home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacGofer 0.22d / MacGofer Sources / gofer.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-03-31  |  30.6 KB  |  1,189 lines  |  [TEXT/MPS ]
  1. /* --------------------------------------------------------------------------
  2.  * gofer.c:    Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *        See goferite.h for details and conditions of use etc...
  4.  *        Gofer version 2.28 January 1993
  5.  *
  6.  * Command interpreter
  7.  * ------------------------------------------------------------------------*/
  8.  
  9. #include "prelude.h"
  10. #include "storage.h"
  11. #include "command.h"
  12. #include "connect.h"
  13. #include "errors.h"
  14. #include <setjmp.h>
  15. #if MPW
  16. #include "mac_ctype.h"        /* KH: I need to override the defaults for the Mac */
  17. #else
  18. #include <ctype.h>
  19. #endif
  20.  
  21. /* --------------------------------------------------------------------------
  22.  * Machine dependent code for Gofer interpreter:
  23.  * ------------------------------------------------------------------------*/
  24.  
  25. #define  MACHDEP_GOFER 1
  26. #include "machdep.c"
  27.  
  28.  
  29. /* --------------------------------------------------------------------------
  30.  * Shared parts of user interface:
  31.  * ------------------------------------------------------------------------*/
  32.  
  33. #include "commonui.c"
  34.  
  35.  
  36. #if MPW
  37. #pragma segment Gofer
  38. #endif
  39.  
  40. /* --------------------------------------------------------------------------
  41.  * Local function prototypes:
  42.  * ------------------------------------------------------------------------*/
  43.  
  44. #if !MAC
  45. static Void   local initialise          Args((Int,String []));
  46. static Void   local interpreter       Args((Int,String []));
  47. #else
  48. static Void   local initialise          Args((Void));
  49.        Void         interpreter       Args((Void));
  50.        Void        printPrompt          Args((Void));
  51.        Void        showType          Args((String));
  52. #endif
  53. static Void   local menu          Args((Void));
  54. static Void   local guidance          Args((Void));
  55. static Void   local forHelp          Args((Void));
  56. static Void   local set              Args((Void));
  57. static Void   local changeDir          Args((Void));
  58. #if !MAC
  59. static Void   local load          Args((Void));
  60. static Void   local project           Args((Void));
  61. static Void   local readScripts       Args((Int));
  62. #else
  63.        Void         load          Args((Void));
  64.        Void         project           Args((Void));
  65.        Void         readScripts       Args((Void));
  66.        Void        resetScript          Args((Int));
  67. #endif
  68.        Void         ResetInterpreter  Args((Void));
  69. static Void   local whatFiles          Args((Void));
  70. static Void   local editor          Args((Void));
  71. static Void   local find          Args((Void));
  72. static Void   local runEditor         Args((Void));
  73. static Void   local evaluator          Args((Void));
  74. static Void   local stopAnyPrinting   Args((Void));
  75. static Void   local showtype          Args((Void));
  76. static Void   local info          Args((Void));
  77. static Void   local describe          Args((Text));
  78. static Void   local listNames          Args((Void));
  79. static Void   local show_banner       Args((Void));    /* KH */
  80.  
  81. /* --------------------------------------------------------------------------
  82.  * Local data areas:
  83.  * ------------------------------------------------------------------------*/
  84.  
  85. #if !MAC
  86. static Time lastChange[NUM_MODULES];    /* Time of last change to file       */
  87. #endif
  88. static Bool printing  = FALSE;        /* TRUE => currently printing value*/
  89. #if !MAC
  90. static Bool addType;            /* TRUE => print type with value   */
  91. static Bool showStats = TRUE;        /* TRUE => print stats after eval  */
  92. #else
  93.        Bool addType   = FALSE;        /* TRUE => print type with value  */
  94.        Bool showStats = TRUE;        /* TRUE => print stats after eval  */
  95. #endif
  96. static Bool listFiles = TRUE;        /* TRUE => list files after loading*/
  97.  
  98. #if MAC
  99.        int errorLine = 0;        /* Line number for last error       */
  100.        int errorMod = 0;        /* File name for last error       */
  101.  
  102. extern Boolean quit;            /* To enable :q  -- MS             */
  103.  
  104. extern Bool AutoLoad;            /* Automatically reload scripts */
  105.  
  106.        Bool literateModule = FALSE;    /* TRUE => the module is literate */
  107.        Bool moduleCoerceNumLiterals = FALSE;  /* TRUE => coerce numbers in this module */
  108.  
  109. #endif    /* MAC */
  110.  
  111.  
  112. /* --------------------------------------------------------------------------
  113.  * Gofer entry point:
  114.  * ------------------------------------------------------------------------*/
  115.  
  116. #if !MAC
  117. Main main Args((Int, String []));    /* now every func has a prototype  */
  118.  
  119. Main main(argc,argv)
  120. int  argc;
  121. char *argv[]; {
  122.     CStackBase = &argc;                 /* Save stack base for use in gc   */
  123.  
  124.     show_banner();
  125. #if DYNAMIC_STORAGE
  126.     Dynamic_Storage_Init();        /* Initialise the Dynamic Storage */
  127. #endif
  128.     interpreter(argc,argv);
  129.     printf("[Leaving Gofer]\n");
  130.     everybody(EXIT);
  131.     exit(0);
  132.     MainDone
  133. }
  134.  
  135. #else /* !MAC */
  136.  
  137. /*
  138.    The main routine is split up like this because the interpreter is called 
  139.    from the interface, rather than vice-versa as on a text-based system.
  140.    
  141.    The routines correspond to initialisation, printing prompts and termination,
  142.    respectively.
  143. */
  144.  
  145. Void init_gofer Args((Void));
  146. Void terminate_gofer Args((Void));
  147.  
  148. Void init_gofer()
  149. {
  150.   show_banner();
  151.   updatewindows();
  152.   Dynamic_Storage_Init();
  153.   updatewindows();
  154.   
  155.   /* One dummy argument for the Mac version */
  156.   initialise(0);
  157.   
  158.   printPrompt();
  159. }
  160.  
  161. /* Print the prompt string */
  162. Void printPrompt()
  163. {
  164.   ResetCursor();
  165.   if(prompt != NULL)
  166.     printf("%s\n",prompt);
  167. }
  168.  
  169.  
  170. Void terminate_gofer()
  171. {
  172.   printf("[Leaving Gofer]\n");
  173.   everybody(EXIT);
  174. }
  175.  
  176. #endif
  177.  
  178.  
  179. /* The startup banner now includes my name.  Gofer is provided free of */
  180. /* charge.  I ask however that you show your appreciation for the many */
  181. /* hours of work involved by retaining my name in the banner.  Thanks! */
  182.  
  183. static Void local show_banner()
  184. {
  185.     printf("Gofer Version 2.28b  Copyright (c) Mark P Jones 1991-1993\n");
  186. #if MAC
  187.     printf("Macintosh Interface by Kevin Hammond, 12/1/92--16/2/93\n");
  188.     printf("Configuring Gofer's Memory and loading Prelude -- Please be Patient…\n\n");
  189. #else
  190.     fflush(stdout);
  191. #endif
  192. }
  193.  
  194.  
  195. /* --------------------------------------------------------------------------
  196.  * Initialisation, interpret command line args and read prelude:
  197.  * ------------------------------------------------------------------------*/
  198.  
  199. #if !MAC
  200.  
  201. static Void local initialise(argc,argv)/* interpreter initialisation       */
  202. Int    argc;
  203. String argv[]; {
  204.     Module i;
  205.     String proj = 0;
  206.  
  207.     setLastEdit((String)0,0);
  208.     lastEdit      = 0;
  209.     scriptFile      = 0;
  210.     numScripts      = 0;
  211.     namesUpto      = 1;
  212.     scriptName[0] = strCopy(fromEnv("GOFER",STD_PRELUDE));
  213.     prompt      = strCopy(PROMPT);
  214.     repeatStr      = strCopy("$$");
  215.  
  216.     for (i=1; i<argc; ++i)        /* process command line arguments  */
  217.     if (strcmp(argv[i],"+")==0 && i+1<argc)
  218.         if (proj) {
  219.         ERROR(0) "Multiple project filenames on command line"
  220.         EEND;
  221.         }
  222.         else
  223.         proj = argv[++i];
  224.     else
  225.         addScriptName(argv[i]);
  226.  
  227.     everybody(INSTALL);
  228.     if (proj) {
  229.     if (namesUpto>1)
  230.         fprintf(stderr,
  231.             "\nUsing project file, ignoring additional filenames\n");
  232.     loadProject(strCopy(proj));
  233.     }
  234.     readScripts(0);
  235. }
  236. #else /* !MAC */
  237. static Void local initialise(dummy) /* interpreter initialisation       */
  238. int dummy;
  239. {
  240.     CStackBase = &dummy;
  241.     scriptFile      = 0;
  242.     numScripts      = 0;
  243.     prompt      = PROMPT;
  244.  
  245.     everybody(INSTALL);
  246.     updatewindows();
  247.     readScripts(0);
  248.     numScripts = 1;
  249.     everybody(RESET);
  250. }
  251. #endif
  252.  
  253.  
  254. /* --------------------------------------------------------------------------
  255.  * Print Menu of list of commands:
  256.  * ------------------------------------------------------------------------*/
  257.  
  258. static struct cmd cmds[] = {
  259.  {":?",       HELP},    {":type",   TYPEOF}, {":load",    LOAD},
  260.  {":also", ALSO},    {":reload", RELOAD}, {":project", PROJECT},
  261.  {":edit", EDIT},    {":find",   FIND},   {":names",   NAMES},
  262.  {":set",  SET},     {":quit",   QUIT},   {":cd",      CHGDIR},
  263.  {":!",    SYSTEM},  {":info",     INFO},      {"",           EVAL},
  264. #if MAC
  265.  {":unload", UNLOAD},
  266. #endif
  267.  {0,0}
  268. };
  269.  
  270. static Void local menu() {
  271. #if !MAC
  272.     printf("LIST OF COMMANDS:  Any command may be abbreviated to :c where\n");
  273.     printf("c is the first character in the full name.\n\n");
  274. #else
  275.     printf("GOFER COMMANDS:\n\nAny command may be shortened to two characters (e.g. :l for :load)\n");
  276. #endif
  277.     printf(":load <filenames>   load scripts from specified files\n");
  278.     printf(":load               clear all files except prelude\n");
  279.     printf(":also <filenames>   read additional script files\n");
  280. #if MAC
  281.     printf(":reload             reload scripts from files\n");
  282.     printf(":unload <filenames> remove files from the current project\n");
  283. #else
  284.     printf(":reload             repeat last load command\n");
  285. #endif
  286.     printf(":project <filename> use project file\n");
  287.     printf(":edit <filename>    edit file\n");
  288.     printf(":edit               edit last file\n");
  289.     printf("<expr>              evaluate expression\n");
  290.     printf(":type <expr>        print type of expression\n");
  291.     printf(":?                  display this list of commands\n");
  292. #if !MAC
  293.     printf(":set <options>      set command line options\n");
  294.     printf(":set                help on command line options\n");
  295. #endif
  296.     printf(":names [pat]        list names currently in scope\n");
  297.     printf(":info <names>       describe named objects\n");
  298.     printf(":find <name>        edit file containing definition of name\n");
  299. #if !MAC
  300.     printf(":!command           shell escape\n");
  301.     printf(":cd dir             change directory\n");
  302. #endif
  303.     printf(":quit               exit Gofer interpreter\n");
  304. #if MAC
  305.     printf("\nCMD-period interrupts MacGofer at any time\n");
  306.     printf("\nUse CMD-enter for end-of-input during evaluation\n");
  307. #endif
  308. }
  309.  
  310. static Void local guidance() {
  311.     printf("Command not recognised.  ");
  312.     forHelp();
  313. }
  314.  
  315. static Void local forHelp() {
  316.     printf("Type :? for help\n");
  317. }
  318.  
  319.  
  320. /* --------------------------------------------------------------------------
  321.  * Setting of command line options:
  322.  * ------------------------------------------------------------------------*/
  323.  
  324. #if !MAC
  325.  
  326. struct options toggle[] = {        /* List of command line toggles       */
  327.     {'s', "Print no. reductions/cells after eval", &showStats},
  328.     {'t', "Print type after evaluation",       &addType},
  329.     {'d', "Show dictionary values in output exprs",&showDicts},
  330.     {'f', "Terminate evaluation on first error",   &failOnError},
  331.     {'g', "Print no. cells recovered after gc",       &gcMessages},
  332.     {'c', "Test conformality for pattern bindings",&useConformality},
  333.     {'l', "Literate scripts as default",       &literateScripts},
  334.     {'e', "Warn about errors in literate scripts", &literateErrors},
  335.     {'i', "Apply fromInteger to integer literals", &coerceNumLiterals},
  336.     {'o', "Optimise use of (&&) and (||)",       &andorOptimise},
  337.     {'u', "Catch ambiguously typed top-level vars",&catchAmbigs},
  338.     {'.', "Print dots to show progress",       &useDots},
  339.     {'w', "Always show which files loaded",       &listFiles},
  340.     {'1', "Overload singleton list notation",       &overSingleton},
  341.     {'v', "Print each reduction step in full",       &traceEval},
  342. #ifdef TECH_TOGGLES
  343.     {'a', "Use any evidence, not nec. best",       &anyEvidence},
  344.     {'E', "Fail silently if evidence not found",   &silentEvFail},
  345. #endif
  346.     {'k', "Show kind errors in full",           &kindExpert},
  347.     {0,   0,                       0}
  348. };
  349.  
  350. struct options memopt[] = {        /* List of memory settings -- KH */
  351. #if DYNAMIC_STORAGE
  352.     {'a', "Number of Machine Addresses",       &num_addrs},
  353.     {'c', "Number of Classes",               &num_classes},
  354.     {'d', "Number of Dictionaries",           &num_dicts},
  355.     {'i', "Number of Instances",           &num_insts},
  356.     {'I', "Number of Indexes",               &num_indexes},
  357.     {'m', "Number of Modules",               &num_modules},
  358.     {'n', "Number of Identifiers (Names)",       &num_name},
  359.     {'o', "Number of Machine Offsets",           &num_offsets},
  360.     {'s', "Size of Machine Stack (words)",       &num_stack},
  361.     {'S', "Number of Selectors",           &num_selects},
  362.     {'t', "Number of Type Constructors",       &num_tycon},
  363.     {'T', "Number of Tuple Types",           &num_tuples},
  364.     {'v', "Number of Type Variables",           &num_tyvars},
  365.     {'x', "Size of Text Buffer for Identifiers",   &num_text},
  366.     {'y', "Number of Operators Allowed",       &num_syntax},
  367. #endif
  368.     {0,   0,                       0}
  369. };
  370.  
  371.  
  372. static Void local set() {        /* change command line options from*/
  373.     String s;                /* Gofer command line           */
  374.  
  375.     if (s=readFilename()) {
  376.     do {
  377.         if (s[0]=='+' || s[0]=='-')
  378.         processOption(s);
  379.         else {
  380.         ERROR(0) "Option string must begin with `+' or `-'"
  381.         EEND;
  382.         }
  383.     } while (s=readFilename());
  384.     }
  385.     else
  386.     optionInfo();
  387. }
  388.  
  389. #endif
  390.  
  391.  
  392. /* --------------------------------------------------------------------------
  393.  * Change directory command:
  394.  * ------------------------------------------------------------------------*/
  395.  
  396. static Void local changeDir() {        /* change directory           */
  397. #if MPW
  398.     ERROR(0) ":cd not yet implemented"
  399.     EEND;
  400. #else
  401.     extern int chdir Args((String));
  402.     String s = readFilename();
  403.     if (s && chdir(s)) {
  404.     ERROR(0) "Unable to change to directory \"%s\"", s
  405.     EEND;
  406.     }
  407. #endif
  408. }
  409.  
  410.  
  411. /* --------------------------------------------------------------------------
  412.  * Loading and removal of script files:
  413.  * ------------------------------------------------------------------------*/
  414.  
  415. #if !MAC
  416.  
  417. static Void local load() {           /* read filenames from command line */
  418.     String s;                   /* and add to list of files waiting */
  419.                        /* to be read               */
  420.     while (s=readFilename())
  421.     addScriptName(s);
  422.     readScripts(1);
  423. }
  424.  
  425. static Void local project() {           /* read list of file names from     */
  426.     String s;                   /* project file               */
  427.  
  428.     if ((s=readFilename()) || currProject) {
  429.     if (!s)
  430.         s = strCopy(currProject);
  431.     else if (readFilename()) {
  432.         ERROR(0) "Too many project files"
  433.         EEND;
  434.     }
  435.     else
  436.         s = strCopy(s);
  437.     }
  438.     else {
  439.     ERROR(0) "No project filename specified"
  440.     EEND;
  441.     }
  442.     loadProject(s);
  443.     readScripts(1);
  444. }
  445.  
  446. static Void local readScripts(first)    /* reread current list of scripts, */
  447. Int first; {                /* loading everything after and       */
  448.     Module i;                /* including the first script which*/
  449.     Time   timeStamp;            /* has been either changed or added*/
  450.     Long   fileSize;
  451.  
  452.     for (i=first; i<namesUpto; ++i) {
  453.     getFileInfo(scriptName[i], &timeStamp, &fileSize);
  454.  
  455.     if (i<numScripts && timeChanged(timeStamp,lastChange[i])) {
  456.         dropModulesFrom(i-1);    /* previously loaded file changed ?*/
  457.         numScripts = i;
  458.     }
  459.  
  460.     if (i>=numScripts) {        /* new script file to be read ?       */
  461.         timeSet(lastChange[i],timeStamp);
  462.         if (i>0)            /* no new module for prelude       */
  463.         startNewModule();
  464.         addScript(scriptName[i],fileSize);
  465.         numScripts++;
  466.     }
  467.     }
  468.  
  469.     if (listFiles)
  470.     whatFiles();
  471.     if (numScripts<=1)
  472.     setLastEdit((String)0, 0);
  473. }
  474.  
  475. static Void local whatFiles() {        /* list files in current session   */
  476.     int i;
  477.     printf("\nGofer session for:");
  478.     if (projectLoaded)
  479.     printf(" (project: %s)",currProject);
  480.     for (i=0; i<numScripts; ++i)
  481.     printf("\n%s",scriptName[i]);
  482.     putchar('\n');
  483. }
  484.  
  485.  
  486. #else    /* !MAC */
  487.  
  488. Void readScripts(first) 
  489. Int first;
  490. {
  491.   int mod = 0;
  492.   Module i;
  493.   char    *fname;
  494.   
  495.   CStackBase = &i;
  496.   
  497.   for (i = first; mod >= 0; i++)
  498.     {
  499.        /* Get the module index for the load item, and add it if necessary */
  500.        if((mod = getProjectItem(i)) >= 0)
  501.      {
  502.        if(haschanged(mod))
  503.          resetScript(i);
  504.  
  505.        if (i >= numScripts)
  506.          {
  507.             startNewModule();
  508.            addScript(mod,i);
  509.            fname = scriptname( mod);
  510.            setLastEdit( fname, 0 );
  511.            
  512.            numScripts++;
  513.          }
  514.      }
  515.    }
  516. }
  517.  
  518.  
  519. /*    Clear to a particular script */
  520. Void resetScript(n)
  521. {
  522.   if(n < numScripts)
  523.    {
  524.      dropModulesFrom(n);
  525.      numScripts = n;
  526.    }
  527. }
  528.  
  529.  
  530.  
  531. static Void local whatFiles() {        /* list files in current session   */
  532.     int i;
  533.     printf("\nGofer session for:");
  534.     for (i=0; i<numScripts; ++i)
  535.     printf("\n%s",scriptname(i));
  536.     putchar('\n');
  537. }
  538.  
  539. #endif
  540.  
  541. /*    Reset the interpreter following failed evaluation    */
  542. Void ResetInterpreter()
  543. {
  544.   dropModulesFrom(numScripts);    /* remove partially loaded scripts  */
  545.   everybody(RESET);
  546. #if MAC
  547.   moduleCoerceNumLiterals = literateModule = FALSE;
  548. #endif
  549. }
  550.  
  551.  
  552.  
  553.  
  554. /* --------------------------------------------------------------------------
  555.  * Access to external editor:
  556.  * ------------------------------------------------------------------------*/
  557.  
  558. static Void local editor() {        /* interpreter-editor interface       */
  559.     String newFile  = readFilename();
  560.     if (newFile) {
  561.     setLastEdit(newFile,0);
  562.     if (readFilename()) {
  563.         ERROR(0) "Multiple filenames not permitted"
  564.         EEND;
  565.     }
  566.     }
  567.     runEditor();
  568. #if !MAC
  569.     readScripts(1);            /* try to reload scripts after edit */
  570.  
  571. /*
  572.    There is no need to do this in the Mac interface -- scripts will 
  573.    be reloaded automatically when an expression is typed, 
  574.    or when the user requests a reload.
  575.   
  576.   Incidentally, readScripts(1) should probably be readScripts(0).
  577.   If the user has sufficient privilege to be able to edit the Prelude,
  578.   there can be no reason to prevent them loading the changes now!!
  579.   To do so is distinctly inconsistent!!
  580.   
  581.   KH
  582. */
  583. #endif
  584. }
  585.  
  586. static Void local find() {        /* edit file containing definition */
  587.     String nm = readFilename();        /* of specified name           */
  588.     if (!nm) {
  589.     ERROR(0) "No name specified"
  590.     EEND;
  591.     }
  592.     else if (readFilename()) {
  593.     ERROR(0) "Multiple names not permitted"
  594.     EEND;
  595.     }
  596.     else {
  597.     Name n; int m;
  598.     startNewModule();
  599.     if (isNull(n = findName(findText(nm)))) {
  600.         ERROR(0) "No current definition for name \"%s\"", nm
  601.         EEND;
  602.     }
  603. #if MAC
  604.     m=moduleThisName(n);
  605.     errorMod = m == 0? 0: m-1;
  606.     setLastEdit(scriptname(errorMod),name(n).line);
  607.     findError();
  608. #else
  609.     setLastEdit(scriptName[moduleThisName(n)],name(n).line);
  610.     runEditor();
  611.     readScripts(1);
  612. #endif
  613.   }
  614. }
  615.  
  616.  
  617.  
  618. #if MAC
  619.  
  620. /*
  621.     Get the line and module number for the definition called name.
  622. */
  623.  
  624. getName(name,module,line)
  625. char *name;
  626. int *module, *line;
  627. {
  628.   Name n;
  629.   Module m = startNewModule();
  630.   if (isNull(n = findName(findText(name))))
  631.     {
  632.       ERROR(0) "No current definition for name \"%s\"", name
  633.       EEND;
  634.     }
  635.   *module = moduleThisName(n);
  636.   *line = name(n).line;
  637.   dropModulesFrom(m);
  638.   if(*module == 0)
  639.     *module = 1;
  640. }
  641. #endif
  642.  
  643.  
  644. #if !MAC
  645. static Void local runEditor() {        /* run editor on file lastEdit at  */
  646.     static char editorCmd[100];        /* line editLine           */
  647.     String editor   = fromEnv("EDITOR",DEF_EDITOR);
  648.     String editline = fromEnv("EDITLINE",DEF_EDITLINE);
  649.     Int    l,f;
  650.  
  651.     if (lastEdit && editline && lastLine
  652.                  && (l=substr("%d",editline))>=0
  653.                  && (f=substr("%s",editline))>=0)
  654.         if (l<f)
  655.         sprintf(editorCmd,editline,lastLine,lastEdit);
  656.     else
  657.         sprintf(editorCmd,editline,lastEdit,lastLine);
  658.     else if (editor)
  659.     if (lastEdit)
  660.         sprintf(editorCmd,"%s %s",editor,lastEdit);
  661.     else
  662.         sprintf(editorCmd,"%s",editor);
  663.     else {
  664.     ERROR(0) "No editor specified in environment variable EDITOR"
  665.     EEND;
  666.     }
  667.  
  668.     if (shellEsc(editorCmd)) {
  669.     ERROR(0) "Editor terminated abnormally"
  670.     EEND;
  671.     }
  672. }
  673. #else
  674.  
  675. static Void local runEditor() {        /* run editor on file lastEdit at  */
  676.                                     /* line editLine           */
  677.     if(lastEdit)    
  678.       findFile(lastEdit,lastVol,lastDir,lastLine);
  679.     else
  680.       {
  681.         ERROR(0) "No file to edit\n" EEND;
  682.       }
  683. }
  684. #endif
  685.  
  686. /* --------------------------------------------------------------------------
  687.  * Read and evaluate an expression:
  688.  * ------------------------------------------------------------------------*/
  689.  
  690. static Void local evaluator() {        /* evaluate expr and print value    */
  691.     Type type;
  692.  
  693. #if MPW
  694.     CStackBase = &type;            /* Set stack base for evaluation   */
  695. #endif
  696.  
  697.     scriptFile = 0;
  698.     startNewModule();               /* Enables recovery of storage       */
  699.                        /* allocated during evaluation       */
  700.     parseExp();
  701.     checkExp();
  702.     type = typeCheckExp();
  703.     if (whatIs(isPolyType(type) ? monoTypeOf(type) : type)==QUAL) {
  704.     ERROR(0) "Unresolved overloading" ETHEN
  705.     ERRTEXT  "\n*** type        : "   ETHEN ERRTYPE(type);
  706.     ERRTEXT  "\n*** translation : "   ETHEN ERREXPR(inputExpr);
  707.     ERRTEXT  "\n"
  708.     EEND;
  709.     }
  710.     compileExp();
  711.     numCells      = 0;
  712.     numReductions = 0;
  713.     numberGcs     = 0;
  714.     printing      = TRUE;
  715.     if (typeMatches(type,typeString))
  716.     outputString(stdout,graphForExp(),TRUE);
  717.     else if (typeMatches(type,typeDialogue))
  718.     dialogue(graphForExp());
  719. #ifdef LAMBDAVAR
  720.     else if (typeMatches(type,typeProg))
  721.     lvExecute(graphForExp());
  722. #endif
  723. #ifdef LAMBDANU
  724.     else if (typeInstOf(type,typeLnProg))
  725.     lnExecute(graphForExp());
  726. #endif
  727.     else {
  728.     outputString(stdout,ap(ap(ap(namePrint,
  729.                      mkInt(MIN_PREC)),
  730.                      graphForExp()),
  731.                      nameNil),TRUE);
  732.     if (addType) {
  733.         printf(" :: ");
  734.         printType(stdout,type);
  735.     }
  736.     }
  737.     stopAnyPrinting();
  738. }
  739.  
  740. static Void local stopAnyPrinting() {  /* terminate printing of expression,*/
  741.     if (printing) {               /* after successful termination or  */
  742.     printing = FALSE;           /* runtime error (e.g. interrupt)   */
  743. #if MAC
  744.     ResetCursor();                 /* Reset the cursor to an arrow */
  745. #endif
  746.     putchar('\n');
  747.     if (showStats) {
  748. #define plural(v)   v, (v==1?"":"s")
  749.         printf("(%lu reduction%s, ",plural(numReductions));
  750.         printf("%lu cell%s",plural(numCells));
  751.         if (numberGcs>0)
  752.         printf(", %u garbage collection%s",plural(numberGcs));
  753.         printf(")\n");
  754. #undef plural
  755.     }
  756.     fflush(stdout);
  757.     }
  758. }
  759.  
  760. /* --------------------------------------------------------------------------
  761.  * Print type of input expression:
  762.  * ------------------------------------------------------------------------*/
  763.  
  764. static Void local showtype() {           /* print type of expression (if any)*/
  765.     Cell type;
  766.  
  767.     startNewModule();               /* Enables recovery of storage       */
  768.                        /* allocated during evaluation       */
  769.     parseExp();
  770.     checkExp();
  771.     type = typeCheckExp();
  772.     printExp(stdout,inputExpr);
  773.     printf(" :: ");
  774.     printType(stdout,type);
  775.     putchar('\n');
  776. }
  777.  
  778. #if MAC
  779.  
  780. /*
  781.     This is the graphical interface version of the above.  KH
  782. */
  783.  
  784. Void showType(defn)
  785. char *defn;
  786. {
  787.   Name n;
  788.   Module m = startNewModule();
  789.   if (isNull(n = findName(findText(defn))))
  790.     {
  791.       ERROR(0) "No current definition for name \"%s\"", defn
  792.       EEND;
  793.     }
  794.   printf("%s :: ",defn);
  795.   printType(stdout,name(n).type);
  796.   putchar('\n');
  797.   dropModulesFrom(m);
  798. }
  799. #endif
  800.  
  801.  
  802. /* --------------------------------------------------------------------------
  803.  * Enhanced help system:  print current list of scripts or give information
  804.  * about an object.
  805.  * ------------------------------------------------------------------------*/
  806.  
  807. static Void local info() {        /* describe objects           */
  808.     Int    count = 0;            /* or give menu of commands       */
  809.     String s;
  810.  
  811.     startNewModule();            /* for recovery of storage       */
  812.     for (; s=readFilename(); count++)
  813.     describe(findText(s));
  814.     if (count == 0)
  815.     whatFiles();
  816. }
  817.  
  818. static Void local describe(t)        /* describe an object           */
  819. Text t; {
  820.     Tycon tc = findTycon(t);
  821.     Class cl = findClass(t);
  822.     Name  nm = findName(t);
  823.  
  824.     if (nonNull(tc)) {            /* as a type constructor       */
  825.     Type t = tc;
  826.     Int  i;
  827.     for (i=0; i<tycon(tc).arity; ++i)
  828.         t = ap(t,mkOffset(i));
  829.     printf("-- type constructor");
  830.     if (kindExpert) {
  831.         printf(" with kind ");
  832.         printKind(stdout,tycon(tc).kind);
  833.     }
  834.     putchar('\n');
  835.     switch (tycon(tc).what) {
  836.         case SYNONYM      : printf("type ");
  837.                 printType(stdout,t);
  838.                 printf(" = ");
  839.                 printType(stdout,tycon(tc).defn);
  840.                 break;
  841.  
  842.         case DATATYPE     : {   List cs = tycon(tc).defn;
  843.                     printf("data ");
  844.                     printType(stdout,t);
  845.                     if (nonNull(cs))
  846.                     printf("\n\n-- constructors:");
  847.                     for (; nonNull(cs); cs=tl(cs)) {
  848.                     putchar('\n');
  849.                     printExp(stdout,hd(cs));
  850.                     printf(" :: ");
  851.                     printType(stdout,name(hd(cs)).type);
  852.                     }
  853.                 }
  854.                 break;
  855.  
  856.         case RESTRICTSYN  : printf("type ");
  857.                 printType(stdout,t);
  858.                 printf(" = <restricted>");
  859.                 break;
  860.     }
  861.     printf("\n\n");
  862.     }
  863.  
  864.     if (nonNull(cl)) {            /* as a class               */
  865.     List ins = class(cl).instances;
  866.     if (isPair(class(cl).sig) && fst(class(cl).sig)==STAR
  867.                   && isNull(snd(class(cl).sig)))
  868.         printf("-- type class");
  869.     else {
  870.         printf("-- constructor class");
  871.         if (kindExpert) {
  872.         printf(" with arity ");
  873.         printSig(stdout,class(cl).sig);
  874.         }
  875.     }
  876.     printf("\nclass ");
  877.     if (nonNull(class(cl).supers)) {
  878.         printContext(stdout,class(cl).supers);
  879.         printf(" => ");
  880.     }
  881.     printPred(stdout,class(cl).head);
  882.     if (nonNull(class(cl).members)) {
  883.         List ms = class(cl).members;
  884.         printf(" where");
  885.         do {
  886.         printf("\n    ");
  887.         printExp(stdout,hd(ms));
  888.         printf(" :: ");
  889.         printType(stdout,name(hd(ms)).type);
  890.         ms = tl(ms);
  891.         } while (nonNull(ms));
  892.     }
  893.     putchar('\n');
  894.     if (nonNull(ins))
  895.         printf("\n-- instances:\n");
  896.     for (; nonNull(ins); ins=tl(ins)) {
  897.         printf("instance ");
  898.         if (nonNull(inst(hd(ins)).specifics)) {
  899.         printContext(stdout,inst(hd(ins)).specifics);
  900.         printf(" => ");
  901.         }
  902.         printPred(stdout,inst(hd(ins)).head);
  903.         putchar('\n');
  904.     }
  905.     putchar('\n');
  906.     }
  907.  
  908.     if (nonNull(nm)) {            /* as a function/name           */
  909.     printExp(stdout,nm);
  910.     printf(" :: ");
  911.     if (nonNull(name(nm).type))
  912.         printType(stdout,name(nm).type);
  913.     else
  914.         printf("<unknown type>");
  915.     switch (name(nm).defn) {
  916.         case MFUN : printf("   -- class member");
  917.             break;
  918.         case CFUN : printf("   -- data constructor");
  919.             break;
  920.     }
  921.     if (name(nm).primDef)
  922.         printf("   -- primitive");
  923.     printf("\n\n");
  924.     }
  925.  
  926.     if (isNull(tc) && isNull(cl) && isNull(nm)) {
  927.     printf("Unknown reference `%s'\n",textToStr(t));
  928.     }
  929. }
  930.  
  931. /* --------------------------------------------------------------------------
  932.  * List all names currently in scope:
  933.  * ------------------------------------------------------------------------*/
  934.  
  935. static Void local listNames() {        /* list names matching optional pat*/
  936.     String pat   = readFilename();
  937.     List   names = NIL;
  938.     Int    width = getTerminalWidth() - 1;
  939.     Int    count = 0;
  940.     Int    termPos;
  941.  
  942.     if (pat)                /* First gather names to list       */
  943.     do
  944.         names = addNamesMatching(pat,names);
  945.     while (pat=readFilename());
  946.     else
  947.     names = addNamesMatching((String)0,names);
  948.  
  949.     if (isNull(names)) {        /* Then print them out           */
  950.     ERROR(0) "No names selected"
  951.     EEND;
  952.     }
  953.     for (termPos=0; nonNull(names); names=tl(names)) {
  954.     String s = textToStr(name(hd(names)).text);
  955.     Int    l = strlen(s);
  956.     if (termPos+1+l>width) {
  957.         putchar('\n');
  958.         termPos = 0;
  959.     }
  960.     else if (termPos>0) {
  961.         putchar(' ');
  962.         termPos++;
  963.     }
  964.     printf("%s",s);
  965.     termPos += l;
  966.     count++;
  967.     }
  968.     printf("\n(%d names listed)\n", count);
  969. }
  970.  
  971. /* --------------------------------------------------------------------------
  972.  * main read-eval-print loop, with error trapping:
  973.  * ------------------------------------------------------------------------*/
  974.  
  975. jmp_buf catch_error;           /* jump buffer for error trapping -- no longer static -- KH   */
  976.  
  977. #if !MAC
  978.  
  979. static Void local interpreter(argc,argv)/* main interpreter loop       */
  980. Int    argc;
  981. String argv[]; {
  982.     Int errorNumber = setjmp(catch_error);
  983.  
  984.     breakOn(TRUE);               /* enable break trapping        */
  985.     if (numScripts==0) {           /* only succeeds on first time,       */
  986.     if (errorNumber)           /* before prelude has been loaded   */
  987.         fatal("Unable to load prelude");
  988.     initialise(argc,argv);
  989.     forHelp();
  990.     }
  991.  
  992.     for (;;) {
  993.         ResetInterpreter();
  994.  
  995.     everybody(RESET);        /* reset to sensible initial state */
  996.     dropModulesFrom(numScripts-1);    /* remove partially loaded scripts */
  997.                     /* not counting prelude as a module*/
  998.     consoleInput(prompt);
  999.     switch (readCommand(cmds, (Char)':', (Char)'!')) {
  1000. #if !MPW
  1001.         case EDIT    : editor();
  1002.               break;
  1003. #endif
  1004.             case FIND   : find();
  1005.               break;
  1006.         case LOAD    : clearProject();
  1007.               forgetScriptsFrom(1);
  1008.               load();
  1009.               break;
  1010.         case ALSO   : clearProject();
  1011.               forgetScriptsFrom(numScripts);
  1012.               load();
  1013.               break;
  1014.         case RELOAD : readScripts(1);
  1015.               break;
  1016.         case PROJECT: project();
  1017.               break;
  1018.         case EVAL    : evaluator();
  1019.               break;
  1020.         case TYPEOF : showtype();
  1021.               break;
  1022.         case NAMES  : listNames();
  1023.               break;
  1024.         case HELP    : menu();
  1025.               break;
  1026.         case BADCMD : guidance();
  1027.               break;
  1028.         case SET    : set();
  1029.               break;
  1030. #if !MPW
  1031.         /* This wouldn't work under the MPW shell */
  1032.         case SYSTEM : shellEsc(readLine());
  1033.               break;
  1034. #endif
  1035.         case CHGDIR : changeDir();
  1036.               break;
  1037.         case INFO   : info();
  1038.               break;
  1039.         case QUIT    : return;
  1040.         case NOCMD    : break;
  1041.     }
  1042.     }
  1043. }
  1044. #else /* !MAC */
  1045. Void interpreter(dummy)
  1046. int dummy;
  1047. {
  1048.     int cmd;
  1049.     CStackBase = &dummy;
  1050.     
  1051.     breakOn(TRUE);            /* enable break trapping        */
  1052.  
  1053.     CStackBase = &dummy;        /* Reset C stack base for console input */
  1054.     consoleInput();
  1055.  
  1056.     cmd = readCommand(cmds, (Char)':', (Char)'!');
  1057.     
  1058.     if(cmd==EVAL)
  1059.       {
  1060.         if(AutoLoad)
  1061.       {
  1062.         saveConsoleState();
  1063.             readScripts(0);
  1064.         restoreConsoleState();
  1065.       }
  1066.     
  1067.         evaluator();
  1068.         ResetInterpreter();
  1069.       }
  1070.  
  1071.     else
  1072.       {
  1073.          switch (cmd)
  1074.        {
  1075.          case EDIT:
  1076.             editor();
  1077.             break;
  1078.          case LOAD:
  1079.             clearProject();
  1080.             load();
  1081.             return;
  1082.          case FIND:
  1083.             find();
  1084.             break;
  1085.          case ALSO:
  1086.             load();
  1087.             return;
  1088.          case RELOAD:
  1089.             readScripts(0);
  1090.             break;
  1091.          case UNLOAD:
  1092.                 unload();
  1093.             return;
  1094.          case PROJECT:
  1095.             project();
  1096.             return;
  1097.          case TYPEOF:
  1098.             showtype();
  1099.             break;
  1100.          case HELP:
  1101.             menu();
  1102.             break;
  1103.          case NAMES:
  1104.             listNames();
  1105.             break;
  1106.          case CHGDIR:
  1107.                 changeDir();
  1108.             break;
  1109.          case INFO:
  1110.                 info();
  1111.             break;
  1112.          case QUIT:
  1113.             quit = TRUE;
  1114.             printf("[Leaving Gofer]\n");
  1115.             return;
  1116.          case NOCMD:
  1117.                         if(AutoLoad) 
  1118.                           readScripts(0);
  1119.             break;
  1120.          case BADCMD:
  1121.          default:
  1122.             guidance();
  1123.             break;
  1124.         
  1125.        }
  1126.     }
  1127.   printPrompt();             /* print prompt string            */
  1128. }
  1129. #endif
  1130.  
  1131.  
  1132. Void errHead(l)                /* print start of error message       */
  1133. Int l; {
  1134.     failed();                   /* failed to reach target ...       */
  1135.     stopAnyPrinting();
  1136.     fprintf(errorStream,"ERROR");
  1137.  
  1138.     if (scriptFile) {
  1139.     fprintf(errorStream," \"%s\"", scriptFile);
  1140.     setLastEdit(scriptFile,l);
  1141.     if (l) fprintf(errorStream," (line %d)",l);
  1142.     scriptFile = 0;
  1143.     }
  1144.     fprintf(errorStream,": ");
  1145.     fflush(errorStream);
  1146. }
  1147.  
  1148. Void errFail() {            /* terminate error message and       */
  1149.     putc('\n',errorStream);        /* produce exception to return to  */
  1150.     fflush(errorStream);        /* main command loop           */
  1151.     longjmp(catch_error,1);
  1152. }
  1153.  
  1154. Void errAbort() {            /* altern. form of error handling  */
  1155.     failed();                /* used when suitable error message*/
  1156.     stopAnyPrinting();            /* has already been printed       */
  1157.     errFail();
  1158. }
  1159.  
  1160. Void internal(msg)            /* handle internal error        */
  1161. String msg; {
  1162.     failed();
  1163.     stopAnyPrinting();
  1164.     fprintf(errorStream,"INTERNAL ERROR: %s\n",msg);
  1165.     fflush(errorStream);
  1166.     longjmp(catch_error,1);
  1167. }
  1168.  
  1169. Void fatal(msg)                /* handle fatal error           */
  1170. String msg; {
  1171.     fflush(stdout);
  1172.     printf("\nFATAL ERROR: %s\n",msg);
  1173.     everybody(EXIT);
  1174.     exit(1);
  1175. }
  1176.  
  1177. sigHandler(breakHandler) {        /* respond to break interrupt       */
  1178.     breakOn(TRUE);
  1179.     printf("{Interrupted!}\n");
  1180.     everybody(BREAK);
  1181.     failed();
  1182.     stopAnyPrinting();
  1183.     fflush(stdout);
  1184.     longjmp(catch_error,1);
  1185.     sigResume;/*NOTREACHED*/
  1186. }
  1187.  
  1188. /*-------------------------------------------------------------------------*/
  1189.