ghc/interpreter/hugs.c

   1 /* -*- mode: hugs-c; -*- */
   2 /* --------------------------------------------------------------------------
   3  * Command interpreter
   4  *
   5  * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
   6  * All rights reserved. See NOTICE for details and conditions of use etc...
   7  * Hugs version 1.4, December 1997
   8  *
   9  * $RCSfile: hugs.c,v $
  10  * $Revision: 1.2 $
  11  * $Date: 1998/12/02 13:22:09 $
  12  * ------------------------------------------------------------------------*/
  13
  14 #include "prelude.h"
  15 #include "version.h"
  16 #include "storage.h"
  17 #include "command.h"
  18 #include "connect.h"
  19 #include "charset.h"
  20 #include "input.h"
  21 #include "type.h"
  22 #include "subst.h"  /* for typeMatches                        */
  23 #include "link.h"   /* for classShow, nameRunIO and namePrint */
  24 #include "static.h"
  25 #include "compiler.h"
  26 #include "interface.h"
  27 #include "hugs.h"
  28 #include "errors.h"
  29 #include <setjmp.h>
  30 #include <ctype.h>
  31
  32 #include <stdio.h>
  33
  34 #include "machdep.h"
  35
  36 /* --------------------------------------------------------------------------
  37  * Local function prototypes:
  38  * ------------------------------------------------------------------------*/
  39
  40 static Void   local initialize        Args((Int,String []));
  41 static Void   local promptForInput    Args((String));
  42 static Void   local interpreter       Args((Int,String []));
  43 static Void   local menu              Args((Void));
  44 static Void   local guidance          Args((Void));
  45 static Void   local forHelp           Args((Void));
  46 static Void   local set               Args((Void));
  47 static Void   local changeDir         Args((Void));
  48 static Void   local load              Args((Void));
  49 static Void   local project           Args((Void));
  50 static Void   local readScripts       Args((Int));
  51 static Void   local whatScripts       Args((Void));
  52 static Void   local editor            Args((Void));
  53 static Void   local find              Args((Void));
  54 static Void   local runEditor         Args((Void));
  55 static Void   local setModule         Args((Void));
  56 static Module local findEvalModule    Args((Void));
  57 static Void   local evaluator         Args((Void));
  58 static Void   local showtype          Args((Void));
  59 static Void   local info              Args((Void));
  60 static Void   local showInst          Args((Inst));
  61 static Void   local describe          Args((Text));
  62 static Void   local listNames         Args((Void));
  63
  64 static Void   local toggleSet         Args((Char,Bool));
  65 static Void   local togglesIn         Args((Bool));
  66 static Void   local optionInfo        Args((Void));
  67 #if USE_REGISTRY || HUGS_FOR_WINDOWS
  68 static String local optionsToStr      Args((Void));
  69 #endif
  70 static Void   local readOptions       Args((String));
  71 static Bool   local processOption     Args((String));
  72 static Void   local setHeapSize       Args((String));
  73 static Int    local argToInt          Args((String));
  74
  75 static Void   local loadProject       Args((String));
  76 static Void   local clearProject      Args((Void));
  77 static Void   local addScriptName     Args((String,Bool));
  78 static Bool   local addScript         Args((String,Long));
  79 static Void   local forgetScriptsFrom Args((Script));
  80 static Void   local setLastEdit       Args((String,Int));
  81 static Void   local failed            Args((Void));
  82 static String local strCopy           Args((String));
  83
  84 /* --------------------------------------------------------------------------
  85  * Machine dependent code for Hugs interpreter:
  86  * ------------------------------------------------------------------------*/
  87
  88 #ifdef WANT_TIMER
  89 #include "timer.c"
  90 #endif
  91
  92 /* --------------------------------------------------------------------------
  93  * Local data areas:
  94  * ------------------------------------------------------------------------*/
  95
  96 static Bool   listScripts  = TRUE;      /* TRUE => list scripts after loading*/
  97 static Bool   addType      = FALSE;     /* TRUE => print type with value   */
  98 static Bool   chaseImports = TRUE;      /* TRUE => chase imports on load   */
  99 static Bool   useDots      = RISCOS;    /* TRUE => use dots in progress    */
 100 static Bool   quiet        = FALSE;     /* TRUE => don't show progress     */
 101
 102 static String scriptName[NUM_SCRIPTS];  /* Script file names               */
 103 static Time   lastChange[NUM_SCRIPTS];  /* Time of last change to script   */
 104 static Bool   postponed[NUM_SCRIPTS];   /* Indicates postponed load        */
 105 static Int    scriptBase;               /* Number of scripts in Prelude    */
 106 static Int    numScripts;               /* Number of scripts loaded        */
 107 static Int    namesUpto;                /* Number of script names set      */
 108 static Bool   needsImports;             /* set to TRUE if imports required */
 109        String scriptFile;               /* Name of current script (if any) */
 110
 111 static Text   evalModule  = 0;          /* Name of module we eval exprs in */
 112 static String currProject = 0;          /* Name of current project file    */
 113 static Bool   projectLoaded = FALSE;    /* TRUE => project file loaded     */
 114
 115 static String lastEdit   = 0;           /* Name of script to edit (if any) */
 116 static Int    lastLine   = 0;           /* Editor line number (if possible)*/
 117 static String prompt     = 0;           /* Prompt string                   */
 118 static Int    hpSize     = DEFAULTHEAP; /* Desired heap size               */
 119 String hugsEdit = 0;                    /* String for editor command       */
 120 String hugsPath = 0;                    /* String for file search path     */
 121
 122 #if REDIRECT_OUTPUT
 123 static Bool disableOutput = FALSE;      /* redirect output to buffer?      */
 124 #endif
 125
 126 /* --------------------------------------------------------------------------
 127  * Hugs entry point:
 128  * ------------------------------------------------------------------------*/
 129
 130 #ifndef NO_MAIN /* we omit main when building the "Hugs server" */
 131
 132 Main main Args((Int, String []));       /* now every func has a prototype  */
 133
 134 Main main(argc,argv)
 135 int  argc;
 136 char *argv[]; {
 137
 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     /* The startup banner now includes my name.  Hugs is provided free of  */
 158     /* charge.  I ask however that you show your appreciation for the many */
 159     /* hours of work involved by retaining my name in the banner.  Thanks! */
 160
 161 #if SMALL_BANNER
 162     Printf("Hugs 1.4, %s release.\n", HUGS_VERSION);
 163     Printf("Copyright (c) The University of Nottingham and Yale University, 1994-1998.\n");
 164     Printf("Home page: http://haskell.org/hugs.  Bug reports: hugs-bugs@haskell.org.\n");
 165 #else
 166 #ifdef OLD_LOGO
 167     Printf("      ___    ___   ___    ___   __________   __________                        \n");
 168     Printf("     /  /   /  /  /  /   /  /  /  _______/  /  _______/         Hugs 1.4       \n");
 169     Printf("    /  /___/  /  /  /   /  /  /  / _____   /  /______                          \n");
 170     Printf("   /  ____   /  /  /   /  /  /  / /_   /  /______   /  The Nottingham and Yale\n");
 171     Printf("  /  /   /  /  /  /___/  /  /  /___/  /  _______/  /    Haskell User's System \n");
 172     Printf(" /__/   /__/  /_________/  /_________/  /_________/         %s\n\n", HUGS_VERSION);
 173     Printf("Copyright (c) The University of Nottingham and Yale University, 1994-1998.\n");
 174     Printf("Home page: http://haskell.org/hugs.  Bug reports: hugs-bugs@haskell.org.\n");
 175 #else
 176     /* There is now a new banner, designed to draw attention to the fact   */
 177     /* that the version of Hugs being used is substantially different from */
 178     /* previous releases (and to correct the mistaken view that Hugs is    */
 179     /* written in capitals).  If you really prefer the old style banner,   */
 180     /* you can still get it by compiling with -DOLD_LOGO.                  */
 181
 182     printf("  __   __ __  __  ____   ___     __________________________________________\n");
 183     printf("  ||   || ||  || ||  || ||__     Hugs 1.4: The Haskell User's Gofer System\n");
 184     printf("  ||___|| ||__|| ||__||  __||    (c) The University of Nottingham\n");
 185     printf("  ||---||         ___||              and Yale University, 1994-1998.\n");
 186     printf("  ||   ||                        Report bugs to hugs-bugs@haskell.org\n");
 187     printf("  ||   ||     "HUGS_VERSION"      __________________________________________\n\n");
 188 #endif
 189 #endif
 190 #if SYMANTEC_C
 191     Printf("   Ported to Macintosh by Hans Aberg, compiled " __DATE__ ".\n\n");
 192 #endif
 193     FlushStdout();
 194     interpreter(argc,argv);
 195     Printf("[Leaving Hugs]\n");
 196     everybody(EXIT);
 197     FlushStdout();
 198     fflush(stderr);
 199     exit(0);
 200     MainDone();
 201 }
 202
 203 #endif
 204
 205 /* --------------------------------------------------------------------------
 206  * Initialization, interpret command line args and read prelude:
 207  * ------------------------------------------------------------------------*/
 208
 209 static Void local initialize(argc,argv)/* Interpreter initialization       */
 210 Int    argc;
 211 String argv[]; {
 212     Script i;
 213     String proj = 0;
 214
 215     setLastEdit((String)0,0);
 216     lastEdit      = 0;
 217     scriptFile    = 0;
 218     numScripts    = 0;
 219     namesUpto     = 1;
 220     initCharTab();
 221
 222 #if HUGS_FOR_WINDOWS
 223     hugsEdit      = strCopy(fromEnv("EDITOR","c:\\windows\notepad.exe"));
 224 #elif SYMANTEC_C
 225     hugsEdit      = "";
 226 #else
 227     hugsEdit      = strCopy(fromEnv("EDITOR",NULL));
 228 #endif
 229     hugsPath      = strCopy(HUGSPATH);
 230     readOptions("-p\"%s> \" -r$$");
 231 #if USE_REGISTRY
 232     readOptions(readRegString("Options",""));
 233 #endif
 234     readOptions(fromEnv("HUGSFLAGS",""));
 235
 236     for (i=1; i<argc; ++i) {            /* process command line arguments  */
 237         if (strcmp(argv[i],"+")==0 && i+1<argc) {
 238             if (proj) {
 239                 ERRMSG(0) "Multiple project filenames on command line"
 240                 EEND;
 241             } else {
 242                 proj = argv[++i];
 243             }
 244         } else if (!processOption(argv[i])) {
 245             addScriptName(argv[i],TRUE);
 246         }
 247     }
 248     /* ToDo: clean up this hack */
 249     {
 250         static char* my_argv[] = {"Hugs"};
 251         startupHaskell(sizeof(my_argv)/sizeof(char*),my_argv);
 252     }
 253 #ifdef DEBUG
 254     DEBUG_LoadSymbols(argv[0]);
 255 #endif
 256
 257     scriptName[0] = strCopy(findMPathname(NULL,STD_PRELUDE));
 258     if (!scriptName[0]) {
 259         Printf("Prelude not found on current path: \"%s\"\n",
 260                hugsPath ? hugsPath : "");
 261         fatal("Unable to load prelude");
 262     }
 263
 264     everybody(INSTALL);
 265     evalModule = findText("");      /* evaluate wrt last module by default */
 266     if (proj) {
 267         if (namesUpto>1) {
 268             fprintf(stderr,
 269                     "\nUsing project file, ignoring additional filenames\n");
 270         }
 271         loadProject(strCopy(proj));
 272     }
 273     readScripts(0);
 274     scriptBase = numScripts;
 275 }
 276
 277 /* --------------------------------------------------------------------------
 278  * Command line options:
 279  * ------------------------------------------------------------------------*/
 280
 281 struct options {                        /* command line option toggles     */
 282     char   c;                           /* table defined in main app.      */
 283     String description;
 284     Bool   *flag;
 285 };
 286 extern struct options toggle[];
 287
 288 static Void local toggleSet(c,state)    /* Set command line toggle         */
 289 Char c;
 290 Bool state; {
 291     Int i;
 292     for (i=0; toggle[i].c; ++i)
 293         if (toggle[i].c == c) {
 294             *toggle[i].flag = state;
 295             return;
 296         }
 297     ERRMSG(0) "Unknown toggle `%c'", c
 298     EEND;
 299 }
 300
 301 static Void local togglesIn(state)      /* Print current list of toggles in*/
 302 Bool state; {                           /* given state                     */
 303     Int count = 0;
 304     Int i;
 305     for (i=0; toggle[i].c; ++i)
 306         if (*toggle[i].flag == state) {
 307             if (count==0)
 308                 Putchar((char)(state ? '+' : '-'));
 309             Putchar(toggle[i].c);
 310             count++;
 311         }
 312     if (count>0)
 313         Putchar(' ');
 314 }
 315
 316 static Void local optionInfo() {        /* Print information about command */
 317     static String fmts = "%-5s%s\n";    /* line settings                   */
 318     static String fmtc = "%-5c%s\n";
 319     Int    i;
 320
 321     Printf("TOGGLES: groups begin with +/- to turn options on/off resp.\n");
 322     for (i=0; toggle[i].c; ++i)
 323         Printf(fmtc,toggle[i].c,toggle[i].description);
 324
 325     Printf("\nOTHER OPTIONS: (leading + or - makes no difference)\n");
 326     Printf(fmts,"hnum","Set heap size (cannot be changed within Hugs)");
 327     Printf(fmts,"pstr","Set prompt string to str");
 328     Printf(fmts,"rstr","Set repeat last expression string to str");
 329     Printf(fmts,"Pstr","Set search path for modules to str");
 330     Printf(fmts,"Estr","Use editor setting given by str");
 331 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 332     Printf(fmts,"Fstr","Set preprocessor filter to str");
 333 #endif
 334
 335     Printf("\nCurrent settings: ");
 336     togglesIn(TRUE);
 337     togglesIn(FALSE);
 338     Printf("-h%d",heapSize);
 339     Printf(" -p");
 340     printString(prompt);
 341     Printf(" -r");
 342     printString(repeatStr);
 343     Printf("\nSearch path     : -P");
 344     printString(hugsPath);
 345     Printf("\nEditor setting  : -E");
 346     printString(hugsEdit);
 347 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 348     Printf("\nPreprocessor    : -F");
 349     printString(preprocessor);
 350 #endif
 351     Putchar('\n');
 352 }
 353
 354 #if USE_REGISTRY || HUGS_FOR_WINDOWS
 355 #define PUTC(c)                         \
 356     *next++=(c)
 357
 358 #define PUTS(s)                         \
 359     strcpy(next,s);                     \
 360     next+=strlen(next)
 361
 362 #define PUTInt(optc,i)                  \
 363     sprintf(next,"-%c%d",optc,i);       \
 364     next+=strlen(next)
 365
 366 #define PUTStr(c,s)                     \
 367     next=PUTStr_aux(next,c,s)
 368
 369 static String local PUTStr_aux Args((String,Char, String));
 370
 371 static String local PUTStr_aux(next,c,s)
 372 String next;
 373 Char   c;
 374 String s; {
 375     if (s) {
 376         String t = 0;
 377         sprintf(next,"-%c\"",c);
 378         next+=strlen(next);
 379         for(t=s; *t; ++t) {
 380             PUTS(unlexChar(*t,'"'));
 381         }
 382         next+=strlen(next);
 383         PUTS("\" ");
 384     }
 385     return next;
 386 }
 387
 388 static String local optionsToStr() {          /* convert options to string */
 389     static char buffer[2000];
 390     String next = buffer;
 391
 392     Int i;
 393     for (i=0; toggle[i].c; ++i) {
 394         PUTC(*toggle[i].flag ? '+' : '-');
 395         PUTC(toggle[i].c);
 396         PUTC(' ');
 397     }
 398     PUTInt('h',hpSize);  PUTC(' ');
 399     PUTStr('p',prompt);
 400     PUTStr('r',repeatStr);
 401     PUTStr('P',hugsPath);
 402     PUTStr('E',hugsEdit);
 403 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 404     PUTStr('F',preprocessor);
 405 #endif
 406     PUTC('\0');
 407     return buffer;
 408 }
 409 #endif /* USE_REGISTRY */
 410
 411 #undef PUTC
 412 #undef PUTS
 413 #undef PUTInt
 414 #undef PUTStr
 415
 416 static Void local readOptions(options)         /* read options from string */
 417 String options; {
 418     String s;
 419     if (options) {
 420         stringInput(options);
 421         while ((s=readFilename())!=0) {
 422             if (*s && !processOption(s)) {
 423                 ERRMSG(0) "Option string must begin with `+' or `-'"
 424                 EEND;
 425             }
 426         }
 427     }
 428 }
 429
 430 static Bool local processOption(s)      /* process string s for options,   */
 431 String s; {                             /* return FALSE if none found.     */
 432     Bool state;
 433
 434     if (s[0]=='-')
 435         state = FALSE;
 436     else if (s[0]=='+')
 437         state = TRUE;
 438     else
 439         return FALSE;
 440
 441     while (*++s)
 442         switch (*s) {
 443             case 'p' : if (s[1]) {
 444                            if (prompt) free(prompt);
 445                            prompt = strCopy(s+1);
 446                        }
 447                        return TRUE;
 448
 449             case 'r' : if (s[1]) {
 450                            if (repeatStr) free(repeatStr);
 451                            repeatStr = strCopy(s+1);
 452                        }
 453                        return TRUE;
 454
 455             case 'P' : {
 456                            String p = substPath(s+1,hugsPath ? hugsPath : "");
 457                            if (hugsPath) free(hugsPath);
 458                            hugsPath = p;
 459                            return TRUE;
 460                        }
 461
 462             case 'E' : if (hugsEdit) free(hugsEdit);
 463                        hugsEdit = strCopy(s+1);
 464                        return TRUE;
 465
 466 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 467             case 'F' : if (preprocessor) free(preprocessor);
 468                        preprocessor = strCopy(s+1);
 469                        return TRUE;
 470 #endif
 471
 472             case 'h' : setHeapSize(s+1);
 473                        return TRUE;
 474
 475             case 'd' : /* hack */
 476                 {
 477                     extern void setRtsFlags( int x );
 478                     setRtsFlags(argToInt(s+1));
 479                     return TRUE;
 480                 }
 481
 482             default  : toggleSet(*s,state);
 483                        break;
 484         }
 485     return TRUE;
 486 }
 487
 488 static Void local setHeapSize(s)
 489 String s; {
 490     if (s) {
 491         hpSize = argToInt(s);
 492         if (hpSize < MINIMUMHEAP)
 493             hpSize = MINIMUMHEAP;
 494         else if (MAXIMUMHEAP && hpSize > MAXIMUMHEAP)
 495             hpSize = MAXIMUMHEAP;
 496         if (heapBuilt() && hpSize != heapSize) {
 497             /* ToDo: should this use a message box in winhugs? */
 498 #if USE_REGISTRY
 499             FPrintf(stderr,"Change to heap size will not take effect until you rerun Hugs\n");
 500 #else
 501             FPrintf(stderr,"Cannot change heap size\n");
 502 #endif
 503         } else {
 504             heapSize = hpSize;
 505         }
 506     }
 507 }
 508
 509 static Int local argToInt(s)            /* read integer from argument str  */
 510 String s; {
 511     Int    n = 0;
 512     String t = s;
 513
 514     if (*s=='\0' || !isascii(*s) || !isdigit(*s)) {
 515         ERRMSG(0) "Missing integer in option setting \"%s\"", t
 516         EEND;
 517     }
 518
 519     do {
 520         Int d = (*s++) - '0';
 521         if (n > ((MAXPOSINT - d)/10)) {
 522             ERRMSG(0) "Option setting \"%s\" is too large", t
 523             EEND;
 524         }
 525         n     = 10*n + d;
 526     } while (isascii(*s) && isdigit(*s));
 527
 528     if (*s=='K' || *s=='k') {
 529         if (n > (MAXPOSINT/1000)) {
 530             ERRMSG(0) "Option setting \"%s\" is too large", t
 531             EEND;
 532         }
 533         n *= 1000;
 534         s++;
 535     }
 536
 537 #if MAXPOSINT > 1000000                 /* waste of time on 16 bit systems */
 538     if (*s=='M' || *s=='m') {
 539         if (n > (MAXPOSINT/1000000)) {
 540             ERRMSG(0) "Option setting \"%s\" is too large", t
 541             EEND;
 542         }
 543         n *= 1000000;
 544         s++;
 545     }
 546 #endif
 547
 548 #if MAXPOSINT > 1000000000
 549     if (*s=='G' || *s=='g') {
 550         if (n > (MAXPOSINT/1000000000)) {
 551             ERRMSG(0) "Option setting \"%s\" is too large", t
 552             EEND;
 553         }
 554         n *= 1000000000;
 555         s++;
 556     }
 557 #endif
 558
 559     if (*s!='\0') {
 560         ERRMSG(0) "Unwanted characters after option setting \"%s\"", t
 561         EEND;
 562     }
 563
 564     return n;
 565 }
 566
 567 /* --------------------------------------------------------------------------
 568  * Print Menu of list of commands:
 569  * ------------------------------------------------------------------------*/
 570
 571 static struct cmd cmds[] = {
 572  {":?",      HELP},   {":cd",   CHGDIR},  {":also",    ALSO},
 573  {":type",   TYPEOF}, {":!",    SYSTEM},  {":load",    LOAD},
 574  {":reload", RELOAD}, {":gc",   COLLECT}, {":edit",    EDIT},
 575  {":quit",   QUIT},   {":set",  SET},     {":find",    FIND},
 576  {":names",  NAMES},  {":info", INFO},    {":project", PROJECT},
 577  {":module", SETMODULE},
 578  {":version", SHOWVERSION},
 579  {"",      EVAL},
 580  {0,0}
 581 };
 582
 583 static Void local menu() {
 584     Printf("LIST OF COMMANDS:  Any command may be abbreviated to :c where\n");
 585     Printf("c is the first character in the full name.\n\n");
 586     Printf(":load <filenames>   load modules from specified files\n");
 587     Printf(":load               clear all files except prelude\n");
 588     Printf(":also <filenames>   read additional modules\n");
 589     Printf(":reload             repeat last load command\n");
 590     Printf(":project <filename> use project file\n");
 591     Printf(":edit <filename>    edit file\n");
 592     Printf(":edit               edit last module\n");
 593     Printf(":module <module>    set module for evaluating expressions\n");
 594     Printf("<expr>              evaluate expression\n");
 595     Printf(":type <expr>        print type of expression\n");
 596     Printf(":version            show Hugs version\n");
 597     Printf(":?                  display this list of commands\n");
 598     Printf(":set <options>      set command line options\n");
 599     Printf(":set                help on command line options\n");
 600     Printf(":names [pat]        list names currently in scope\n");
 601     Printf(":info <names>       describe named objects\n");
 602     Printf(":find <name>        edit module containing definition of name\n");
 603     Printf(":!command           shell escape\n");
 604     Printf(":cd dir             change directory\n");
 605     Printf(":gc                 force garbage collection\n");
 606     Printf(":quit               exit Hugs interpreter\n");
 607 }
 608
 609 static Void local guidance() {
 610     Printf("Command not recognised.  ");
 611     forHelp();
 612 }
 613
 614 static Void local forHelp() {
 615     Printf("Type :? for help\n");
 616 }
 617
 618 /* --------------------------------------------------------------------------
 619  * Setting of command line options:
 620  * ------------------------------------------------------------------------*/
 621
 622 struct options toggle[] = {             /* List of command line toggles    */
 623     {'t', "Print type after evaluation",           &addType},
 624     {'g', "Print no. cells recovered after gc",    &gcMessages},
 625     {'l', "Literate modules as default",           &literateScripts},
 626     {'e', "Warn about errors in literate modules", &literateErrors},
 627     {'.', "Print dots to show progress",           &useDots},
 628     {'q', "Print nothing to show progress",        &quiet},
 629     {'w', "Always show which modules are loaded",  &listScripts},
 630     {'k', "Show kind errors in full",              &kindExpert},
 631     {'o', "Allow overlapping instances",           &allowOverlap},
 632     {'i', "Chase imports while loading modules",   &chaseImports},
 633 #if DEBUG_CODE
 634     {'D', "Debug: show generated code",            &debugCode},
 635 #endif
 636     {0,   0,                                       0}
 637 };
 638
 639 static Void local set() {               /* change command line options from*/
 640     String s;                           /* Hugs command line               */
 641
 642     if ((s=readFilename())!=0) {
 643         do {
 644             if (!processOption(s)) {
 645                 ERRMSG(0) "Option string must begin with `+' or `-'"
 646                 EEND;
 647             }
 648         } while ((s=readFilename())!=0);
 649 #if USE_REGISTRY
 650         writeRegString("Options", optionsToStr());
 651 #endif
 652     }
 653     else
 654         optionInfo();
 655 }
 656
 657 /* --------------------------------------------------------------------------
 658  * Change directory command:
 659  * ------------------------------------------------------------------------*/
 660
 661 static Void local changeDir() {         /* change directory                */
 662     String s = readFilename();
 663     if (s && chdir(s)) {
 664         ERRMSG(0) "Unable to change to directory \"%s\"", s
 665         EEND;
 666     }
 667 }
 668
 669 /* --------------------------------------------------------------------------
 670  * Loading project and script files:
 671  * ------------------------------------------------------------------------*/
 672
 673 static Void local loadProject(s)        /* Load project file               */
 674 String s; {
 675     clearProject();
 676     currProject = s;
 677     projInput(currProject);
 678     scriptFile = currProject;
 679     forgetScriptsFrom(scriptBase);
 680     while ((s=readFilename())!=0)
 681         addScriptName(s,TRUE);
 682     if (namesUpto<=1) {
 683         ERRMSG(0) "Empty project file"
 684         EEND;
 685     }
 686     scriptFile    = 0;
 687     projectLoaded = TRUE;
 688 }
 689
 690 static Void local clearProject() {      /* clear name for current project  */
 691     if (currProject)
 692         free(currProject);
 693     currProject   = 0;
 694     projectLoaded = FALSE;
 695 #if HUGS_FOR_WINDOWS
 696     setLastEdit((String)0,0);
 697 #endif
 698 }
 699
 700 static Void local addScriptName(s,sch)  /* Add script to list of scripts   */
 701 String s;                               /* to be read in ...               */
 702 Bool   sch; {                           /* TRUE => requires pathname search*/
 703     if (namesUpto>=NUM_SCRIPTS) {
 704         ERRMSG(0) "Too many module files (maximum of %d allowed)",
 705                   NUM_SCRIPTS
 706         EEND;
 707     }
 708     else
 709         scriptName[namesUpto++] = strCopy(sch ? findPathname(NULL,s) : s);
 710 }
 711
 712 static Bool local addScript(fname,len)  /* read single script file         */
 713 String fname;                           /* name of script file             */
 714 Long   len; {                           /* length of script file           */
 715     scriptFile = fname;
 716
 717 #if HUGS_FOR_WINDOWS                    /* Set clock cursor while loading  */
 718     allowBreak();
 719     SetCursor(LoadCursor(NULL, IDC_WAIT));
 720 #endif
 721
 722     Printf("Reading file \"%s\":\n",fname);
 723     setLastEdit(fname,0);
 724
 725     if (isInterfaceFile(fname)) {
 726         loadInterface(fname);
 727     } else {
 728         needsImports = FALSE;
 729         parseScript(fname,len);         /* process script file             */
 730         if (needsImports)
 731             return FALSE;
 732         checkDefns();
 733         typeCheckDefns();
 734         compileDefns();
 735     }
 736     scriptFile = 0;
 737     return TRUE;
 738 }
 739
 740 Bool chase(imps)                        /* Process list of import requests */
 741 List imps; {
 742     if (chaseImports) {
 743         Int    origPos  = numScripts;   /* keep track of original position */
 744         String origName = scriptName[origPos];
 745         for (; nonNull(imps); imps=tl(imps)) {
 746             String iname = findPathname(origName,textToStr(textOf(hd(imps))));
 747             Int    i     = 0;
 748             for (; i<namesUpto; i++)
 749                 if (pathCmp(scriptName[i],iname)==0)
 750                     break;
 751             if (i>=origPos) {           /* Neither loaded or queued        */
 752                 String theName;
 753                 Time   theTime;
 754                 Bool   thePost;
 755
 756                 postponed[origPos] = TRUE;
 757                 needsImports       = TRUE;
 758
 759                 if (i>=namesUpto)       /* Name not found (i==namesUpto)   */
 760                     addScriptName(iname,FALSE);
 761                 else if (postponed[i]) {/* Check for recursive dependency  */
 762                     ERRMSG(0)
 763                       "Recursive import dependency between \"%s\" and \"%s\"",
 764                       scriptName[origPos], iname
 765                     EEND;
 766                 }
 767                 /* Right rotate section of tables between numScripts and i so
 768                  * that i ends up with other imports in front of orig. script
 769                  */
 770                 theName = scriptName[i];
 771                 thePost = postponed[i];
 772                 timeSet(theTime,lastChange[i]);
 773                 for (; i>numScripts; i--) {
 774                     scriptName[i] = scriptName[i-1];
 775                     postponed[i]  = postponed[i-1];
 776                     timeSet(lastChange[i],lastChange[i-1]);
 777                 }
 778                 scriptName[numScripts] = theName;
 779                 postponed[numScripts]  = thePost;
 780                 timeSet(lastChange[numScripts],theTime);
 781                 origPos++;
 782             }
 783         }
 784         return needsImports;
 785     }
 786     return FALSE;
 787 }
 788
 789 static Void local forgetScriptsFrom(scno)/* remove scripts from system     */
 790 Script scno; {
 791     Script i;
 792     for (i=scno; i<namesUpto; ++i)
 793         if (scriptName[i])
 794             free(scriptName[i]);
 795     dropScriptsFrom(scno);
 796     namesUpto = scno;
 797     if (numScripts>namesUpto)
 798         numScripts = scno;
 799 }
 800
 801 /* --------------------------------------------------------------------------
 802  * Commands for loading and removing script files:
 803  * ------------------------------------------------------------------------*/
 804
 805 static Void local load() {           /* read filenames from command line   */
 806     String s;                        /* and add to list of scripts waiting */
 807                                      /* to be read                         */
 808     while ((s=readFilename())!=0)
 809         addScriptName(s,TRUE);
 810     readScripts(scriptBase);
 811 }
 812
 813 static Void local project() {          /* read list of script names from   */
 814     String s;                          /* project file                     */
 815
 816     if ((s=readFilename()) || currProject) {
 817         if (!s)
 818             s = strCopy(currProject);
 819         else if (readFilename()) {
 820             ERRMSG(0) "Too many project files"
 821             EEND;
 822         }
 823         else
 824             s = strCopy(s);
 825     }
 826     else {
 827         ERRMSG(0) "No project filename specified"
 828         EEND;
 829     }
 830     loadProject(s);
 831     readScripts(scriptBase);
 832 }
 833
 834 static Void local readScripts(n)        /* Reread current list of scripts, */
 835 Int n; {                                /* loading everything after and    */
 836     Time timeStamp;                     /* including the first script which*/
 837     Long fileSize;                      /* has been either changed or added*/
 838
 839 #if HUGS_FOR_WINDOWS
 840     SetCursor(LoadCursor(NULL, IDC_WAIT));
 841 #endif
 842
 843     for (; n<numScripts; n++) {         /* Scan previously loaded scripts  */
 844         getFileInfo(scriptName[n], &timeStamp, &fileSize);
 845         if (timeChanged(timeStamp,lastChange[n])) {
 846             dropScriptsFrom(n);
 847             numScripts = n;
 848             break;
 849         }
 850     }
 851     for (; n<NUM_SCRIPTS; n++)          /* No scripts have been postponed  */
 852         postponed[n] = FALSE;           /* at this stage                   */
 853
 854     while (numScripts<namesUpto) {      /* Process any remaining scripts   */
 855         getFileInfo(scriptName[numScripts], &timeStamp, &fileSize);
 856         timeSet(lastChange[numScripts],timeStamp);
 857         startNewScript(scriptName[numScripts]);
 858         if (addScript(scriptName[numScripts],fileSize))
 859             numScripts++;
 860         else
 861             dropScriptsFrom(numScripts);
 862     }
 863
 864     if (listScripts)
 865         whatScripts();
 866     if (numScripts<=scriptBase)
 867         setLastEdit((String)0, 0);
 868 }
 869
 870 static Void local whatScripts() {       /* list scripts in current session */
 871     int i;
 872     Printf("\nHugs session for:");
 873     if (projectLoaded)
 874         Printf(" (project: %s)",currProject);
 875     for (i=0; i<numScripts; ++i)
 876         Printf("\n%s",scriptName[i]);
 877     Putchar('\n');
 878 }
 879
 880 /* --------------------------------------------------------------------------
 881  * Access to external editor:
 882  * ------------------------------------------------------------------------*/
 883
 884 static Void local editor() {            /* interpreter-editor interface    */
 885     String newFile  = readFilename();
 886     if (newFile) {
 887         setLastEdit(newFile,0);
 888         if (readFilename()) {
 889             ERRMSG(0) "Multiple filenames not permitted"
 890             EEND;
 891         }
 892     }
 893     runEditor();
 894 }
 895
 896 static Void local find() {              /* edit file containing definition */
 897     String nm = readFilename();         /* of specified name               */
 898     if (!nm) {
 899         ERRMSG(0) "No name specified"
 900         EEND;
 901     }
 902     else if (readFilename()) {
 903         ERRMSG(0) "Multiple names not permitted"
 904         EEND;
 905     }
 906     else {
 907         Text t;
 908         Cell c;
 909         setCurrModule(findEvalModule());
 910         startNewScript(0);
 911         if (nonNull(c=findTycon(t=findText(nm)))) {
 912             if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
 913                 readScripts(scriptBase);
 914             }
 915         } else if (nonNull(c=findName(t))) {
 916             if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
 917                 readScripts(scriptBase);
 918             }
 919         } else {
 920             ERRMSG(0) "No current definition for name \"%s\"", nm
 921             EEND;
 922         }
 923     }
 924 }
 925
 926 static Void local runEditor() {         /* run editor on script lastEdit   */
 927     if (startEdit(lastLine,lastEdit))   /* at line lastLine                */
 928         readScripts(scriptBase);
 929 }
 930
 931 static Void local setLastEdit(fname,line)/* keep name of last file to edit */
 932 String fname;
 933 Int    line; {
 934     if (lastEdit)
 935         free(lastEdit);
 936     lastEdit = strCopy(fname);
 937     lastLine = line;
 938 #if HUGS_FOR_WINDOWS
 939     DrawStatusLine(hWndMain);           /* Redo status line                */
 940 #endif
 941 }
 942
 943 /* --------------------------------------------------------------------------
 944  * Read and evaluate an expression:
 945  * ------------------------------------------------------------------------*/
 946
 947 static Void local setModule(){/*set module in which to evaluate expressions*/
 948     String s = readFilename();
 949     if (!s) s = "";              /* :m clears the current module selection */
 950     evalModule = findText(s);
 951     setLastEdit(fileOfModule(findEvalModule()),0);
 952 }
 953
 954 static Module local findEvalModule() { /*Module in which to eval expressions*/
 955     Module m = findModule(evalModule);
 956     if (isNull(m)) {
 957         m = lastModule();
 958     }
 959     return m;
 960 }
 961
 962 static Void local evaluator() {        /* evaluate expr and print value    */
 963     Type  type, bd;
 964     Kinds ks = NIL;
 965
 966     setCurrModule(findEvalModule());
 967     scriptFile = 0;
 968     startNewScript(0);                 /* Enables recovery of storage      */
 969                                        /* allocated during evaluation      */
 970     parseExp();
 971     checkExp();
 972     defaultDefns = evalDefaults;
 973     type         = typeCheckExp(TRUE);
 974     if (isPolyType(type)) {
 975         ks = polySigOf(type);
 976         bd = monotypeOf(type);
 977     }
 978     else
 979         bd = type;
 980
 981     if (whatIs(bd)==QUAL) {
 982         ERRMSG(0) "Unresolved overloading" ETHEN
 983         ERRTEXT   "\n*** type       : "    ETHEN ERRTYPE(type);
 984         ERRTEXT   "\n*** expression : "    ETHEN ERREXPR(inputExpr);
 985         ERRTEXT   "\n"
 986         EEND;
 987     }
 988
 989     /* ToDo: restore the code to print types, use show, etc */
 990
 991 #ifdef WANT_TIMER
 992     updateTimers();
 993 #endif
 994     if (typeMatches(type,ap(typeIO,typeUnit))) {
 995         inputExpr = ap(nameRunIO,inputExpr);
 996         evalExp();
 997         Putchar('\n');
 998     } else {
 999         Cell d = provePred(ks,NIL,ap(classShow,bd));
1000         if (isNull(d)) {
1001             ERRMSG(0) "Cannot find \"show\" function for:" ETHEN
1002             ERRTEXT   "\n*** expression : "   ETHEN ERREXPR(inputExpr);
1003             ERRTEXT   "\n*** of type    : "   ETHEN ERRTYPE(type);
1004             ERRTEXT   "\n"
1005             EEND;
1006         }
1007         inputExpr = ap2(namePrint,d,inputExpr);
1008         inputExpr = ap(nameRunIO,inputExpr);
1009         evalExp();
1010         if (addType) {
1011             printf(" :: ");
1012             printType(stdout,type);
1013             Putchar('\n');
1014         }
1015     }
1016 }
1017
1018 /* --------------------------------------------------------------------------
1019  * Print type of input expression:
1020  * ------------------------------------------------------------------------*/
1021
1022 static Void local showtype() {         /* print type of expression (if any)*/
1023     Cell type;
1024
1025     setCurrModule(findEvalModule());
1026     startNewScript(0);                 /* Enables recovery of storage      */
1027                                        /* allocated during evaluation      */
1028     parseExp();
1029     checkExp();
1030     defaultDefns = evalDefaults;
1031     type = typeCheckExp(FALSE);
1032     printExp(stdout,inputExpr);
1033     Printf(" :: ");
1034     printType(stdout,type);
1035     Putchar('\n');
1036 }
1037
1038 /* --------------------------------------------------------------------------
1039  * Enhanced help system:  print current list of scripts or give information
1040  * about an object.
1041  * ------------------------------------------------------------------------*/
1042
1043 static String local objToStr Args((Module, Cell));
1044
1045 static String local objToStr(m,c)
1046 Module m;
1047 Cell   c; {
1048 #if DISPLAY_QUANTIFIERS
1049     static char newVar[60];
1050     switch (whatIs(c)) {
1051     case NAME  : if (m == name(c).mod) {
1052                      sprintf(newVar,"%s",   textToStr(name(c).text));
1053                  } else {
1054                      sprintf(newVar,"%s.%s",textToStr(module(name(c).mod).text),
1055                                             textToStr(name(c).text));
1056                  }
1057                  break;
1058     case TYCON : if (m == tycon(c).mod) {
1059                      sprintf(newVar,"%s",   textToStr(tycon(c).text));
1060                  } else {
1061                      sprintf(newVar,"%s.%s",textToStr(module(tycon(c).mod).text),
1062                                             textToStr(tycon(c).text));
1063                  }
1064                  break;
1065     case CLASS : if (m == cclass(c).mod) {
1066                      sprintf(newVar,"%s",   textToStr(cclass(c).text));
1067                  } else {
1068                      sprintf(newVar,"%s.%s",textToStr(module(cclass(c).mod).text),
1069                                             textToStr(cclass(c).text));
1070                  }
1071                  break;
1072     default    : internal("objToStr");
1073     }
1074     return newVar;
1075 #else
1076     static char newVar[33];
1077     switch (whatIs(c)) {
1078     case NAME  : sprintf(newVar,"%s",   textToStr(name(c).text));
1079                  break;
1080     case TYCON : sprintf(newVar,"%s",   textToStr(tycon(c).text));
1081                  break;
1082     case CLASS : sprintf(newVar,"%s",   textToStr(cclass(c).text));
1083     default    : internal("objToStr");
1084     }
1085     return newVar;
1086 #endif
1087 }
1088
1089 static Void local info() {              /* describe objects                */
1090     Int    count = 0;                   /* or give menu of commands        */
1091     String s;
1092
1093     setCurrModule(findEvalModule());
1094     startNewScript(0);                  /* for recovery of storage         */
1095     for (; (s=readFilename())!=0; count++) {
1096         describe(findText(s));
1097     }
1098     if (count == 0) {
1099         whatScripts();
1100     }
1101 }
1102
1103 static Void local describe(t)           /* describe an object              */
1104 Text t; {
1105     Tycon tc = findTycon(t);
1106     Class cl = findClass(t);
1107     Name  nm = findName(t);
1108     Module mod = findEvalModule();
1109
1110     if (nonNull(tc)) {                  /* as a type constructor           */
1111         Type ty = tc;
1112         Int  i;
1113         Inst in;
1114         for (i=0; i<tycon(tc).arity; ++i) {
1115             ty = ap(ty,mkOffset(i));
1116         }
1117         Printf("-- type constructor");
1118         if (kindExpert) {
1119             Printf(" with kind ");
1120             printKind(stdout,tycon(tc).kind);
1121         }
1122         Putchar('\n');
1123         switch (tycon(tc).what) {
1124             case SYNONYM      : Printf("type ");
1125                                 printType(stdout,ty);
1126                                 Printf(" = ");
1127                                 printType(stdout,tycon(tc).defn);
1128                                 break;
1129
1130             case NEWTYPE      :
1131             case DATATYPE     : {   List cs = tycon(tc).defn;
1132                                     if (tycon(tc).what==DATATYPE) {
1133                                         Printf("data ");
1134                                     } else {
1135                                         Printf("newtype ");
1136                                     }
1137                                     printType(stdout,ty);
1138                                     if (hasCfun(cs)) {
1139                                         Printf("\n\n-- constructors:");
1140                                     }
1141                                     for (; hasCfun(cs); cs=tl(cs)) {
1142                                         Putchar('\n');
1143                                         printExp(stdout,hd(cs));
1144                                         Printf(" :: ");
1145                                         printType(stdout,name(hd(cs)).type);
1146                                     }
1147                                     if (nonNull(cs)) {
1148                                         Printf("\n\n-- selectors:");
1149                                     }
1150                                     for (; nonNull(cs); cs=tl(cs)) {
1151                                         Putchar('\n');
1152                                         printExp(stdout,hd(cs));
1153                                         Printf(" :: ");
1154                                         printType(stdout,name(hd(cs)).type);
1155                                     }
1156                                 }
1157                                 break;
1158
1159             case RESTRICTSYN  : Printf("type ");
1160                                 printType(stdout,ty);
1161                                 Printf(" = <restricted>");
1162                                 break;
1163         }
1164         Putchar('\n');
1165         if (nonNull(in=findFirstInst(tc))) {
1166             Printf("\n-- instances:\n");
1167             do {
1168                 showInst(in);
1169                 in = findNextInst(tc,in);
1170             } while (nonNull(in));
1171         }
1172         Putchar('\n');
1173     }
1174
1175     if (nonNull(cl)) {                  /* as a class                      */
1176         List  ins = cclass(cl).instances;
1177         Kinds ks  = cclass(cl).kinds;
1178         if (nonNull(ks) && isNull(tl(ks)) && hd(ks)==STAR) {
1179             printf("-- type class");
1180         } else {
1181             printf("-- constructor class");
1182             if (kindExpert) {
1183                 printf(" with arity ");
1184                 printKinds(stdout,ks);
1185             }
1186         }
1187         printf("\nclass ");
1188         if (nonNull(cclass(cl).supers)) {
1189             printContext(stdout,cclass(cl).supers);
1190             printf(" => ");
1191         }
1192         printPred(stdout,cclass(cl).head);
1193         if (nonNull(cclass(cl).members)) {
1194             List ms = cclass(cl).members;
1195             printf(" where");
1196             do {
1197                 Type t = monotypeOf(name(hd(ms)).type);
1198                 printf("\n  ");
1199                 printExp(stdout,hd(ms));
1200                 printf(" :: ");
1201                 if (isNull(tl(fst(snd(t))))) {
1202                     t = snd(snd(t));
1203                 } else {
1204                     t = ap(QUAL,pair(tl(fst(snd(t))),snd(snd(t))));
1205                 }
1206                 printType(stdout,t);
1207                 ms = tl(ms);
1208             } while (nonNull(ms));
1209         }
1210         putchar('\n');
1211         if (nonNull(ins)) {
1212             printf("\n-- instances:\n");
1213             do {
1214                 showInst(hd(ins));
1215                 ins = tl(ins);
1216             } while (nonNull(ins));
1217         }
1218         putchar('\n');
1219     }
1220
1221     if (nonNull(nm)) {                  /* as a function/name              */
1222         printExp(stdout,nm);
1223         printf(" :: ");
1224         if (nonNull(name(nm).type)) {
1225             printType(stdout,name(nm).type);
1226         } else {
1227             printf("<unknown type>");
1228         }
1229
1230         if (isCfun(nm)) {
1231             printf("  -- data constructor");
1232         } else if (isMfun(nm)) {
1233             printf("  -- class member");
1234         } else if (isSfun(nm)) {
1235             printf("  -- selector function");
1236         }
1237         if (name(nm).primop) {
1238             printf("   -- primitive");
1239         }
1240         printf("\n\n");
1241     }
1242
1243     if (isNull(tc) && isNull(cl) && isNull(nm)) {
1244         Printf("Unknown reference `%s'\n",textToStr(t));
1245     }
1246 }
1247
1248 static Void local showInst(in)          /* Display instance decl header    */
1249 Inst in; {
1250     printf("instance ");
1251     if (nonNull(inst(in).specifics)) {
1252         printContext(stdout,inst(in).specifics);
1253         printf(" => ");
1254     }
1255     printPred(stdout,inst(in).head);
1256     putchar('\n');
1257 }
1258
1259 /* --------------------------------------------------------------------------
1260  * List all names currently in scope:
1261  * ------------------------------------------------------------------------*/
1262
1263 static Void local listNames() {         /* list names matching optional pat*/
1264     String pat   = readFilename();
1265     List   names = NIL;
1266     Int    width = getTerminalWidth() - 1;
1267     Int    count = 0;
1268     Int    termPos;
1269     Module mod   = findEvalModule();
1270
1271     if (pat) {                          /* First gather names to list      */
1272         do {
1273             names = addNamesMatching(pat,names);
1274         } while ((pat=readFilename())!=0);
1275     } else {
1276         names = addNamesMatching((String)0,names);
1277     }
1278     if (isNull(names)) {                /* Then print them out             */
1279         ERRMSG(0) "No names selected"
1280         EEND;
1281     }
1282     for (termPos=0; nonNull(names); names=tl(names)) {
1283         String s = objToStr(mod,hd(names));
1284         Int    l = strlen(s);
1285         if (termPos+1+l>width) {
1286             Putchar('\n');
1287             termPos = 0;
1288         } else if (termPos>0) {
1289             Putchar(' ');
1290             termPos++;
1291         }
1292         Printf("%s",s);
1293         termPos += l;
1294         count++;
1295     }
1296     Printf("\n(%d names listed)\n", count);
1297 }
1298
1299 /* --------------------------------------------------------------------------
1300  * print a prompt and read a line of input:
1301  * ------------------------------------------------------------------------*/
1302
1303 static Void local promptForInput(moduleName)
1304 String moduleName; {
1305     char promptBuffer[1000];
1306 #if 1
1307     /* This is portable but could overflow buffer */
1308     sprintf(promptBuffer,prompt,moduleName);
1309 #else
1310     /* Works on ANSI C - but pre-ANSI compilers return a pointer to
1311      * promptBuffer instead.
1312      */
1313     if (sprintf(promptBuffer,prompt,moduleName) >= 1000) {
1314         /* Reset prompt to a safe default to avoid an infinite loop */
1315         free(prompt);
1316         prompt = strCopy("? ");
1317         internal("Combined prompt and evaluation module name too long");
1318     }
1319 #endif
1320     consoleInput(promptBuffer);
1321 }
1322
1323 /* --------------------------------------------------------------------------
1324  * main read-eval-print loop, with error trapping:
1325  * ------------------------------------------------------------------------*/
1326
1327 static jmp_buf catch_error;             /* jump buffer for error trapping  */
1328
1329 static Void local interpreter(argc,argv)/* main interpreter loop           */
1330 Int    argc;
1331 String argv[]; {
1332     Int errorNumber = setjmp(catch_error);
1333
1334     breakOn(TRUE);                      /* enable break trapping           */
1335     if (numScripts==0) {                /* only succeeds on first time,    */
1336         if (errorNumber)                /* before prelude has been loaded  */
1337             fatal("Unable to load prelude");
1338         initialize(argc,argv);
1339         forHelp();
1340     }
1341
1342     for (;;) {
1343         Command cmd;
1344         everybody(RESET);               /* reset to sensible initial state */
1345         dropScriptsFrom(numScripts);    /* remove partially loaded scripts */
1346
1347         promptForInput(textToStr(module(findEvalModule()).text));
1348
1349         cmd = readCommand(cmds, (Char)':', (Char)'!');
1350 #ifdef WANT_TIMER
1351         updateTimers();
1352 #endif
1353         switch (cmd) {
1354             case EDIT   : editor();
1355                           break;
1356             case FIND   : find();
1357                           break;
1358             case LOAD   : clearProject();
1359                           forgetScriptsFrom(scriptBase);
1360                           load();
1361                           break;
1362             case ALSO   : clearProject();
1363                           forgetScriptsFrom(numScripts);
1364                           load();
1365                           break;
1366             case RELOAD : readScripts(scriptBase);
1367                           break;
1368             case PROJECT: project();
1369                           break;
1370             case SETMODULE :
1371                           setModule();
1372                           break;
1373             case SHOWVERSION :
1374                           Printf("Hugs 1.4, %s release.\n", HUGS_VERSION);
1375                           break;
1376             case EVAL   : evaluator();
1377                           break;
1378             case TYPEOF : showtype();
1379                           break;
1380             case NAMES  : listNames();
1381                           break;
1382             case HELP   : menu();
1383                           break;
1384             case BADCMD : guidance();
1385                           break;
1386             case SET    : set();
1387                           break;
1388             case SYSTEM : if (shellEsc(readLine()))
1389                               Printf("Warning: Shell escape terminated abnormally\n");
1390                           break;
1391             case CHGDIR : changeDir();
1392                           break;
1393             case INFO   : info();
1394                           break;
1395             case QUIT   : return;
1396             case COLLECT: consGC = FALSE;
1397                           garbageCollect();
1398                           consGC = TRUE;
1399                           Printf("Garbage collection recovered %d cells\n",
1400                                  cellsRecovered);
1401                           break;
1402             case NOCMD  : break;
1403         }
1404 #ifdef WANT_TIMER
1405         updateTimers();
1406         Printf("Elapsed time (ms): %ld (user), %ld (system)\n",
1407                millisecs(userElapsed), millisecs(systElapsed));
1408 #endif
1409     }
1410 }
1411
1412 /* --------------------------------------------------------------------------
1413  * Display progress towards goal:
1414  * ------------------------------------------------------------------------*/
1415
1416 static Target currTarget;
1417 static Bool   aiming = FALSE;
1418 static Int    currPos;
1419 static Int    maxPos;
1420 static Int    charCount;
1421
1422 Void setGoal(what, t)                  /* Set goal for what to be t        */
1423 String what;
1424 Target t; {
1425     if (quiet) return;
1426     currTarget = (t?t:1);
1427     aiming     = TRUE;
1428     if (useDots) {
1429         currPos = strlen(what);
1430         maxPos  = getTerminalWidth() - 1;
1431         Printf("%s",what);
1432     }
1433     else
1434         for (charCount=0; *what; charCount++)
1435             Putchar(*what++);
1436     FlushStdout();
1437 }
1438
1439 Void soFar(t)                          /* Indicate progress towards goal   */
1440 Target t; {                            /* has now reached t                */
1441     if (quiet) return;
1442     if (useDots) {
1443         Int newPos = (Int)((maxPos * ((long)t))/currTarget);
1444
1445         if (newPos>maxPos)
1446             newPos = maxPos;
1447
1448         if (newPos>currPos) {
1449             do
1450                 Putchar('.');
1451             while (newPos>++currPos);
1452             FlushStdout();
1453         }
1454         FlushStdout();
1455     }
1456 }
1457
1458 Void done() {                          /* Goal has now been achieved       */
1459     if (quiet) return;
1460     if (useDots) {
1461         while (maxPos>currPos++)
1462             Putchar('.');
1463         Putchar('\n');
1464     }
1465     else
1466         for (; charCount>0; charCount--) {
1467             Putchar('\b');
1468             Putchar(' ');
1469             Putchar('\b');
1470         }
1471     aiming = FALSE;
1472     FlushStdout();
1473 }
1474
1475 static Void local failed() {           /* Goal cannot be reached due to    */
1476     if (aiming) {                      /* errors                           */
1477         aiming = FALSE;
1478         Putchar('\n');
1479         FlushStdout();
1480     }
1481 }
1482
1483 /* --------------------------------------------------------------------------
1484  * Error handling:
1485  * ------------------------------------------------------------------------*/
1486
1487 Void errHead(l)                        /* print start of error message     */
1488 Int l; {
1489     failed();                          /* failed to reach target ...       */
1490     FPrintf(errorStream,"ERROR");
1491
1492     if (scriptFile) {
1493         FPrintf(errorStream," \"%s\"", scriptFile);
1494         setLastEdit(scriptFile,l);
1495         if (l) FPrintf(errorStream," (line %d)",l);
1496         scriptFile = 0;
1497     }
1498     FPrintf(errorStream,": ");
1499     FFlush(errorStream);
1500 }
1501
1502 Void errFail() {                        /* terminate error message and     */
1503     Putc('\n',errorStream);             /* produce exception to return to  */
1504     FFlush(errorStream);                /* main command loop               */
1505     longjmp(catch_error,1);
1506 }
1507
1508 Void errAbort() {                       /* altern. form of error handling  */
1509     failed();                           /* used when suitable error message*/
1510     errFail();                          /* has already been printed        */
1511 }
1512
1513 Void internal(msg)                      /* handle internal error           */
1514 String msg; {
1515 #if HUGS_FOR_WINDOWS
1516     char buf[300];
1517     wsprintf(buf,"INTERNAL ERROR: %s",msg);
1518     MessageBox(hWndMain, buf, appName, MB_ICONHAND | MB_OK);
1519 #endif
1520     failed();
1521     Printf("INTERNAL ERROR: %s\n",msg);
1522     FlushStdout();
1523     longjmp(catch_error,1);
1524 }
1525
1526 Void fatal(msg)                         /* handle fatal error              */
1527 String msg; {
1528 #if HUGS_FOR_WINDOWS
1529     char buf[300];
1530     wsprintf(buf,"FATAL ERROR: %s",msg);
1531     MessageBox(hWndMain, buf, appName, MB_ICONHAND | MB_OK);
1532 #endif
1533     FlushStdout();
1534     Printf("\nFATAL ERROR: %s\n",msg);
1535     everybody(EXIT);
1536     exit(1);
1537 }
1538
1539 sigHandler(breakHandler) {              /* respond to break interrupt      */
1540 #if HUGS_FOR_WINDOWS
1541     MessageBox(GetFocus(), "Interrupted!", appName, MB_ICONSTOP | MB_OK);
1542 #endif
1543     Hilite();
1544     Printf("{Interrupted!}\n");
1545     Lolite();
1546     breakOn(TRUE);
1547     everybody(BREAK);
1548     failed();
1549     FlushStdout();
1550     clearerr(stdin);
1551     longjmp(catch_error,1);
1552     sigResume;/*NOTREACHED*/
1553 }
1554
1555 /* --------------------------------------------------------------------------
1556  * Read value from environment variable or registry:
1557  * ------------------------------------------------------------------------*/
1558
1559 String fromEnv(var,def)         /* return value of:                        */
1560 String var;                     /*     environment variable named by var   */
1561 String def; {                   /* or: default value given by def          */
1562     String s = getenv(var);
1563     return (s ? s : def);
1564 }
1565
1566 /* --------------------------------------------------------------------------
1567  * String manipulation routines:
1568  * ------------------------------------------------------------------------*/
1569
1570 static String local strCopy(s)         /* make malloced copy of a string   */
1571 String s; {
1572     if (s && *s) {
1573         char *t, *r;
1574         if ((t=(char *)malloc(strlen(s)+1))==0) {
1575             ERRMSG(0) "String storage space exhausted"
1576             EEND;
1577         }
1578         for (r=t; (*r++ = *s++)!=0; ) {
1579         }
1580         return t;
1581     }
1582     return NULL;
1583 }
1584
1585 /* --------------------------------------------------------------------------
1586  * Compiler output
1587  * We can redirect compiler output (prompts, error messages, etc) by
1588  * tweaking these functions.
1589  * ------------------------------------------------------------------------*/
1590
1591 #if REDIRECT_OUTPUT && !HUGS_FOR_WINDOWS
1592
1593 #ifdef HAVE_STDARG_H
1594 #include <stdarg.h>
1595 #else
1596 #include <varargs.h>
1597 #endif
1598
1599 /* ----------------------------------------------------------------------- */
1600
1601 #define BufferSize 5000               /* size of redirected output buffer  */
1602
1603 typedef struct _HugsStream {
1604     char buffer[BufferSize];          /* buffer for redirected output      */
1605     Int  next;                        /* next space in buffer              */
1606 } HugsStream;
1607
1608 static Void   local vBufferedPrintf  Args((HugsStream*, const char*, va_list));
1609 static Void   local bufferedPutchar  Args((HugsStream*, Char));
1610 static String local bufferClear      Args((HugsStream *stream));
1611
1612 static Void local vBufferedPrintf(stream, fmt, ap)
1613 HugsStream* stream;
1614 const char* fmt;
1615 va_list     ap; {
1616     Int spaceLeft = BufferSize - stream->next;
1617     char* p = &stream->buffer[stream->next];
1618     Int charsAdded = vsnprintf(p, spaceLeft, fmt, ap);
1619     if (0 <= charsAdded && charsAdded < spaceLeft)
1620         stream->next += charsAdded;
1621 #if 1 /* we can either buffer the first n chars or buffer the last n chars */
1622     else
1623         stream->next = 0;
1624 #endif
1625 }
1626
1627 static Void local bufferedPutchar(stream, c)
1628 HugsStream *stream;
1629 Char        c; {
1630     if (BufferSize - stream->next >= 2) {
1631         stream->buffer[stream->next++] = c;
1632         stream->buffer[stream->next] = '\0';
1633     }
1634 }
1635
1636 static String local bufferClear(stream)
1637 HugsStream *stream; {
1638     if (stream->next == 0) {
1639         return "";
1640     } else {
1641         stream->next = 0;
1642         return stream->buffer;
1643     }
1644 }
1645
1646 /* ----------------------------------------------------------------------- */
1647
1648 static HugsStream outputStream;
1649 /* ADR note:
1650  * We rely on standard C semantics to initialise outputStream.next to 0.
1651  */
1652
1653 Void hugsEnableOutput(f)
1654 Bool f; {
1655     disableOutput = !f;
1656 }
1657
1658 String hugsClearOutputBuffer() {
1659     return bufferClear(&outputStream);
1660 }
1661
1662 #ifdef HAVE_STDARG_H
1663 Void hugsPrintf(const char *fmt, ...) {
1664     va_list ap;                    /* pointer into argument list           */
1665     va_start(ap, fmt);             /* make ap point to first arg after fmt */
1666     if (!disableOutput) {
1667         vprintf(fmt, ap);
1668     } else {
1669         vBufferedPrintf(&outputStream, fmt, ap);
1670     }
1671     va_end(ap);                    /* clean up                             */
1672 }
1673 #else
1674 Void hugsPrintf(fmt, va_alist)
1675 const char *fmt;
1676 va_dcl {
1677     va_list ap;                    /* pointer into argument list           */
1678     va_start(ap);                  /* make ap point to first arg after fmt */
1679     if (!disableOutput) {
1680         vprintf(fmt, ap);
1681     } else {
1682         vBufferedPrintf(&outputStream, fmt, ap);
1683     }
1684     va_end(ap);                    /* clean up                             */
1685 }
1686 #endif
1687
1688 Void hugsPutchar(c)
1689 int c; {
1690     if (!disableOutput) {
1691         putchar(c);
1692     } else {
1693         bufferedPutchar(&outputStream, c);
1694     }
1695 }
1696
1697 Void hugsFlushStdout() {
1698     if (!disableOutput) {
1699         fflush(stdout);
1700     }
1701 }
1702
1703 Void hugsFFlush(fp)
1704 FILE* fp; {
1705     if (!disableOutput) {
1706         fflush(fp);
1707     }
1708 }
1709
1710 #ifdef HAVE_STDARG_H
1711 Void hugsFPrintf(FILE *fp, const char* fmt, ...) {
1712     va_list ap;
1713     va_start(ap, fmt);
1714     if (!disableOutput) {
1715         vfprintf(fp, fmt, ap);
1716     } else {
1717         vBufferedPrintf(&outputStream, fmt, ap);
1718     }
1719     va_end(ap);
1720 }
1721 #else
1722 Void hugsFPrintf(FILE *fp, const char* fmt, va_list)
1723 FILE* fp;
1724 const char* fmt;
1725 va_dcl {
1726     va_list ap;
1727     va_start(ap);
1728     if (!disableOutput) {
1729         vfprintf(fp, fmt, ap);
1730     } else {
1731         vBufferedPrintf(&outputStream, fmt, ap);
1732     }
1733     va_end(ap);
1734 }
1735 #endif
1736
1737 Void hugsPutc(c, fp)
1738 int   c;
1739 FILE* fp; {
1740     if (!disableOutput) {
1741         putc(c,fp);
1742     } else {
1743         bufferedPutchar(&outputStream, c);
1744     }
1745 }
1746
1747 #endif /* REDIRECT_OUTPUT && !HUGS_FOR_WINDOWS */
1748
1749 /* --------------------------------------------------------------------------
1750  * Hugs for Windows code (WinMain and related functions)
1751  * ------------------------------------------------------------------------*/
1752
1753 #if HUGS_FOR_WINDOWS
1754 #include "winhugs.c"
1755 #endif
1756
1757 /*-------------------------------------------------------------------------*/
1758