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.41 $
  13  * $Date: 2000/03/10 20:03:36 $
  14  * ------------------------------------------------------------------------*/
  15
  16 #include <setjmp.h>
  17 #include <ctype.h>
  18 #include <stdio.h>
  19
  20 #include "prelude.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
  33 #if EXPLAIN_INSTANCE_RESOLUTION
  34 Bool showInstRes = FALSE;
  35 #endif
  36 #if MULTI_INST
  37 Bool multiInstRes = FALSE;
  38 #endif
  39
  40 /* --------------------------------------------------------------------------
  41  * Local function prototypes:
  42  * ------------------------------------------------------------------------*/
  43
  44 static Void   local initialize        Args((Int,String []));
  45 static Void   local promptForInput    Args((String));
  46 static Void   local interpreter       Args((Int,String []));
  47 static Void   local menu              Args((Void));
  48 static Void   local guidance          Args((Void));
  49 static Void   local forHelp           Args((Void));
  50 static Void   local set               Args((Void));
  51 static Void   local changeDir         Args((Void));
  52 static Void   local load              Args((Void));
  53 static Void   local project           Args((Void));
  54 static Void   local readScripts       Args((Int));
  55 static Void   local whatScripts       Args((Void));
  56 static Void   local editor            Args((Void));
  57 static Void   local find              Args((Void));
  58 static Bool   local startEdit         Args((Int,String));
  59 static Void   local runEditor         Args((Void));
  60 static Void   local setModule         Args((Void));
  61 static Module local findEvalModule    Args((Void));
  62 static Void   local evaluator         Args((Void));
  63 static Void   local stopAnyPrinting   Args((Void));
  64 static Void   local showtype          Args((Void));
  65 static String local objToStr          Args((Module, Cell));
  66 static Void   local info              Args((Void));
  67 static Void   local printSyntax       Args((Name));
  68 static Void   local showInst          Args((Inst));
  69 static Void   local describe          Args((Text));
  70 static Void   local listNames         Args((Void));
  71
  72 static Void   local toggleSet         Args((Char,Bool));
  73 static Void   local togglesIn         Args((Bool));
  74 static Void   local optionInfo        Args((Void));
  75 #if USE_REGISTRY || HUGS_FOR_WINDOWS
  76 static String local optionsToStr      Args((Void));
  77 #endif
  78 static Void   local readOptions       Args((String));
  79 static Bool   local processOption     Args((String));
  80 static Void   local setHeapSize       Args((String));
  81 static Int    local argToInt          Args((String));
  82
  83 static Void   local loadProject       Args((String));
  84 static Void   local clearProject      Args((Void));
  85 static Bool   local addScript         Args((Int));
  86 static Void   local forgetScriptsFrom Args((Script));
  87 static Void   local setLastEdit       Args((String,Int));
  88 static Void   local failed            Args((Void));
  89 static String local strCopy           Args((String));
  90 static Void   local browseit          Args((Module,String,Bool));
  91 static Void   local browse            Args((Void));
  92
  93 /* --------------------------------------------------------------------------
  94  * Machine dependent code for Hugs interpreter:
  95  * ------------------------------------------------------------------------*/
  96
  97        Bool   combined      = TRUE;
  98
  99 #include "machdep.c"
 100 #ifdef WANT_TIMER
 101 #include "timer.c"
 102 #endif
 103
 104 /* --------------------------------------------------------------------------
 105  * Local data areas:
 106  * ------------------------------------------------------------------------*/
 107
 108 static Bool   printing      = FALSE;    /* TRUE => currently printing value*/
 109 static Bool   showStats     = FALSE;    /* TRUE => print stats after eval  */
 110 static Bool   listScripts   = TRUE;   /* TRUE => list scripts after loading*/
 111 static Bool   addType       = FALSE;    /* TRUE => print type with value   */
 112 static Bool   useDots       = RISCOS;   /* TRUE => use dots in progress    */
 113 static Bool   quiet         = FALSE;    /* TRUE => don't show progress     */
 114 static Bool   lastWasObject = FALSE;
 115        Bool   preludeLoaded = FALSE;
 116        Bool   debugSC       = FALSE;
 117
 118 typedef
 119    struct {
 120       String modName;                   /* Module name                     */
 121       Bool   details;             /* FALSE => remaining fields are invalid */
 122       String path;                      /* Path to module                  */
 123       String srcExt;                    /* ".hs" or ".lhs" if fromSource   */
 124       Time   lastChange;                /* Time of last change to script   */
 125       Bool   fromSource;                /* FALSE => load object code       */
 126       Bool   postponed;                 /* Indicates postponed load        */
 127       Bool   objLoaded;
 128       Long   size;
 129       Long   oSize;
 130    }
 131    ScriptInfo;
 132
 133 static Void   local makeStackEntry    Args((ScriptInfo*,String));
 134 static Void   local addStackEntry     Args((String));
 135
 136 static ScriptInfo scriptInfo[NUM_SCRIPTS];
 137
 138 static Int    numScripts;               /* Number of scripts loaded        */
 139 static Int    nextNumScripts;
 140 static Int    namesUpto;                /* Number of script names set      */
 141 static Bool   needsImports;             /* set to TRUE if imports required */
 142        String scriptFile;               /* Name of current script (if any) */
 143
 144
 145
 146 static Text   evalModule  = 0;          /* Name of module we eval exprs in */
 147 static String currProject = 0;          /* Name of current project file    */
 148 static Bool   projectLoaded = FALSE;    /* TRUE => project file loaded     */
 149
 150 static Bool   autoMain   = FALSE;
 151 static String lastEdit   = 0;           /* Name of script to edit (if any) */
 152 static Int    lastEdLine = 0;           /* Editor line number (if possible)*/
 153 static String prompt     = 0;           /* Prompt string                   */
 154 static Int    hpSize     = DEFAULTHEAP; /* Desired heap size               */
 155        String hugsEdit   = 0;           /* String for editor command       */
 156        String hugsPath   = 0;           /* String for file search path     */
 157
 158        List  ifaces_outstanding = NIL;
 159
 160 #if REDIRECT_OUTPUT
 161 static Bool disableOutput = FALSE;      /* redirect output to buffer?      */
 162 #endif
 163
 164 String bool2str ( Bool b )
 165 {
 166    if (b) return "Yes"; else return "No ";
 167 }
 168
 169 void ppSmStack ( String who )
 170 {
 171    int i, j;
 172 return;
 173    fflush(stdout);fflush(stderr);
 174    printf ( "\n" );
 175    printf ( "ppSmStack %s:  numScripts = %d   namesUpto = %d  needsImports = %s\n",
 176             who, numScripts, namesUpto, bool2str(needsImports) );
 177    assert (namesUpto >= numScripts);
 178    printf ( "     Det FrS Pst ObL           Module Ext   Size ModTime  Path\n" );
 179    for (i = namesUpto-1; i >= 0; i--) {
 180       printf ( "%c%2d: %3s %3s %3s %3s %16s %-4s %5ld %8lx %s\n",
 181                (i==numScripts ? '*' : ' '),
 182                i, bool2str(scriptInfo[i].details),
 183                   bool2str(scriptInfo[i].fromSource),
 184                   bool2str(scriptInfo[i].postponed),
 185                   bool2str(scriptInfo[i].objLoaded),
 186                   scriptInfo[i].modName,
 187                   scriptInfo[i].fromSource ? scriptInfo[i].srcExt : "",
 188                   scriptInfo[i].size,
 189                   scriptInfo[i].lastChange,
 190                   scriptInfo[i].path
 191              );
 192    }
 193    fflush(stdout);fflush(stderr);
 194    ppScripts();
 195    ppModules();
 196    printf ( "\n" );
 197 }
 198
 199 /* --------------------------------------------------------------------------
 200  * Hugs entry point:
 201  * ------------------------------------------------------------------------*/
 202
 203 #ifndef NO_MAIN /* we omit main when building the "Hugs server" */
 204
 205 Main main Args((Int, String []));       /* now every func has a prototype  */
 206
 207 Main main(argc,argv)
 208 int  argc;
 209 char *argv[]; {
 210 #ifdef HAVE_CONSOLE_H /* Macintosh port */
 211     _ftype = 'TEXT';
 212     _fcreator = 'R*ch';       /*  // 'KAHL';      //'*TEX';       //'ttxt'; */
 213
 214     console_options.top = 50;
 215     console_options.left = 20;
 216
 217     console_options.nrows = 32;
 218     console_options.ncols = 80;
 219
 220     console_options.pause_atexit = 1;
 221     console_options.title = "\pHugs";
 222
 223     console_options.procID = 5;
 224     argc = ccommand(&argv);
 225 #endif
 226
 227     CStackBase = &argc;                 /* Save stack base for use in gc   */
 228
 229     /* If first arg is +Q or -Q, be entirely silent, and automatically run
 230        main after loading scripts.  Useful for running the nofib suite.    */
 231     if (argc > 1 && (strcmp(argv[1],"+Q") == 0 || strcmp(argv[1],"-Q")==0)) {
 232        autoMain = TRUE;
 233        if (strcmp(argv[1],"-Q") == 0) {
 234          hugsEnableOutput(0);
 235        }
 236     }
 237
 238     Printf("__   __ __  __  ____   ___      _________________________________________\n");
 239     Printf("||   || ||  || ||  || ||__      STGHugs: Based on the Haskell 98 standard\n");
 240     Printf("||___|| ||__|| ||__||  __||     Copyright (c) 1994-1999\n");
 241     Printf("||---||         ___||           World Wide Web: http://haskell.org/hugs\n");
 242     Printf("||   ||                         Report bugs to: hugs-bugs@haskell.org\n");
 243     Printf("||   || Version: %s _________________________________________\n\n",HUGS_VERSION);
 244
 245     /* Get the absolute path to the directory containing the hugs
 246        executable, so that we know where the Prelude and nHandle.so/.dll are.
 247        We do this by reading env var STGHUGSDIR.  This needs to succeed, so
 248        setInstallDir won't return unless it succeeds.
 249     */
 250     setInstallDir ( argv[0] );
 251
 252 #if SYMANTEC_C
 253     Printf("   Ported to Macintosh by Hans Aberg, compiled " __DATE__ ".\n\n");
 254 #endif
 255     FlushStdout();
 256     interpreter(argc,argv);
 257     Printf("[Leaving Hugs]\n");
 258     everybody(EXIT);
 259     shutdownHaskell();
 260     FlushStdout();
 261     fflush(stderr);
 262     exit(0);
 263     MainDone();
 264 }
 265
 266 #endif
 267
 268 /* --------------------------------------------------------------------------
 269  * Initialization, interpret command line args and read prelude:
 270  * ------------------------------------------------------------------------*/
 271
 272 static Void local initialize(argc,argv)/* Interpreter initialization       */
 273 Int    argc;
 274 String argv[]; {
 275     Script i;
 276     String proj        = 0;
 277     char argv_0_orig[1000];
 278
 279     setLastEdit((String)0,0);
 280     lastEdit      = 0;
 281     scriptFile    = 0;
 282     numScripts    = 0;
 283     namesUpto     = 1;
 284
 285 #if HUGS_FOR_WINDOWS
 286     hugsEdit      = strCopy(fromEnv("EDITOR","c:\\windows\\notepad.exe"));
 287 #elif SYMANTEC_C
 288     hugsEdit      = "";
 289 #else
 290     hugsEdit      = strCopy(fromEnv("EDITOR",NULL));
 291 #endif
 292     hugsPath      = strCopy(HUGSPATH);
 293     readOptions("-p\"%s> \" -r$$");
 294 #if USE_REGISTRY
 295     projectPath   = strCopy(readRegChildStrings(HKEY_LOCAL_MACHINE,ProjectRoot,
 296                                                 "HUGSPATH", PATHSEP, ""));
 297     readOptions(readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"Options",""));
 298     readOptions(readRegString(HKEY_CURRENT_USER, HugsRoot,"Options",""));
 299 #endif /* USE_REGISTRY */
 300     readOptions(fromEnv("STGHUGSFLAGS",""));
 301
 302    strncpy(argv_0_orig,argv[0],1000);   /* startupHaskell mangles argv[0] */
 303    startupHaskell (argc,argv);
 304    argc = prog_argc; argv = prog_argv;
 305
 306    namesUpto = numScripts = 0;
 307
 308    /* Pre-scan flags to see if -c or +c is present.  This needs to
 309       precede adding the stack entry for Prelude.  On the other hand,
 310       that stack entry needs to be made before the cmd line args are
 311       properly examined.  Hence the following pre-scan of them.
 312    */
 313    for (i=1; i < argc; ++i) {
 314       if (strcmp(argv[i], "--")==0) break;
 315       if (strcmp(argv[i], "-c")==0) combined = FALSE;
 316       if (strcmp(argv[i], "+c")==0) combined = TRUE;
 317    }
 318
 319    addStackEntry("Prelude");
 320    if (combined) addStackEntry("PrelHugs");
 321
 322    for (i=1; i < argc; ++i) {            /* process command line arguments  */
 323         if (strcmp(argv[i], "--")==0) break;
 324         if (strcmp(argv[i],"+")==0 && i+1<argc) {
 325             if (proj) {
 326                 ERRMSG(0) "Multiple project filenames on command line"
 327                 EEND;
 328             } else {
 329                 proj = argv[++i];
 330             }
 331         } else if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/
 332                  && !processOption(argv[i])) {
 333             addStackEntry(argv[i]);
 334         }
 335     }
 336
 337 #if DEBUG
 338     {
 339        char exe_name[N_INSTALLDIR + 6];
 340        strcpy(exe_name, installDir);
 341        strcat(exe_name, "hugs");
 342        DEBUG_LoadSymbols(exe_name);
 343     }
 344 #endif
 345
 346
 347 #if 0
 348     if (!scriptName[0]) {
 349         Printf("Prelude not found on current path: \"%s\"\n",
 350                hugsPath ? hugsPath : "");
 351         fatal("Unable to load prelude");
 352     }
 353 #endif
 354
 355     if (haskell98) {
 356         Printf("Haskell 98 mode: Restart with command line option -98 to enable extensions\n");
 357     } else {
 358         Printf("Hugs mode: Restart with command line option +98 for Haskell 98 mode\n");
 359     }
 360
 361     if (combined) {
 362         Printf("Combined mode: Restart with command line -c for standalone mode\n\n" );
 363     } else {
 364         Printf("Standalone mode: Restart with command line +c for combined mode\n\n" );
 365     }
 366
 367     everybody(PREPREL);
 368
 369     evalModule = findText("");      /* evaluate wrt last module by default */
 370     if (proj) {
 371         if (namesUpto>1) {
 372             fprintf(stderr,
 373                     "\nUsing project file, ignoring additional filenames\n");
 374         }
 375         loadProject(strCopy(proj));
 376     }
 377     readScripts(0);
 378 }
 379
 380 /* --------------------------------------------------------------------------
 381  * Command line options:
 382  * ------------------------------------------------------------------------*/
 383
 384 struct options {                        /* command line option toggles     */
 385     char   c;                           /* table defined in main app.      */
 386     int    h98;
 387     String description;
 388     Bool   *flag;
 389 };
 390 extern struct options toggle[];
 391
 392 static Void local toggleSet(c,state)    /* Set command line toggle         */
 393 Char c;
 394 Bool state; {
 395     Int i;
 396     for (i=0; toggle[i].c; ++i)
 397         if (toggle[i].c == c) {
 398             *toggle[i].flag = state;
 399             return;
 400         }
 401     ERRMSG(0) "Unknown toggle `%c'", c
 402     EEND;
 403 }
 404
 405 static Void local togglesIn(state)      /* Print current list of toggles in*/
 406 Bool state; {                           /* given state                     */
 407     Int count = 0;
 408     Int i;
 409     for (i=0; toggle[i].c; ++i)
 410         if (*toggle[i].flag == state && (!haskell98 || toggle[i].h98)) {
 411             if (count==0)
 412                 Putchar((char)(state ? '+' : '-'));
 413             Putchar(toggle[i].c);
 414             count++;
 415         }
 416     if (count>0)
 417         Putchar(' ');
 418 }
 419
 420 static Void local optionInfo() {        /* Print information about command */
 421     static String fmts = "%-5s%s\n";    /* line settings                   */
 422     static String fmtc = "%-5c%s\n";
 423     Int    i;
 424
 425     Printf("TOGGLES: groups begin with +/- to turn options on/off resp.\n");
 426     for (i=0; toggle[i].c; ++i) {
 427         if (!haskell98 || toggle[i].h98) {
 428             Printf(fmtc,toggle[i].c,toggle[i].description);
 429         }
 430     }
 431
 432     Printf("\nOTHER OPTIONS: (leading + or - makes no difference)\n");
 433     Printf(fmts,"hnum","Set heap size (cannot be changed within Hugs)");
 434     Printf(fmts,"pstr","Set prompt string to str");
 435     Printf(fmts,"rstr","Set repeat last expression string to str");
 436     Printf(fmts,"Pstr","Set search path for modules to str");
 437     Printf(fmts,"Estr","Use editor setting given by str");
 438     Printf(fmts,"cnum","Set constraint cutoff limit");
 439 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 440     Printf(fmts,"Fstr","Set preprocessor filter to str");
 441 #endif
 442
 443     Printf("\nCurrent settings: ");
 444     togglesIn(TRUE);
 445     togglesIn(FALSE);
 446     Printf("-h%d",heapSize);
 447     Printf(" -p");
 448     printString(prompt);
 449     Printf(" -r");
 450     printString(repeatStr);
 451     Printf(" -c%d",cutoff);
 452     Printf("\nSearch path     : -P");
 453     printString(hugsPath);
 454 #if 0
 455 ToDo
 456     if (projectPath!=NULL) {
 457         Printf("\nProject Path    : %s",projectPath);
 458     }
 459 #endif
 460     Printf("\nEditor setting  : -E");
 461     printString(hugsEdit);
 462 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 463     Printf("\nPreprocessor    : -F");
 464     printString(preprocessor);
 465 #endif
 466     Printf("\nCompatibility   : %s", haskell98 ? "Haskell 98 (+98)"
 467                                                : "Hugs Extensions (-98)");
 468     Putchar('\n');
 469 }
 470
 471 #if USE_REGISTRY || HUGS_FOR_WINDOWS
 472 #define PUTC(c)                         \
 473     *next++=(c)
 474
 475 #define PUTS(s)                         \
 476     strcpy(next,s);                     \
 477     next+=strlen(next)
 478
 479 #define PUTInt(optc,i)                  \
 480     sprintf(next,"-%c%d",optc,i);       \
 481     next+=strlen(next)
 482
 483 #define PUTStr(c,s)                     \
 484     next=PUTStr_aux(next,c,s)
 485
 486 static String local PUTStr_aux Args((String,Char, String));
 487
 488 static String local PUTStr_aux(next,c,s)
 489 String next;
 490 Char   c;
 491 String s; {
 492     if (s) {
 493         String t = 0;
 494         sprintf(next,"-%c\"",c);
 495         next+=strlen(next);
 496         for(t=s; *t; ++t) {
 497             PUTS(unlexChar(*t,'"'));
 498         }
 499         next+=strlen(next);
 500         PUTS("\" ");
 501     }
 502     return next;
 503 }
 504
 505 static String local optionsToStr() {          /* convert options to string */
 506     static char buffer[2000];
 507     String next = buffer;
 508
 509     Int i;
 510     for (i=0; toggle[i].c; ++i) {
 511         PUTC(*toggle[i].flag ? '+' : '-');
 512         PUTC(toggle[i].c);
 513         PUTC(' ');
 514     }
 515     PUTS(haskell98 ? "+98 " : "-98 ");
 516     PUTInt('h',hpSize);  PUTC(' ');
 517     PUTStr('p',prompt);
 518     PUTStr('r',repeatStr);
 519     PUTStr('P',hugsPath);
 520     PUTStr('E',hugsEdit);
 521     PUTInt('c',cutoff);  PUTC(' ');
 522 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 523     PUTStr('F',preprocessor);
 524 #endif
 525     PUTC('\0');
 526     return buffer;
 527 }
 528 #endif /* USE_REGISTRY */
 529
 530 #undef PUTC
 531 #undef PUTS
 532 #undef PUTInt
 533 #undef PUTStr
 534
 535 static Void local readOptions(options)         /* read options from string */
 536 String options; {
 537     String s;
 538     if (options) {
 539         stringInput(options);
 540         while ((s=readFilename())!=0) {
 541             if (*s && !processOption(s)) {
 542                 ERRMSG(0) "Option string must begin with `+' or `-'"
 543                 EEND;
 544             }
 545         }
 546     }
 547 }
 548
 549 static Bool local processOption(s)      /* process string s for options,   */
 550 String s; {                             /* return FALSE if none found.     */
 551     Bool state;
 552
 553     if (s[0]=='-')
 554         state = FALSE;
 555     else if (s[0]=='+')
 556         state = TRUE;
 557     else
 558         return FALSE;
 559
 560     while (*++s)
 561         switch (*s) {
 562             case 'Q' : break;                           /* already handled */
 563
 564             case 'p' : if (s[1]) {
 565                            if (prompt) free(prompt);
 566                            prompt = strCopy(s+1);
 567                        }
 568                        return TRUE;
 569
 570             case 'r' : if (s[1]) {
 571                            if (repeatStr) free(repeatStr);
 572                            repeatStr = strCopy(s+1);
 573                        }
 574                        return TRUE;
 575
 576             case 'P' : {
 577                            String p = substPath(s+1,hugsPath ? hugsPath : "");
 578                            if (hugsPath) free(hugsPath);
 579                            hugsPath = p;
 580                            return TRUE;
 581                        }
 582
 583             case 'E' : if (hugsEdit) free(hugsEdit);
 584                        hugsEdit = strCopy(s+1);
 585                        return TRUE;
 586
 587 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 588             case 'F' : if (preprocessor) free(preprocessor);
 589                        preprocessor = strCopy(s+1);
 590                        return TRUE;
 591 #endif
 592
 593             case 'h' : setHeapSize(s+1);
 594                        return TRUE;
 595
 596             case 'c' : if (heapBuilt()) {
 597                           FPrintf(stderr,
 598                                   "You can't enable/disable combined"
 599                                   " operation inside Hugs\n" );
 600                        } else {
 601                           /* don't do anything, since pre-scan of args
 602                              will have got it already */
 603                        }
 604                        return TRUE;
 605
 606             case 'D' : /* hack */
 607                 {
 608                     extern void setRtsFlags( int x );
 609                     setRtsFlags(argToInt(s+1));
 610                     return TRUE;
 611                 }
 612
 613             default  : if (strcmp("98",s)==0) {
 614                            if (heapBuilt() && ((state && !haskell98) ||
 615                                                (!state && haskell98))) {
 616                                FPrintf(stderr,
 617                                        "Haskell 98 compatibility cannot be changed"
 618                                        " while the interpreter is running\n");
 619                            } else {
 620                                haskell98 = state;
 621                            }
 622                            return TRUE;
 623                        } else {
 624                            toggleSet(*s,state);
 625                        }
 626                        break;
 627         }
 628     return TRUE;
 629 }
 630
 631 static Void local setHeapSize(s)
 632 String s; {
 633     if (s) {
 634         hpSize = argToInt(s);
 635         if (hpSize < MINIMUMHEAP)
 636             hpSize = MINIMUMHEAP;
 637         else if (MAXIMUMHEAP && hpSize > MAXIMUMHEAP)
 638             hpSize = MAXIMUMHEAP;
 639         if (heapBuilt() && hpSize != heapSize) {
 640             /* ToDo: should this use a message box in winhugs? */
 641 #if USE_REGISTRY
 642             FPrintf(stderr,"Change to heap size will not take effect until you rerun Hugs\n");
 643 #else
 644             FPrintf(stderr,"You cannot change heap size from inside Hugs\n");
 645 #endif
 646         } else {
 647             heapSize = hpSize;
 648         }
 649     }
 650 }
 651
 652 static Int local argToInt(s)            /* read integer from argument str  */
 653 String s; {
 654     Int    n = 0;
 655     String t = s;
 656
 657     if (*s=='\0' || !isascii((int)(*s)) || !isdigit((int)(*s))) {
 658         ERRMSG(0) "Missing integer in option setting \"%s\"", t
 659         EEND;
 660     }
 661
 662     do {
 663         Int d = (*s++) - '0';
 664         if (n > ((MAXPOSINT - d)/10)) {
 665             ERRMSG(0) "Option setting \"%s\" is too large", t
 666             EEND;
 667         }
 668         n     = 10*n + d;
 669     } while (isascii((int)(*s)) && isdigit((int)(*s)));
 670
 671     if (*s=='K' || *s=='k') {
 672         if (n > (MAXPOSINT/1000)) {
 673             ERRMSG(0) "Option setting \"%s\" is too large", t
 674             EEND;
 675         }
 676         n *= 1000;
 677         s++;
 678     }
 679
 680 #if MAXPOSINT > 1000000                 /* waste of time on 16 bit systems */
 681     if (*s=='M' || *s=='m') {
 682         if (n > (MAXPOSINT/1000000)) {
 683             ERRMSG(0) "Option setting \"%s\" is too large", t
 684             EEND;
 685         }
 686         n *= 1000000;
 687         s++;
 688     }
 689 #endif
 690
 691 #if MAXPOSINT > 1000000000
 692     if (*s=='G' || *s=='g') {
 693         if (n > (MAXPOSINT/1000000000)) {
 694             ERRMSG(0) "Option setting \"%s\" is too large", t
 695             EEND;
 696         }
 697         n *= 1000000000;
 698         s++;
 699     }
 700 #endif
 701
 702     if (*s!='\0') {
 703         ERRMSG(0) "Unwanted characters after option setting \"%s\"", t
 704         EEND;
 705     }
 706
 707     return n;
 708 }
 709
 710 /* --------------------------------------------------------------------------
 711  * Print Menu of list of commands:
 712  * ------------------------------------------------------------------------*/
 713
 714 static struct cmd cmds[] = {
 715  {":?",      HELP},   {":cd",   CHGDIR},  {":also",    ALSO},
 716  {":type",   TYPEOF}, {":!",    SYSTEM},  {":load",    LOAD},
 717  {":reload", RELOAD}, {":gc",   COLLECT}, {":edit",    EDIT},
 718  {":quit",   QUIT},   {":set",  SET},     {":find",    FIND},
 719  {":names",  NAMES},  {":info", INFO},    {":project", PROJECT},
 720  {":dump",   DUMP},   {":ztats", STATS},
 721  {":module",SETMODULE},
 722  {":browse", BROWSE},
 723 #if EXPLAIN_INSTANCE_RESOLUTION
 724  {":xplain", XPLAIN},
 725 #endif
 726  {":version", PNTVER},
 727  {"",      EVAL},
 728  {0,0}
 729 };
 730
 731 static Void local menu() {
 732     Printf("LIST OF COMMANDS:  Any command may be abbreviated to :c where\n");
 733     Printf("c is the first character in the full name.\n\n");
 734     Printf(":load <filenames>   load modules from specified files\n");
 735     Printf(":load               clear all files except prelude\n");
 736     Printf(":also <filenames>   read additional modules\n");
 737     Printf(":reload             repeat last load command\n");
 738     Printf(":project <filename> use project file\n");
 739     Printf(":edit <filename>    edit file\n");
 740     Printf(":edit               edit last module\n");
 741     Printf(":module <module>    set module for evaluating expressions\n");
 742     Printf("<expr>              evaluate expression\n");
 743     Printf(":type <expr>        print type of expression\n");
 744     Printf(":?                  display this list of commands\n");
 745     Printf(":set <options>      set command line options\n");
 746     Printf(":set                help on command line options\n");
 747     Printf(":names [pat]        list names currently in scope\n");
 748     Printf(":info <names>       describe named objects\n");
 749     Printf(":browse <modules>   browse names defined in <modules>\n");
 750 #if EXPLAIN_INSTANCE_RESOLUTION
 751     Printf(":xplain <context>   explain instance resolution for <context>\n");
 752 #endif
 753     Printf(":find <name>        edit module containing definition of name\n");
 754     Printf(":!command           shell escape\n");
 755     Printf(":cd dir             change directory\n");
 756     Printf(":gc                 force garbage collection\n");
 757     Printf(":version            print Hugs version\n");
 758     Printf(":dump <name>        print STG code for named fn\n");
 759 #ifdef CRUDE_PROFILING
 760     Printf(":ztats <name>       print reduction stats\n");
 761 #endif
 762     Printf(":quit               exit Hugs interpreter\n");
 763 }
 764
 765 static Void local guidance() {
 766     Printf("Command not recognised.  ");
 767     forHelp();
 768 }
 769
 770 static Void local forHelp() {
 771     Printf("Type :? for help\n");
 772 }
 773
 774 /* --------------------------------------------------------------------------
 775  * Setting of command line options:
 776  * ------------------------------------------------------------------------*/
 777
 778 struct options toggle[] = {             /* List of command line toggles    */
 779     {'s', 1, "Print no. reductions/cells after eval", &showStats},
 780     {'t', 1, "Print type after evaluation",           &addType},
 781     {'g', 1, "Print no. cells recovered after gc",    &gcMessages},
 782     {'l', 1, "Literate modules as default",           &literateScripts},
 783     {'e', 1, "Warn about errors in literate modules", &literateErrors},
 784     {'.', 1, "Print dots to show progress",           &useDots},
 785     {'q', 1, "Print nothing to show progress",        &quiet},
 786     {'w', 1, "Always show which modules are loaded",  &listScripts},
 787     {'k', 1, "Show kind errors in full",              &kindExpert},
 788     {'o', 0, "Allow overlapping instances",           &allowOverlap},
 789     {'S', 1, "Debug: show generated SC code",         &debugSC},
 790 #if EXPLAIN_INSTANCE_RESOLUTION
 791     {'x', 1, "Explain instance resolution",           &showInstRes},
 792 #endif
 793 #if MULTI_INST
 794     {'m', 0, "Use multi instance resolution",         &multiInstRes},
 795 #endif
 796     {0,   0, 0,                                       0}
 797 };
 798
 799 static Void local set() {               /* change command line options from*/
 800     String s;                           /* Hugs command line               */
 801
 802     if ((s=readFilename())!=0) {
 803         do {
 804             if (!processOption(s)) {
 805                 ERRMSG(0) "Option string must begin with `+' or `-'"
 806                 EEND;
 807             }
 808         } while ((s=readFilename())!=0);
 809 #if USE_REGISTRY
 810         writeRegString("Options", optionsToStr());
 811 #endif
 812     }
 813     else
 814         optionInfo();
 815 }
 816
 817 /* --------------------------------------------------------------------------
 818  * Change directory command:
 819  * ------------------------------------------------------------------------*/
 820
 821 static Void local changeDir() {         /* change directory                */
 822     String s = readFilename();
 823     if (s && chdir(s)) {
 824         ERRMSG(0) "Unable to change to directory \"%s\"", s
 825         EEND;
 826     }
 827 }
 828
 829 /* --------------------------------------------------------------------------
 830  * Loading project and script files:
 831  * ------------------------------------------------------------------------*/
 832
 833 static Void local loadProject(s)        /* Load project file               */
 834 String s; {
 835     clearProject();
 836     currProject = s;
 837     projInput(currProject);
 838     scriptFile = currProject;
 839     forgetScriptsFrom(N_PRELUDE_SCRIPTS);
 840     while ((s=readFilename())!=0)
 841         addStackEntry(s);
 842     if (namesUpto<=1) {
 843         ERRMSG(0) "Empty project file"
 844         EEND;
 845     }
 846     scriptFile    = 0;
 847     projectLoaded = TRUE;
 848 }
 849
 850 static Void local clearProject() {      /* clear name for current project  */
 851     if (currProject)
 852         free(currProject);
 853     currProject   = 0;
 854     projectLoaded = FALSE;
 855 #if HUGS_FOR_WINDOWS
 856     setLastEdit((String)0,0);
 857 #endif
 858 }
 859
 860
 861
 862 static Void local makeStackEntry ( ScriptInfo* ent, String iname )
 863 {
 864    Bool   ok, fromObj;
 865    Bool   sAvail, iAvail, oAvail;
 866    Time   sTime,  iTime,  oTime;
 867    Long   sSize,  iSize,  oSize;
 868    String path,   sExt;
 869
 870    ok = findFilesForModule (
 871            iname,
 872            &path,
 873            &sExt,
 874            &sAvail, &sTime, &sSize,
 875            &iAvail, &iTime, &iSize,
 876            &oAvail, &oTime, &oSize
 877         );
 878    if (!ok) {
 879       ERRMSG(0)
 880          "Can't find source or object+interface for module \"%s\"",
 881          /* "Can't find source for module \"%s\"", */
 882          iname
 883       EEND;
 884    }
 885    /* findFilesForModule should enforce this */
 886    if (!(sAvail || (oAvail && iAvail)))
 887       internal("chase");
 888    /* Load objects in preference to sources if both are available */
 889    /* 11 Oct 99: disable object loading in the interim.
 890       Will probably only reinstate when HEP becomes available.
 891    */
 892    if (combined) {
 893       fromObj = sAvail
 894                 ? (oAvail && iAvail && timeEarlier(sTime,oTime))
 895                 : TRUE;
 896    } else {
 897       fromObj = FALSE;
 898    }
 899
 900    /* ToDo: namesUpto overflow */
 901    ent->modName     = strCopy(iname);
 902    ent->details     = TRUE;
 903    ent->path        = path;
 904    ent->fromSource  = !fromObj;
 905    ent->srcExt      = sExt;
 906    ent->postponed   = FALSE;
 907    ent->lastChange  = sTime; /* ToDo: is this right? */
 908    ent->size        = fromObj ? iSize : sSize;
 909    ent->oSize       = fromObj ? oSize : 0;
 910    ent->objLoaded   = FALSE;
 911 }
 912
 913
 914
 915 static Void nukeEnding( String s )
 916 {
 917     Int l = strlen(s);
 918     if (l > 4 && strncmp(s+l-4,".u_o" ,4)==0) s[l-4] = 0; else
 919     if (l > 5 && strncmp(s+l-5,".u_hi",5)==0) s[l-5] = 0; else
 920     if (l > 3 && strncmp(s+l-3,".hs"  ,3)==0) s[l-3] = 0; else
 921     if (l > 4 && strncmp(s+l-4,".lhs" ,4)==0) s[l-4] = 0; else
 922     if (l > 4 && strncmp(s+l-4,".dll" ,4)==0) s[l-4] = 0; else
 923     if (l > 4 && strncmp(s+l-4,".DLL" ,4)==0) s[l-4] = 0;
 924 }
 925
 926 static Void local addStackEntry(s)     /* Add script to list of scripts    */
 927 String s; {                            /* to be read in ...                */
 928     String s2;
 929     Bool   found;
 930     Int    i;
 931
 932     if (namesUpto>=NUM_SCRIPTS) {
 933         ERRMSG(0) "Too many module files (maximum of %d allowed)",
 934                   NUM_SCRIPTS
 935         EEND;
 936     }
 937
 938     s = strCopy(s);
 939     nukeEnding(s);
 940     for (s2 = s; *s2; s2++)
 941        if (*s2 == SLASH && *(s2+1)) s = s2+1;
 942
 943     found = FALSE;
 944     for (i = 0; i < namesUpto; i++)
 945        if (strcmp(scriptInfo[i].modName,s)==0)
 946           found = TRUE;
 947
 948     if (!found) {
 949        makeStackEntry ( &scriptInfo[namesUpto], strCopy(s) );
 950        namesUpto++;
 951     }
 952     free(s);
 953 }
 954
 955 /* Return TRUE if no imports were needed; FALSE otherwise. */
 956 static Bool local addScript(stacknum)   /* read single file                */
 957 Int stacknum; {
 958    Bool didPrelude;
 959    static char name[FILENAME_MAX+1];
 960    Int len = scriptInfo[stacknum].size;
 961
 962 #if HUGS_FOR_WINDOWS                    /* Set clock cursor while loading  */
 963     allowBreak();
 964     SetCursor(LoadCursor(NULL, IDC_WAIT));
 965 #endif
 966
 967     //   setLastEdit(name,0);
 968
 969    strcpy(name, scriptInfo[stacknum].path);
 970    strcat(name, scriptInfo[stacknum].modName);
 971    if (scriptInfo[stacknum].fromSource)
 972       strcat(name, scriptInfo[stacknum].srcExt); else
 973       strcat(name, ".u_hi");
 974
 975    scriptFile = name;
 976
 977    if (scriptInfo[stacknum].fromSource) {
 978       if (lastWasObject) {
 979          didPrelude = processInterfaces();
 980          if (didPrelude) {
 981             preludeLoaded = TRUE;
 982             everybody(POSTPREL);
 983          }
 984       }
 985       lastWasObject = FALSE;
 986       Printf("Reading script \"%s\":\n",name);
 987       needsImports = FALSE;
 988       parseScript(name,len);
 989       if (needsImports) return FALSE;
 990       checkDefns();
 991       typeCheckDefns();
 992       compileDefns();
 993    } else {
 994       Cell    iface;
 995       List    imports;
 996       ZTriple iface_info;
 997       char    nameObj[FILENAME_MAX+1];
 998       Int     sizeObj;
 999
1000       Printf("Reading  iface \"%s\":\n", name);
1001       scriptFile = name;
1002       needsImports = FALSE;
1003
1004       // set nameObj for the benefit of openGHCIface
1005       strcpy(nameObj, scriptInfo[stacknum].path);
1006       strcat(nameObj, scriptInfo[stacknum].modName);
1007       strcat(nameObj, DLL_ENDING);
1008       sizeObj = scriptInfo[stacknum].oSize;
1009
1010       iface = readInterface(name,len);
1011       imports = zsnd(iface); iface = zfst(iface);
1012
1013       if (nonNull(imports)) chase(imports);
1014       scriptFile = 0;
1015       lastWasObject = TRUE;
1016
1017       iface_info = ztriple(iface, findText(nameObj), mkInt(sizeObj) );
1018       ifaces_outstanding = cons(iface_info,ifaces_outstanding);
1019
1020       if (needsImports) return FALSE;
1021    }
1022
1023    scriptFile = 0;
1024
1025    return TRUE;
1026 }
1027
1028
1029 Bool chase(imps)                        /* Process list of import requests */
1030 List imps; {
1031     Int    dstPosn;
1032     ScriptInfo tmp;
1033     Int    origPos  = numScripts;       /* keep track of original position */
1034     String origName = scriptInfo[origPos].modName;
1035     for (; nonNull(imps); imps=tl(imps)) {
1036         String iname = textToStr(textOf(hd(imps)));
1037         Int    i     = 0;
1038         for (; i<namesUpto; i++)
1039             if (strcmp(scriptInfo[i].modName,iname)==0)
1040                 break;
1041         //fprintf(stderr, "import name = %s   num = %d\n", iname, i );
1042
1043         if (i<namesUpto) {
1044            /* We should have filled in the details of each module
1045               the first time we hear about it.
1046            */
1047            assert(scriptInfo[i].details);
1048         }
1049
1050         if (i>=origPos) {               /* Neither loaded or queued        */
1051             String theName;
1052             Time   theTime;
1053             Bool   thePost;
1054             Bool   theFS;
1055
1056             needsImports = TRUE;
1057             if (scriptInfo[origPos].fromSource)
1058                scriptInfo[origPos].postponed  = TRUE;
1059
1060             if (i==namesUpto) {         /* Name not found (i==namesUpto)   */
1061                  /* Find out where it lives, whether source or object, etc */
1062                makeStackEntry ( &scriptInfo[i], iname );
1063                namesUpto++;
1064             }
1065             else
1066             if (scriptInfo[i].postponed && scriptInfo[i].fromSource) {
1067                                         /* Check for recursive dependency  */
1068                 ERRMSG(0)
1069                   "Recursive import dependency between \"%s\" and \"%s\"",
1070                   scriptInfo[origPos].modName, iname
1071                 EEND;
1072             }
1073             /* Move stack entry i to somewhere below origPos.  If i denotes
1074              * an object, destination is immediately below origPos.
1075              * Otherwise, it's underneath the queue of objects below origPos.
1076              */
1077             dstPosn = origPos-1;
1078             if (scriptInfo[i].fromSource)
1079                while (!scriptInfo[dstPosn].fromSource && dstPosn > 0)
1080                   dstPosn--;
1081
1082             dstPosn++;
1083             tmp = scriptInfo[i];
1084             for (; i > dstPosn; i--) scriptInfo[i] = scriptInfo[i-1];
1085             scriptInfo[dstPosn] = tmp;
1086             if (dstPosn < nextNumScripts) nextNumScripts = dstPosn;
1087             origPos++;
1088         }
1089     }
1090     return needsImports;
1091 }
1092
1093 static Void local forgetScriptsFrom(scno)/* remove scripts from system     */
1094 Script scno; {
1095     Script i;
1096 #if 0
1097     for (i=scno; i<namesUpto; ++i)
1098         if (scriptName[i])
1099             free(scriptName[i]);
1100 #endif
1101     dropScriptsFrom(scno-1);
1102     namesUpto = scno;
1103     if (numScripts>namesUpto)
1104         numScripts = scno;
1105 }
1106
1107 /* --------------------------------------------------------------------------
1108  * Commands for loading and removing script files:
1109  * ------------------------------------------------------------------------*/
1110
1111 static Void local load() {           /* read filenames from command line   */
1112     String s;                        /* and add to list of scripts waiting */
1113                                      /* to be read                         */
1114     while ((s=readFilename())!=0)
1115         addStackEntry(s);
1116     readScripts(N_PRELUDE_SCRIPTS);
1117 }
1118
1119 static Void local project() {          /* read list of script names from   */
1120     String s;                          /* project file                     */
1121
1122     if ((s=readFilename()) || currProject) {
1123         if (!s)
1124             s = strCopy(currProject);
1125         else if (readFilename()) {
1126             ERRMSG(0) "Too many project files"
1127             EEND;
1128         }
1129         else
1130             s = strCopy(s);
1131     }
1132     else {
1133         ERRMSG(0) "No project filename specified"
1134         EEND;
1135     }
1136     loadProject(s);
1137     readScripts(N_PRELUDE_SCRIPTS);
1138 }
1139
1140 static Void local readScripts(n)        /* Reread current list of scripts, */
1141 Int n; {                                /* loading everything after and    */
1142     Time timeStamp;                     /* including the first script which*/
1143     Long fileSize;                      /* has been either changed or added*/
1144     static char name[FILENAME_MAX+1];
1145     Bool didPrelude;
1146
1147     lastWasObject = FALSE;
1148     ppSmStack("readscripts-begin");
1149 #if HUGS_FOR_WINDOWS
1150     SetCursor(LoadCursor(NULL, IDC_WAIT));
1151 #endif
1152
1153 #if 0
1154     for (; n<numScripts; n++) {         /* Scan previously loaded scripts  */
1155         ppSmStack("readscripts-loop1");
1156         getFileInfo(scriptName[n], &timeStamp, &fileSize);
1157         if (timeChanged(timeStamp,lastChange[n])) {
1158             dropScriptsFrom(n-1);
1159             numScripts = n;
1160             break;
1161         }
1162     }
1163     for (; n<NUM_SCRIPTS; n++)          /* No scripts have been postponed  */
1164         postponed[n] = FALSE;           /* at this stage                   */
1165     numScripts = 0;
1166
1167     while (numScripts<namesUpto) {      /* Process any remaining scripts   */
1168         ppSmStack("readscripts-loop2");
1169         getFileInfo(scriptName[numScripts], &timeStamp, &fileSize);
1170         timeSet(lastChange[numScripts],timeStamp);
1171         if (numScripts>0)               /* no new script for prelude       */
1172             startNewScript(scriptName[numScripts]);
1173         if (addScript(scriptName[numScripts],fileSize))
1174             numScripts++;
1175         else
1176             dropScriptsFrom(numScripts-1);
1177     }
1178 #endif
1179
1180     interface(RESET);
1181
1182     for (; n<numScripts; n++) {
1183         ppSmStack("readscripts-loop2");
1184         strcpy(name, scriptInfo[n].path);
1185         strcat(name, scriptInfo[n].modName);
1186         if (scriptInfo[n].fromSource)
1187            strcat(name, scriptInfo[n].srcExt); else
1188            strcat(name, ".u_hi");  //ToDo: should be .o
1189         getFileInfo(name,&timeStamp, &fileSize);
1190         if (timeChanged(timeStamp,scriptInfo[n].lastChange)) {
1191            dropScriptsFrom(n-1);
1192            numScripts = n;
1193            break;
1194         }
1195     }
1196     for (; n<NUM_SCRIPTS; n++)
1197         scriptInfo[n].postponed = FALSE;
1198
1199     //numScripts = 0;
1200
1201     while (numScripts < namesUpto) {
1202        ppSmStack ( "readscripts-loop2" );
1203
1204        if (scriptInfo[numScripts].fromSource) {
1205
1206           if (numScripts>0)
1207               startNewScript(scriptInfo[numScripts].modName);
1208           nextNumScripts = NUM_SCRIPTS; //bogus initialisation
1209           if (addScript(numScripts)) {
1210              numScripts++;
1211              assert(nextNumScripts==NUM_SCRIPTS);
1212           }
1213           else
1214              dropScriptsFrom(numScripts-1);
1215
1216        } else {
1217
1218           if (scriptInfo[numScripts].objLoaded) {
1219              numScripts++;
1220           } else {
1221              scriptInfo[numScripts].objLoaded = TRUE;
1222              /* new */
1223              if (numScripts>0)
1224                  startNewScript(scriptInfo[numScripts].modName);
1225              /* end */
1226              nextNumScripts = NUM_SCRIPTS;
1227              if (addScript(numScripts)) {
1228                 numScripts++;
1229                 assert(nextNumScripts==NUM_SCRIPTS);
1230              } else {
1231                 //while (!scriptInfo[numScripts].fromSource && numScripts > 0)
1232                 //   numScripts--;
1233                 //if (scriptInfo[numScripts].fromSource)
1234                 //   numScripts++;
1235                 numScripts = nextNumScripts;
1236                 assert(nextNumScripts<NUM_SCRIPTS);
1237              }
1238           }
1239        }
1240        if (numScripts==namesUpto) ppSmStack( "readscripts-final") ;
1241     }
1242
1243     didPrelude = processInterfaces();
1244     if (didPrelude) {
1245        preludeLoaded = TRUE;
1246        everybody(POSTPREL);
1247     }
1248
1249
1250     { Int  m     = namesUpto-1;
1251       Text mtext = findText(scriptInfo[m].modName);
1252
1253       /* Hack to avoid starting up in PrelHugs */
1254       if (mtext == findText("PrelHugs")) mtext = findText("Prelude");
1255
1256
1257       /* Commented out till we understand what
1258        * this is trying to do.
1259        * Problem, you cant find a module till later.
1260        */
1261 #if 0
1262        setCurrModule(findModule(mtext));
1263 #endif
1264       evalModule = mtext;
1265     }
1266
1267
1268
1269     if (listScripts)
1270         whatScripts();
1271     if (numScripts<=1)
1272         setLastEdit((String)0, 0);
1273     ppSmStack("readscripts-end  ");
1274 }
1275
1276 static Void local whatScripts() {       /* list scripts in current session */
1277     int i;
1278     Printf("\nHugs session for:");
1279     if (projectLoaded)
1280         Printf(" (project: %s)",currProject);
1281     for (i=0; i<numScripts; ++i)
1282       Printf("\n%s%s",scriptInfo[i].path, scriptInfo[i].modName);
1283     Putchar('\n');
1284 }
1285
1286 /* --------------------------------------------------------------------------
1287  * Access to external editor:
1288  * ------------------------------------------------------------------------*/
1289
1290 static Void local editor() {            /* interpreter-editor interface    */
1291     String newFile  = readFilename();
1292     if (newFile) {
1293         setLastEdit(newFile,0);
1294         if (readFilename()) {
1295             ERRMSG(0) "Multiple filenames not permitted"
1296             EEND;
1297         }
1298     }
1299     runEditor();
1300 }
1301
1302 static Void local find() {              /* edit file containing definition */
1303 #if 0
1304 This just plain wont work no more.
1305 ToDo: Fix!
1306     String nm = readFilename();         /* of specified name               */
1307     if (!nm) {
1308         ERRMSG(0) "No name specified"
1309         EEND;
1310     }
1311     else if (readFilename()) {
1312         ERRMSG(0) "Multiple names not permitted"
1313         EEND;
1314     }
1315     else {
1316         Text t;
1317         Cell c;
1318         setCurrModule(findEvalModule());
1319         startNewScript(0);
1320         if (nonNull(c=findTycon(t=findText(nm)))) {
1321             if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
1322                 readScripts(N_PRELUDE_SCRIPTS);
1323             }
1324         } else if (nonNull(c=findName(t))) {
1325             if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
1326                 readScripts(N_PRELUDE_SCRIPTS);
1327             }
1328         } else {
1329             ERRMSG(0) "No current definition for name \"%s\"", nm
1330             EEND;
1331         }
1332     }
1333 #endif
1334 }
1335
1336 static Void local runEditor() {         /* run editor on script lastEdit   */
1337     if (startEdit(lastEdLine,lastEdit)) /* at line lastEdLine              */
1338         readScripts(N_PRELUDE_SCRIPTS);
1339 }
1340
1341 static Void local setLastEdit(fname,line)/* keep name of last file to edit */
1342 String fname;
1343 Int    line; {
1344     if (lastEdit)
1345         free(lastEdit);
1346     lastEdit = strCopy(fname);
1347     lastEdLine = line;
1348 #if HUGS_FOR_WINDOWS
1349     DrawStatusLine(hWndMain);           /* Redo status line                */
1350 #endif
1351 }
1352
1353 /* --------------------------------------------------------------------------
1354  * Read and evaluate an expression:
1355  * ------------------------------------------------------------------------*/
1356
1357 static Void local setModule(){/*set module in which to evaluate expressions*/
1358     String s = readFilename();
1359     if (!s) s = "";              /* :m clears the current module selection */
1360     evalModule = findText(s);
1361     setLastEdit(fileOfModule(findEvalModule()),0);
1362 }
1363
1364 static Module local findEvalModule() { /*Module in which to eval expressions*/
1365     Module m = findModule(evalModule);
1366     if (isNull(m))
1367         m = lastModule();
1368     return m;
1369 }
1370
1371 static Void local evaluator() {        /* evaluate expr and print value    */
1372     Type  type, bd;
1373     Kinds ks   = NIL;
1374
1375     setCurrModule(findEvalModule());
1376     scriptFile = 0;
1377     startNewScript(0);                 /* Enables recovery of storage      */
1378                                        /* allocated during evaluation      */
1379     parseExp();
1380     checkExp();
1381     defaultDefns = combined ? stdDefaults : evalDefaults;
1382     type         = typeCheckExp(TRUE);
1383
1384     if (isPolyType(type)) {
1385         ks = polySigOf(type);
1386         bd = monotypeOf(type);
1387     }
1388     else
1389         bd = type;
1390
1391     if (whatIs(bd)==QUAL) {
1392         ERRMSG(0) "Unresolved overloading" ETHEN
1393         ERRTEXT   "\n*** Type       : "    ETHEN ERRTYPE(type);
1394         ERRTEXT   "\n*** Expression : "    ETHEN ERREXPR(inputExpr);
1395         ERRTEXT   "\n"
1396         EEND;
1397     }
1398
1399 #ifdef WANT_TIMER
1400     updateTimers();
1401 #endif
1402
1403 #if 1
1404     if (isProgType(ks,bd)) {
1405         inputExpr = ap(nameRunIO_toplevel,inputExpr);
1406         evalExp();
1407         Putchar('\n');
1408     } else {
1409         Cell d = provePred(ks,NIL,ap(classShow,bd));
1410         if (isNull(d)) {
1411             ERRMSG(0) "Cannot find \"show\" function for:" ETHEN
1412             ERRTEXT   "\n*** expression : "   ETHEN ERREXPR(inputExpr);
1413             ERRTEXT   "\n*** of type    : "   ETHEN ERRTYPE(type);
1414             ERRTEXT   "\n"
1415             EEND;
1416         }
1417         inputExpr = ap2(nameShow,           d,inputExpr);
1418         inputExpr = ap (namePutStr,         inputExpr);
1419         inputExpr = ap (nameRunIO_toplevel, inputExpr);
1420
1421         evalExp(); printf("\n");
1422         if (addType) {
1423             printf(" :: ");
1424             printType(stdout,type);
1425             Putchar('\n');
1426         }
1427     }
1428
1429 #else
1430
1431    printf ( "result type is " );
1432    printType ( stdout, type );
1433    printf ( "\n" );
1434    evalExp();
1435    printf ( "\n" );
1436
1437 #endif
1438
1439 }
1440
1441 static Void local stopAnyPrinting() {  /* terminate printing of expression,*/
1442     if (printing) {                    /* after successful termination or  */
1443         printing = FALSE;              /* runtime error (e.g. interrupt)   */
1444         Putchar('\n');
1445         if (showStats) {
1446 #define plural(v)   v, (v==1?"":"s")
1447             Printf("%lu cell%s",plural(numCells));
1448             if (numGcs>0)
1449                 Printf(", %u garbage collection%s",plural(numGcs));
1450             Printf(")\n");
1451 #undef plural
1452         }
1453         FlushStdout();
1454         garbageCollect();
1455     }
1456 }
1457
1458 /* --------------------------------------------------------------------------
1459  * Print type of input expression:
1460  * ------------------------------------------------------------------------*/
1461
1462 static Void local showtype() {         /* print type of expression (if any)*/
1463     Cell type;
1464
1465     setCurrModule(findEvalModule());
1466     startNewScript(0);                 /* Enables recovery of storage      */
1467                                        /* allocated during evaluation      */
1468     parseExp();
1469     checkExp();
1470     defaultDefns = evalDefaults;
1471     type = typeCheckExp(FALSE);
1472     printExp(stdout,inputExpr);
1473     Printf(" :: ");
1474     printType(stdout,type);
1475     Putchar('\n');
1476 }
1477
1478
1479 static Void local browseit(mod,t,all)
1480 Module mod;
1481 String t;
1482 Bool all; {
1483     if (nonNull(mod)) {
1484         Cell cs;
1485         if (nonNull(t))
1486             Printf("module %s where\n",textToStr(module(mod).text));
1487         for (cs = module(mod).names; nonNull(cs); cs=tl(cs)) {
1488             Name nm = hd(cs);
1489             /* only look at things defined in this module,
1490                unless `all' flag is set */
1491             if (all || name(nm).mod == mod) {
1492                 /* unwanted artifacts, like lambda lifted values,
1493                    are in the list of names, but have no types */
1494                 if (nonNull(name(nm).type)) {
1495                     printExp(stdout,nm);
1496                     Printf(" :: ");
1497                     printType(stdout,name(nm).type);
1498                     if (isCfun(nm)) {
1499                         Printf("  -- data constructor");
1500                     } else if (isMfun(nm)) {
1501                         Printf("  -- class member");
1502                     } else if (isSfun(nm)) {
1503                         Printf("  -- selector function");
1504                     }
1505                     Printf("\n");
1506                 }
1507             }
1508         }
1509     } else {
1510       if (isNull(mod)) {
1511         Printf("Unknown module %s\n",t);
1512       }
1513     }
1514 }
1515
1516 static Void local browse() {            /* browse modules                  */
1517     Int    count = 0;                   /* or give menu of commands        */
1518     String s;
1519     Bool all = FALSE;
1520
1521     setCurrModule(findEvalModule());
1522     startNewScript(0);                  /* for recovery of storage         */
1523     for (; (s=readFilename())!=0; count++)
1524         if (strcmp(s,"all") == 0) {
1525             all = TRUE;
1526             --count;
1527         } else
1528             browseit(findModule(findText(s)),s,all);
1529     if (count == 0) {
1530         browseit(findEvalModule(),NULL,all);
1531     }
1532 }
1533
1534 #if EXPLAIN_INSTANCE_RESOLUTION
1535 static Void local xplain() {         /* print type of expression (if any)*/
1536     Cell d;
1537     Bool sir = showInstRes;
1538
1539     setCurrModule(findEvalModule());
1540     startNewScript(0);                 /* Enables recovery of storage      */
1541                                        /* allocated during evaluation      */
1542     parseContext();
1543     checkContext();
1544     showInstRes = TRUE;
1545     d = provePred(NIL,NIL,hd(inputContext));
1546     if (isNull(d)) {
1547         fprintf(stdout, "not Sat\n");
1548     } else {
1549         fprintf(stdout, "Sat\n");
1550     }
1551     showInstRes = sir;
1552 }
1553 #endif
1554
1555 /* --------------------------------------------------------------------------
1556  * Enhanced help system:  print current list of scripts or give information
1557  * about an object.
1558  * ------------------------------------------------------------------------*/
1559
1560 static String local objToStr(m,c)
1561 Module m;
1562 Cell   c; {
1563 #if 1 || DISPLAY_QUANTIFIERS
1564     static char newVar[60];
1565     switch (whatIs(c)) {
1566         case NAME  : if (m == name(c).mod) {
1567                          sprintf(newVar,"%s", textToStr(name(c).text));
1568                      } else {
1569                          sprintf(newVar,"%s.%s",
1570                                         textToStr(module(name(c).mod).text),
1571                                         textToStr(name(c).text));
1572                      }
1573                      break;
1574
1575         case TYCON : if (m == tycon(c).mod) {
1576                          sprintf(newVar,"%s", textToStr(tycon(c).text));
1577                      } else {
1578                          sprintf(newVar,"%s.%s",
1579                                         textToStr(module(tycon(c).mod).text),
1580                                         textToStr(tycon(c).text));
1581                      }
1582                      break;
1583
1584         case CLASS : if (m == cclass(c).mod) {
1585                          sprintf(newVar,"%s", textToStr(cclass(c).text));
1586                      } else {
1587                          sprintf(newVar,"%s.%s",
1588                                         textToStr(module(cclass(c).mod).text),
1589                                         textToStr(cclass(c).text));
1590                      }
1591                      break;
1592
1593         default    : internal("objToStr");
1594     }
1595     return newVar;
1596 #else
1597     static char newVar[33];
1598     switch (whatIs(c)) {
1599         case NAME  : sprintf(newVar,"%s", textToStr(name(c).text));
1600                      break;
1601
1602         case TYCON : sprintf(newVar,"%s", textToStr(tycon(c).text));
1603                      break;
1604
1605         case CLASS : sprintf(newVar,"%s", textToStr(cclass(c).text));
1606                      break;
1607
1608         default    : internal("objToStr");
1609     }
1610     return newVar;
1611 #endif
1612 }
1613
1614 extern Name nameHw;
1615
1616 static Void dumpStg ( void )
1617 {
1618    String s;
1619    Int i;
1620    setCurrModule(findEvalModule());
1621    startNewScript(0);
1622    s = readFilename();
1623
1624    /* request to locate a symbol by name */
1625    if (s && (*s == '?')) {
1626       Text t = findText(s+1);
1627       locateSymbolByName(t);
1628       return;
1629    }
1630
1631    /* request to dump a bit of the heap */
1632    if (s && (*s == '-' || isdigit(*s))) {
1633       int i = atoi(s);
1634       print(i,100);
1635       printf("\n");
1636       return;
1637    }
1638
1639    /* request to dump a symbol table entry */
1640    if (!s
1641        || !(*s == 't' || *s == 'n' || *s == 'c' || *s == 'i')
1642        || !isdigit(s[1])) {
1643       fprintf(stderr, ":d -- bad request `%s'\n", s );
1644       return;
1645    }
1646    i = atoi(s+1);
1647    switch (*s) {
1648       case 't': dumpTycon(i); break;
1649       case 'n': dumpName(i); break;
1650       case 'c': dumpClass(i); break;
1651       case 'i': dumpInst(i); break;
1652       default: fprintf(stderr, ":d -- `%c' not implemented\n", *s );
1653    }
1654 }
1655
1656
1657 #if 0
1658 static Void local dumpStg( void ) {       /* print STG stuff                 */
1659     String s;
1660     Text   t;
1661     Name   n;
1662     Int    i;
1663     Cell   v;                           /* really StgVar */
1664     setCurrModule(findEvalModule());
1665     startNewScript(0);
1666     for (; (s=readFilename())!=0;) {
1667         t = findText(s);
1668         v = n = NIL;
1669         /* find the name while ignoring module scopes */
1670         for (i=NAMEMIN; i<nameHw; i++)
1671            if (name(i).text == t) n = i;
1672
1673         /* perhaps it's an "idNNNNNN" thing? */
1674         if (isNull(n) &&
1675             strlen(s) >= 3 &&
1676             s[0]=='i' && s[1]=='d' && isdigit(s[2])) {
1677            v = 0;
1678            i = 2;
1679            while (isdigit(s[i])) {
1680               v = v * 10 + (s[i]-'0');
1681               i++;
1682            }
1683            v = -v;
1684            n = nameFromStgVar(v);
1685         }
1686
1687         if (isNull(n) && whatIs(v)==STGVAR) {
1688            Printf ( "\n{- `%s' has no nametable entry -}\n", s );
1689            printStg(stderr, v );
1690         } else
1691         if (isNull(n)) {
1692            Printf ( "Unknown reference `%s'\n", s );
1693         } else
1694         if (!isName(n)) {
1695            Printf ( "Not a Name: `%s'\n", s );
1696         } else
1697         if (isNull(name(n).stgVar)) {
1698            Printf ( "Doesn't have a STG tree: %s\n", s );
1699         } else {
1700            Printf ( "\n{- stgVar of `%s' is id%d -}\n", s, -name(n).stgVar);
1701            printStg(stderr, name(n).stgVar);
1702         }
1703     }
1704 }
1705 #endif
1706
1707 static Void local info() {              /* describe objects                */
1708     Int    count = 0;                   /* or give menu of commands        */
1709     String s;
1710
1711     setCurrModule(findEvalModule());
1712     startNewScript(0);                  /* for recovery of storage         */
1713     for (; (s=readFilename())!=0; count++) {
1714         describe(findText(s));
1715     }
1716     if (count == 0) {
1717         whatScripts();
1718     }
1719 }
1720
1721
1722 static Void local describe(t)           /* describe an object              */
1723 Text t; {
1724     Tycon  tc  = findTycon(t);
1725     Class  cl  = findClass(t);
1726     Name   nm  = findName(t);
1727
1728     if (nonNull(tc)) {                  /* as a type constructor           */
1729         Type t = tc;
1730         Int  i;
1731         Inst in;
1732         for (i=0; i<tycon(tc).arity; ++i) {
1733             t = ap(t,mkOffset(i));
1734         }
1735         Printf("-- type constructor");
1736         if (kindExpert) {
1737             Printf(" with kind ");
1738             printKind(stdout,tycon(tc).kind);
1739         }
1740         Putchar('\n');
1741         switch (tycon(tc).what) {
1742             case SYNONYM      : Printf("type ");
1743                                 printType(stdout,t);
1744                                 Printf(" = ");
1745                                 printType(stdout,tycon(tc).defn);
1746                                 break;
1747
1748             case NEWTYPE      :
1749             case DATATYPE     : {   List cs = tycon(tc).defn;
1750                                     if (tycon(tc).what==DATATYPE) {
1751                                         Printf("data ");
1752                                     } else {
1753                                         Printf("newtype ");
1754                                     }
1755                                     printType(stdout,t);
1756                                     Putchar('\n');
1757                                     mapProc(printSyntax,cs);
1758                                     if (hasCfun(cs)) {
1759                                         Printf("\n-- constructors:");
1760                                     }
1761                                     for (; hasCfun(cs); cs=tl(cs)) {
1762                                         Putchar('\n');
1763                                         printExp(stdout,hd(cs));
1764                                         Printf(" :: ");
1765                                         printType(stdout,name(hd(cs)).type);
1766                                     }
1767                                     if (nonNull(cs)) {
1768                                         Printf("\n-- selectors:");
1769                                     }
1770                                     for (; nonNull(cs); cs=tl(cs)) {
1771                                         Putchar('\n');
1772                                         printExp(stdout,hd(cs));
1773                                         Printf(" :: ");
1774                                         printType(stdout,name(hd(cs)).type);
1775                                     }
1776                                 }
1777                                 break;
1778
1779             case RESTRICTSYN  : Printf("type ");
1780                                 printType(stdout,t);
1781                                 Printf(" = <restricted>");
1782                                 break;
1783         }
1784         Putchar('\n');
1785         if (nonNull(in=findFirstInst(tc))) {
1786             Printf("\n-- instances:\n");
1787             do {
1788                 showInst(in);
1789                 in = findNextInst(tc,in);
1790             } while (nonNull(in));
1791         }
1792         Putchar('\n');
1793     }
1794
1795     if (nonNull(cl)) {                  /* as a class                      */
1796         List  ins = cclass(cl).instances;
1797         Kinds ks  = cclass(cl).kinds;
1798         if (nonNull(ks) && isNull(tl(ks)) && hd(ks)==STAR) {
1799             Printf("-- type class");
1800         } else {
1801             Printf("-- constructor class");
1802             if (kindExpert) {
1803                 Printf(" with arity ");
1804                 printKinds(stdout,ks);
1805             }
1806         }
1807         Putchar('\n');
1808         mapProc(printSyntax,cclass(cl).members);
1809         Printf("class ");
1810         if (nonNull(cclass(cl).supers)) {
1811             printContext(stdout,cclass(cl).supers);
1812             Printf(" => ");
1813         }
1814         printPred(stdout,cclass(cl).head);
1815
1816         if (nonNull(cclass(cl).fds)) {
1817             List   fds = cclass(cl).fds;
1818             String pre = " | ";
1819             for (; nonNull(fds); fds=tl(fds)) {
1820                 Printf(pre);
1821                 printFD(stdout,hd(fds));
1822                 pre = ", ";
1823             }
1824         }
1825
1826         if (nonNull(cclass(cl).members)) {
1827             List ms = cclass(cl).members;
1828             Printf(" where");
1829             do {
1830                 Type t = name(hd(ms)).type;
1831                 if (isPolyType(t)) {
1832                     t = monotypeOf(t);
1833                 }
1834                 Printf("\n  ");
1835                 printExp(stdout,hd(ms));
1836                 Printf(" :: ");
1837                 if (isNull(tl(fst(snd(t))))) {
1838                     t = snd(snd(t));
1839                 } else {
1840                     t = ap(QUAL,pair(tl(fst(snd(t))),snd(snd(t))));
1841                 }
1842                 printType(stdout,t);
1843                 ms = tl(ms);
1844             } while (nonNull(ms));
1845         }
1846         Putchar('\n');
1847         if (nonNull(ins)) {
1848             Printf("\n-- instances:\n");
1849             do {
1850                 showInst(hd(ins));
1851                 ins = tl(ins);
1852             } while (nonNull(ins));
1853         }
1854         Putchar('\n');
1855     }
1856
1857     if (nonNull(nm)) {                  /* as a function/name              */
1858         printSyntax(nm);
1859         printExp(stdout,nm);
1860         Printf(" :: ");
1861         if (nonNull(name(nm).type)) {
1862             printType(stdout,name(nm).type);
1863         } else {
1864             Printf("<unknown type>");
1865         }
1866         if (isCfun(nm)) {
1867             Printf("  -- data constructor");
1868         } else if (isMfun(nm)) {
1869             Printf("  -- class member");
1870         } else if (isSfun(nm)) {
1871             Printf("  -- selector function");
1872         }
1873         Printf("\n\n");
1874     }
1875
1876
1877     if (isNull(tc) && isNull(cl) && isNull(nm)) {
1878         Printf("Unknown reference `%s'\n",textToStr(t));
1879     }
1880 }
1881
1882 static Void local printSyntax(nm)
1883 Name nm; {
1884     Syntax sy = syntaxOf(nm);
1885     Text   t  = name(nm).text;
1886     String s  = textToStr(t);
1887     if (sy != defaultSyntax(t)) {
1888         Printf("infix");
1889         switch (assocOf(sy)) {
1890             case LEFT_ASS  : Putchar('l'); break;
1891             case RIGHT_ASS : Putchar('r'); break;
1892             case NON_ASS   : break;
1893         }
1894         Printf(" %i ",precOf(sy));
1895         if (isascii((int)(*s)) && isalpha((int)(*s))) {
1896             Printf("`%s`",s);
1897         } else {
1898             Printf("%s",s);
1899         }
1900         Putchar('\n');
1901     }
1902 }
1903
1904 static Void local showInst(in)          /* Display instance decl header    */
1905 Inst in; {
1906     Printf("instance ");
1907     if (nonNull(inst(in).specifics)) {
1908         printContext(stdout,inst(in).specifics);
1909         Printf(" => ");
1910     }
1911     printPred(stdout,inst(in).head);
1912     Putchar('\n');
1913 }
1914
1915 /* --------------------------------------------------------------------------
1916  * List all names currently in scope:
1917  * ------------------------------------------------------------------------*/
1918
1919 static Void local listNames() {         /* list names matching optional pat*/
1920     String pat   = readFilename();
1921     List   names = NIL;
1922     Int    width = getTerminalWidth() - 1;
1923     Int    count = 0;
1924     Int    termPos;
1925     Module mod   = findEvalModule();
1926
1927     if (pat) {                          /* First gather names to list      */
1928         do {
1929             names = addNamesMatching(pat,names);
1930         } while ((pat=readFilename())!=0);
1931     } else {
1932         names = addNamesMatching((String)0,names);
1933     }
1934     if (isNull(names)) {                /* Then print them out             */
1935         ERRMSG(0) "No names selected"
1936         EEND;
1937     }
1938     for (termPos=0; nonNull(names); names=tl(names)) {
1939         String s = objToStr(mod,hd(names));
1940         Int    l = strlen(s);
1941         if (termPos+1+l>width) {
1942             Putchar('\n');
1943             termPos = 0;
1944         } else if (termPos>0) {
1945             Putchar(' ');
1946             termPos++;
1947         }
1948         Printf("%s",s);
1949         termPos += l;
1950         count++;
1951     }
1952     Printf("\n(%d names listed)\n", count);
1953 }
1954
1955 /* --------------------------------------------------------------------------
1956  * print a prompt and read a line of input:
1957  * ------------------------------------------------------------------------*/
1958
1959 static Void local promptForInput(moduleName)
1960 String moduleName; {
1961     char promptBuffer[1000];
1962 #if 1
1963     /* This is portable but could overflow buffer */
1964     sprintf(promptBuffer,prompt,moduleName);
1965 #else
1966     /* Works on ANSI C - but pre-ANSI compilers return a pointer to
1967      * promptBuffer instead.
1968      */
1969     if (sprintf(promptBuffer,prompt,moduleName) >= 1000) {
1970         /* Reset prompt to a safe default to avoid an infinite loop */
1971         free(prompt);
1972         prompt = strCopy("? ");
1973         internal("Combined prompt and evaluation module name too long");
1974     }
1975 #endif
1976     if (autoMain)
1977        stringInput("main\0"); else
1978        consoleInput(promptBuffer);
1979 }
1980
1981 /* --------------------------------------------------------------------------
1982  * main read-eval-print loop, with error trapping:
1983  * ------------------------------------------------------------------------*/
1984
1985 static jmp_buf catch_error;             /* jump buffer for error trapping  */
1986
1987 static Void local interpreter(argc,argv)/* main interpreter loop           */
1988 Int    argc;
1989 String argv[]; {
1990     Int errorNumber = setjmp(catch_error);
1991
1992     if (errorNumber && autoMain) {
1993        fprintf(stderr, "hugs +Q: compilation failed -- can't run `main'\n" );
1994        exit(1);
1995     }
1996
1997     breakOn(TRUE);                      /* enable break trapping           */
1998     if (numScripts==0) {                /* only succeeds on first time,    */
1999         if (errorNumber)                /* before prelude has been loaded  */
2000             fatal("Unable to load prelude");
2001         initialize(argc,argv);
2002         forHelp();
2003     }
2004
2005     /* initialize calls startupHaskell, which trashes our signal handlers */
2006     breakOn(TRUE);
2007
2008     for (;;) {
2009         Command cmd;
2010         everybody(RESET);               /* reset to sensible initial state */
2011         dropScriptsFrom(numScripts-1);  /* remove partially loaded scripts */
2012                                         /* not counting prelude as a script*/
2013
2014         promptForInput(textToStr(module(findEvalModule()).text));
2015
2016         cmd = readCommand(cmds, (Char)':', (Char)'!');
2017 #ifdef WANT_TIMER
2018         updateTimers();
2019 #endif
2020         switch (cmd) {
2021             case EDIT   : editor();
2022                           break;
2023             case FIND   : find();
2024                           break;
2025             case LOAD   : clearProject();
2026                           forgetScriptsFrom(N_PRELUDE_SCRIPTS);
2027                           load();
2028                           break;
2029             case ALSO   : clearProject();
2030                           forgetScriptsFrom(numScripts);
2031                           load();
2032                           break;
2033             case RELOAD : readScripts(N_PRELUDE_SCRIPTS);
2034                           break;
2035             case PROJECT: project();
2036                           break;
2037             case SETMODULE :
2038                           setModule();
2039                           break;
2040             case EVAL   : evaluator();
2041                           break;
2042             case TYPEOF : showtype();
2043                           break;
2044             case BROWSE : browse();
2045                           break;
2046 #if EXPLAIN_INSTANCE_RESOLUTION
2047             case XPLAIN : xplain();
2048                           break;
2049 #endif
2050             case NAMES  : listNames();
2051                           break;
2052             case HELP   : menu();
2053                           break;
2054             case BADCMD : guidance();
2055                           break;
2056             case SET    : set();
2057                           break;
2058             case STATS:
2059 #ifdef CRUDE_PROFILING
2060                           cp_show();
2061 #endif
2062                           break;
2063             case SYSTEM : if (shellEsc(readLine()))
2064                               Printf("Warning: Shell escape terminated abnormally\n");
2065                           break;
2066             case CHGDIR : changeDir();
2067                           break;
2068             case INFO   : info();
2069                           break;
2070             case PNTVER: Printf("-- Hugs Version %s\n",
2071                                  HUGS_VERSION);
2072                           break;
2073             case DUMP   : dumpStg();
2074                           break;
2075             case QUIT   : return;
2076             case COLLECT: consGC = FALSE;
2077                           garbageCollect();
2078                           consGC = TRUE;
2079                           Printf("Garbage collection recovered %d cells\n",
2080                                  cellsRecovered);
2081                           break;
2082             case NOCMD  : break;
2083         }
2084 #ifdef WANT_TIMER
2085         updateTimers();
2086         Printf("Elapsed time (ms): %ld (user), %ld (system)\n",
2087                millisecs(userElapsed), millisecs(systElapsed));
2088 #endif
2089         if (autoMain) break;
2090     }
2091     breakOn(FALSE);
2092 }
2093
2094 /* --------------------------------------------------------------------------
2095  * Display progress towards goal:
2096  * ------------------------------------------------------------------------*/
2097
2098 static Target currTarget;
2099 static Bool   aiming = FALSE;
2100 static Int    currPos;
2101 static Int    maxPos;
2102 static Int    charCount;
2103
2104 Void setGoal(what, t)                  /* Set goal for what to be t        */
2105 String what;
2106 Target t; {
2107     if (quiet)
2108       return;
2109 #if EXPLAIN_INSTANCE_RESOLUTION
2110     if (showInstRes)
2111       return;
2112 #endif
2113     currTarget = (t?t:1);
2114     aiming     = TRUE;
2115     if (useDots) {
2116         currPos = strlen(what);
2117         maxPos  = getTerminalWidth() - 1;
2118         Printf("%s",what);
2119     }
2120     else
2121         for (charCount=0; *what; charCount++)
2122             Putchar(*what++);
2123     FlushStdout();
2124 }
2125
2126 Void soFar(t)                          /* Indicate progress towards goal   */
2127 Target t; {                            /* has now reached t                */
2128     if (quiet)
2129       return;
2130 #if EXPLAIN_INSTANCE_RESOLUTION
2131     if (showInstRes)
2132       return;
2133 #endif
2134     if (useDots) {
2135         Int newPos = (Int)((maxPos * ((long)t))/currTarget);
2136
2137         if (newPos>maxPos)
2138             newPos = maxPos;
2139
2140         if (newPos>currPos) {
2141             do
2142                 Putchar('.');
2143             while (newPos>++currPos);
2144             FlushStdout();
2145         }
2146         FlushStdout();
2147     }
2148 }
2149
2150 Void done() {                          /* Goal has now been achieved       */
2151     if (quiet)
2152       return;
2153 #if EXPLAIN_INSTANCE_RESOLUTION
2154     if (showInstRes)
2155       return;
2156 #endif
2157     if (useDots) {
2158         while (maxPos>currPos++)
2159             Putchar('.');
2160         Putchar('\n');
2161     }
2162     else
2163         for (; charCount>0; charCount--) {
2164             Putchar('\b');
2165             Putchar(' ');
2166             Putchar('\b');
2167         }
2168     aiming = FALSE;
2169     FlushStdout();
2170 }
2171
2172 static Void local failed() {           /* Goal cannot be reached due to    */
2173     if (aiming) {                      /* errors                           */
2174         aiming = FALSE;
2175         Putchar('\n');
2176         FlushStdout();
2177     }
2178 }
2179
2180 /* --------------------------------------------------------------------------
2181  * Error handling:
2182  * ------------------------------------------------------------------------*/
2183
2184 Void errHead(l)                        /* print start of error message     */
2185 Int l; {
2186     failed();                          /* failed to reach target ...       */
2187     stopAnyPrinting();
2188     FPrintf(errorStream,"ERROR");
2189
2190     if (scriptFile) {
2191         FPrintf(errorStream," \"%s\"", scriptFile);
2192         setLastEdit(scriptFile,l);
2193         if (l) FPrintf(errorStream," (line %d)",l);
2194         scriptFile = 0;
2195     }
2196     FPrintf(errorStream,": ");
2197     FFlush(errorStream);
2198 }
2199
2200 Void errFail() {                        /* terminate error message and     */
2201     Putc('\n',errorStream);             /* produce exception to return to  */
2202     FFlush(errorStream);                /* main command loop               */
2203     longjmp(catch_error,1);
2204 }
2205
2206 Void errAbort() {                       /* altern. form of error handling  */
2207     failed();                           /* used when suitable error message*/
2208     stopAnyPrinting();                  /* has already been printed        */
2209     errFail();
2210 }
2211
2212 Void internal(msg)                      /* handle internal error           */
2213 String msg; {
2214 #if HUGS_FOR_WINDOWS
2215     char buf[300];
2216     wsprintf(buf,"INTERNAL ERROR: %s",msg);
2217     MessageBox(hWndMain, buf, appName, MB_ICONHAND | MB_OK);
2218 #endif
2219     failed();
2220     stopAnyPrinting();
2221     Printf("INTERNAL ERROR: %s\n",msg);
2222     FlushStdout();
2223     longjmp(catch_error,1);
2224 }
2225
2226 Void fatal(msg)                         /* handle fatal error              */
2227 String msg; {
2228 #if HUGS_FOR_WINDOWS
2229     char buf[300];
2230     wsprintf(buf,"FATAL ERROR: %s",msg);
2231     MessageBox(hWndMain, buf, appName, MB_ICONHAND | MB_OK);
2232 #endif
2233     FlushStdout();
2234     Printf("\nFATAL ERROR: %s\n",msg);
2235     everybody(EXIT);
2236     exit(1);
2237 }
2238
2239 sigHandler(breakHandler) {              /* respond to break interrupt      */
2240 #if HUGS_FOR_WINDOWS
2241     MessageBox(GetFocus(), "Interrupted!", appName, MB_ICONSTOP | MB_OK);
2242 #endif
2243     Hilite();
2244     Printf("{Interrupted!}\n");
2245     Lolite();
2246     breakOn(TRUE);  /* reinstall signal handler - redundant on BSD systems */
2247                     /* but essential on POSIX (and other?) systems         */
2248     everybody(BREAK);
2249     failed();
2250     stopAnyPrinting();
2251     FlushStdout();
2252     clearerr(stdin);
2253     longjmp(catch_error,1);
2254     sigResume;/*NOTREACHED*/
2255 }
2256
2257 /* --------------------------------------------------------------------------
2258  * Read value from environment variable or registry:
2259  * ------------------------------------------------------------------------*/
2260
2261 String fromEnv(var,def)         /* return value of:                        */
2262 String var;                     /*     environment variable named by var   */
2263 String def; {                   /* or: default value given by def          */
2264     String s = getenv(var);
2265     return (s ? s : def);
2266 }
2267
2268 /* --------------------------------------------------------------------------
2269  * String manipulation routines:
2270  * ------------------------------------------------------------------------*/
2271
2272 static String local strCopy(s)         /* make malloced copy of a string   */
2273 String s; {
2274     if (s && *s) {
2275         char *t, *r;
2276         if ((t=(char *)malloc(strlen(s)+1))==0) {
2277             ERRMSG(0) "String storage space exhausted"
2278             EEND;
2279         }
2280         for (r=t; (*r++ = *s++)!=0; ) {
2281         }
2282         return t;
2283     }
2284     return NULL;
2285 }
2286
2287 /* --------------------------------------------------------------------------
2288  * Compiler output
2289  * We can redirect compiler output (prompts, error messages, etc) by
2290  * tweaking these functions.
2291  * ------------------------------------------------------------------------*/
2292
2293 #if REDIRECT_OUTPUT && !HUGS_FOR_WINDOWS
2294
2295 #ifdef HAVE_STDARG_H
2296 #include <stdarg.h>
2297 #else
2298 #include <varargs.h>
2299 #endif
2300
2301 /* ----------------------------------------------------------------------- */
2302
2303 #define BufferSize 10000              /* size of redirected output buffer  */
2304
2305 typedef struct _HugsStream {
2306     char buffer[BufferSize];          /* buffer for redirected output      */
2307     Int  next;                        /* next space in buffer              */
2308 } HugsStream;
2309
2310 static Void   local vBufferedPrintf  Args((HugsStream*, const char*, va_list));
2311 static Void   local bufferedPutchar  Args((HugsStream*, Char));
2312 static String local bufferClear      Args((HugsStream *stream));
2313
2314 static Void local vBufferedPrintf(stream, fmt, ap)
2315 HugsStream* stream;
2316 const char* fmt;
2317 va_list     ap; {
2318     Int spaceLeft = BufferSize - stream->next;
2319     char* p = &stream->buffer[stream->next];
2320     Int charsAdded = vsnprintf(p, spaceLeft, fmt, ap);
2321     if (0 <= charsAdded && charsAdded < spaceLeft)
2322         stream->next += charsAdded;
2323 #if 1 /* we can either buffer the first n chars or buffer the last n chars */
2324     else
2325         stream->next = 0;
2326 #endif
2327 }
2328
2329 static Void local bufferedPutchar(stream, c)
2330 HugsStream *stream;
2331 Char        c; {
2332     if (BufferSize - stream->next >= 2) {
2333         stream->buffer[stream->next++] = c;
2334         stream->buffer[stream->next] = '\0';
2335     }
2336 }
2337
2338 static String local bufferClear(stream)
2339 HugsStream *stream; {
2340     if (stream->next == 0) {
2341         return "";
2342     } else {
2343         stream->next = 0;
2344         return stream->buffer;
2345     }
2346 }
2347
2348 /* ----------------------------------------------------------------------- */
2349
2350 static HugsStream outputStreamH;
2351 /* ADR note:
2352  * We rely on standard C semantics to initialise outputStreamH.next to 0.
2353  */
2354
2355 Void hugsEnableOutput(f)
2356 Bool f; {
2357     disableOutput = !f;
2358 }
2359
2360 String hugsClearOutputBuffer() {
2361     return bufferClear(&outputStreamH);
2362 }
2363
2364 #ifdef HAVE_STDARG_H
2365 Void hugsPrintf(const char *fmt, ...) {
2366     va_list ap;                    /* pointer into argument list           */
2367     va_start(ap, fmt);             /* make ap point to first arg after fmt */
2368     if (!disableOutput) {
2369         vprintf(fmt, ap);
2370     } else {
2371         vBufferedPrintf(&outputStreamH, fmt, ap);
2372     }
2373     va_end(ap);                    /* clean up                             */
2374 }
2375 #else
2376 Void hugsPrintf(fmt, va_alist)
2377 const char *fmt;
2378 va_dcl {
2379     va_list ap;                    /* pointer into argument list           */
2380     va_start(ap);                  /* make ap point to first arg after fmt */
2381     if (!disableOutput) {
2382         vprintf(fmt, ap);
2383     } else {
2384         vBufferedPrintf(&outputStreamH, fmt, ap);
2385     }
2386     va_end(ap);                    /* clean up                             */
2387 }
2388 #endif
2389
2390 Void hugsPutchar(c)
2391 int c; {
2392     if (!disableOutput) {
2393         putchar(c);
2394     } else {
2395         bufferedPutchar(&outputStreamH, c);
2396     }
2397 }
2398
2399 Void hugsFlushStdout() {
2400     if (!disableOutput) {
2401         fflush(stdout);
2402     }
2403 }
2404
2405 Void hugsFFlush(fp)
2406 FILE* fp; {
2407     if (!disableOutput) {
2408         fflush(fp);
2409     }
2410 }
2411
2412 #ifdef HAVE_STDARG_H
2413 Void hugsFPrintf(FILE *fp, const char* fmt, ...) {
2414     va_list ap;
2415     va_start(ap, fmt);
2416     if (!disableOutput) {
2417         vfprintf(fp, fmt, ap);
2418     } else {
2419         vBufferedPrintf(&outputStreamH, fmt, ap);
2420     }
2421     va_end(ap);
2422 }
2423 #else
2424 Void hugsFPrintf(FILE *fp, const char* fmt, va_list)
2425 FILE* fp;
2426 const char* fmt;
2427 va_dcl {
2428     va_list ap;
2429     va_start(ap);
2430     if (!disableOutput) {
2431         vfprintf(fp, fmt, ap);
2432     } else {
2433         vBufferedPrintf(&outputStreamH, fmt, ap);
2434     }
2435     va_end(ap);
2436 }
2437 #endif
2438
2439 Void hugsPutc(c, fp)
2440 int   c;
2441 FILE* fp; {
2442     if (!disableOutput) {
2443         putc(c,fp);
2444     } else {
2445         bufferedPutchar(&outputStreamH, c);
2446     }
2447 }
2448
2449 #endif /* REDIRECT_OUTPUT && !HUGS_FOR_WINDOWS */
2450 /* --------------------------------------------------------------------------
2451  * Send message to each component of system:
2452  * ------------------------------------------------------------------------*/
2453
2454 Void everybody(what)            /* send command `what' to each component of*/
2455 Int what; {                     /* system to respond as appropriate ...    */
2456 #if 0
2457   fprintf ( stderr, "EVERYBODY %d\n", what );
2458 #endif
2459     machdep(what);              /* The order of calling each component is  */
2460     storage(what);              /* important for the PREPREL command       */
2461     substitution(what);
2462     input(what);
2463     translateControl(what);
2464     linkControl(what);
2465     staticAnalysis(what);
2466     deriveControl(what);
2467     typeChecker(what);
2468     compiler(what);
2469     codegen(what);
2470 }
2471
2472 /* --------------------------------------------------------------------------
2473  * Hugs for Windows code (WinMain and related functions)
2474  * ------------------------------------------------------------------------*/
2475
2476 #if HUGS_FOR_WINDOWS
2477 #include "winhugs.c"
2478 #endif