home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacGofer 0.22d / MacGofer Sources / gofc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-07  |  10.3 KB  |  330 lines  |  [TEXT/MPS ]
  1. /* --------------------------------------------------------------------------
  2.  * gofc.c:      Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *        Gofer Compiler version 1.01 February 1992
  5.  *              Gofer version 2.28 January 1993
  6.  *
  7.  * Gofer->C main program
  8.  * ------------------------------------------------------------------------*/
  9.  
  10. #include "prelude.h"
  11. #include "storage.h"
  12. #include "command.h"
  13. #include "connect.h"
  14. #include "errors.h"
  15. #include <setjmp.h>
  16. #if MPW
  17. #include "mac_ctype.h"
  18. #else
  19. #include <ctype.h>
  20. #endif
  21.  
  22. #define VERSION "1.01 (2.28a)"
  23.  
  24. Bool dumpScs = FALSE;            /* TRUE => output sc defns      */
  25.  
  26. typedef FILE *Fp;
  27. static  Fp   gofcFp  = 0;        /* for output to file          */
  28.  
  29. /* --------------------------------------------------------------------------
  30.  * Machine dependent code for Gofer compiler:
  31.  * ------------------------------------------------------------------------*/
  32.  
  33. #define  MACHDEP_GOFC 1
  34. #include "machdep.c"
  35.  
  36. /* --------------------------------------------------------------------------
  37.  * Shared parts of user interface:
  38.  * ------------------------------------------------------------------------*/
  39.  
  40. #include "commonui.c"
  41.  
  42. /* --------------------------------------------------------------------------
  43.  * Local function prototypes:
  44.  * ------------------------------------------------------------------------*/
  45.  
  46. static Void local loadCompile    Args((Void));
  47. static Fp   local initOutput    Args((String));
  48. static Void local initialise    Args((Int,String []));
  49.  
  50. /* --------------------------------------------------------------------------
  51.  * Gofer entry point:
  52.  * ------------------------------------------------------------------------*/
  53.  
  54. Main main Args((Int, String []));    /* now every func has a prototype  */
  55.   
  56. jmp_buf catch_error;           /* jump buffer for error trapping -- KH   */
  57.  
  58. Main main(argc,argv)
  59. int  argc;
  60. char *argv[]; {
  61.     CStackBase = &argc;                 /* Save stack base for use in gc   */
  62.  
  63.     /* The startup banner now includes my name.  Gofer is provided free of */
  64.     /* charge.  I ask however that you show your appreciation for the many */
  65.     /* hours of work involved by retaining my name in the banner.  Thanks! */
  66.  
  67.     printf("Gofer->C Version %s  Copyright (c) Mark P Jones 1992-1993\n\n",
  68.        VERSION);
  69.     fflush(stdout);
  70.     breakOn(TRUE);
  71. #if DYNAMIC_STORAGE
  72.     Dynamic_Storage_Init();
  73. #endif
  74.     initialise(argc, argv);          /* initialise compiler           */
  75.  
  76.     if (dumpScs) {            /* produce script of sc defns for  */
  77.     gofcFp = initOutput(".gsc");    /* debugging purposes           */
  78.     printf("[Writing supercombinators to \"%s\"]\n",outputFile);
  79.     loadCompile();
  80.     fprintf(gofcFp,"\n/* end of %s */\n",outputFile);
  81.     fclose(gofcFp);
  82.     }
  83.     else {                /* produce C code as output       */
  84.     extern Void outputCode Args((FILE *,Name));
  85.     Name mn;
  86.     loadCompile();
  87.     gofcFp = initOutput(".c");
  88.  
  89.     mn = findName(findText("main"));/* check for main symbol       */
  90.     if (isNull(mn)) {
  91.         ERROR(0) "Program must include definition for \"main\"::Dialogue"
  92.         EEND;
  93.     }
  94.  
  95.     if (name(mn).defn==CFUN ||    /* check that definition is ok       */
  96.         name(mn).defn==MFUN ||
  97.         name(mn).primDef ||
  98.         isNull(name(mn).type)) {
  99.         ERROR(0) "Invalid definition for \"main\""
  100.         EEND;
  101.     }
  102.  
  103.     if (!typeMatches(name(mn).type,typeDialogue)) {
  104.         ERROR(0) "Illegal typing for \"main\":" ETHEN
  105.         ERRTEXT  "\n*** inferred type  : "      ETHEN
  106.         ERRTYPE(name(mn).type);
  107.         ERRTEXT  "\n*** does not match : Dialogue\n"
  108.         EEND;
  109.     }
  110.  
  111.     printf("\nWriting C output file \"%s\":\n",outputFile);
  112.     outputCode(gofcFp,mn);
  113.     fclose(gofcFp);
  114.     }
  115.  
  116.     printf("[Leaving Gofer->C]\n");
  117.     everybody(EXIT);
  118.     exit(0);
  119.     MainDone
  120. }
  121.  
  122. static Void local loadCompile() {    /* load and compile source modules */
  123.     Module i;
  124.     Time   timeStamp;
  125.     Long   fileSize;
  126.  
  127.     for (i=0; i<namesUpto; ++i) {    /* load and compile source modules */
  128.     getFileInfo(scriptName[i], &timeStamp, &fileSize);
  129.     if (i>0)
  130.         startNewModule();
  131.         addScript(scriptName[i], fileSize);
  132.     numScripts++;
  133.     }
  134. }
  135.  
  136. /* --------------------------------------------------------------------------
  137.  * Determine name of output file:
  138.  * ------------------------------------------------------------------------*/
  139.  
  140. static Fp local initOutput(suff)    /* find name for output file, open */
  141. String suff; {                /* it and write header ...       */
  142.     Fp  fp = 0;
  143.     int i;
  144.  
  145.     if (!outputFile) {            /* user specified name has priority*/
  146.     String s,dot;
  147.  
  148.     if (projectLoaded && currProject)    /* use project name if poss*/
  149.         s = currProject;
  150.     else
  151.         s = scriptName[namesUpto-1];    /* o/w use last script name*/
  152.  
  153.     outputFile = malloc(strlen(s)+strlen(suff)+1);
  154.     if (!outputFile)
  155.         fatal("setOutputName");
  156.     strcpy(outputFile,s);
  157.  
  158. #if !RISCOS
  159.         for (s=outputFile, dot=0; *s; ++s)    /* do something sensible   */
  160.         if (*s=='.')            /* with file extensions       */
  161.         dot = s;
  162.  
  163.     if (dot && (strcmp(dot+1,"gp") == 0 || strcmp(dot+1,"prj") ==0 ||
  164.             strcmp(dot+1,"hs") == 0 || strcmp(dot+1,"lhs") ==0 ||
  165.             strcmp(dot+1,"gs") == 0 || strcmp(dot+1,"lgs") ==0 ||
  166.             strcmp(dot+1,"gof")== 0 || strcmp(dot+1,"has") ==0 ||
  167.             strcmp(dot+1,"lit")== 0 || strcmp(dot+1,"verb")==0 ||
  168.             strcmp(dot+1,"prelude")==0))
  169.         *dot = '\0';
  170.  
  171.     strcat(outputFile,suff);
  172. #else
  173.     /* What strange code!  It uses strlen three times, when once is enough.  KH */
  174.     strcat(outputFile,suff);
  175.     outputFile[strlen(outputFile)-strlen(suff)] = '_'; /* No dot */
  176. #endif
  177.     }
  178.  
  179.     if (!(fp=fopen(outputFile,"w"))) {        /* now try to open       */
  180.     ERROR(0) "Unable to open output file \"%s\" for writing",
  181.          outputFile
  182.     EEND;
  183.     }
  184.  
  185.     fprintf(fp,"/* %s\t\t\t\t%s *\n",outputFile,timeString());
  186.     fprintf(fp," * This program produced by gofc %s from:\n",VERSION);
  187.  
  188.     if (projectLoaded && currProject)
  189.         fprintf(fp," * Project file %s comprising:\n",currProject);
  190.  
  191.     for (i=0; i<namesUpto; i++)
  192.         fprintf(fp," *\t%s\n",scriptName[i]);
  193.     fprintf(fp," */\n\n");
  194.  
  195.     return fp;
  196. }
  197.  
  198. /* --------------------------------------------------------------------------
  199.  * Include our own version of output.c with ability to output sc defns
  200.  * (This is a big hack, but it would probably be worth doing a proper
  201.  * overhaul of the overall structure of Gofer before spending too much
  202.  * time here.)
  203.  * ------------------------------------------------------------------------*/
  204.  
  205. #define GOFC_OUTPUT
  206. #include "output.c"
  207.  
  208. /* --------------------------------------------------------------------------
  209.  * Initialisation, interpret command line args and read prelude:
  210.  * ------------------------------------------------------------------------*/
  211.  
  212. struct options toggle[] = {
  213.     {'d', "Show dictionary values in output exprs",&showDicts},
  214.     {'g', "Print no. cells recovered after gc",       &gcMessages},
  215.     {'c', "Test conformality for pattern bindings",&useConformality},
  216.     {'l', "Treat input files as literate scripts", &literateScripts},
  217.     {'e', "Warn about errors in literate scripts", &literateErrors},
  218.     {'i', "Apply fromInteger to integer literals", &coerceNumLiterals},
  219.     {'o', "Optimise use of (&&) and (||)",       &andorOptimise},
  220.     {'u', "Catch ambiguously typed top-level vars",&catchAmbigs},
  221.     {'a', "Use any evidence, not nec. best",       &anyEvidence},
  222.     {'E', "Fail silently if evidence not found",   &silentEvFail},
  223.     {'.', "Print dots to show progress",       &useDots},
  224.     {'1', "Overload singleton list notation",       &overSingleton},
  225.     {'D', "Output .gsc file for debugging",       &dumpScs},
  226.     {0,   0,                       0}
  227. };
  228.  
  229. /* I'm not sure whether all these are needed for the compiler! KH */
  230. struct options memopt[] = {        /* List of memory settings -- KH */
  231. #if DYNAMIC_STORAGE
  232.     {'a', "Number of Machine Addresses",       &num_addrs},
  233.     {'c', "Number of Classes",               &num_classes},
  234.     {'d', "Number of Dictionaries",           &num_dicts},
  235.     {'i', "Number of Instances",           &num_insts},
  236.     {'I', "Number of Indexes",               &num_indexes},
  237.     {'m', "Number of Modules",               &num_modules},
  238.     {'n', "Number of Identifiers (Names)",       &num_name},
  239.     {'o', "Number of Machine Offsets",           &num_offsets},
  240.     {'s', "Size of Machine Stack (words)",       &num_stack},
  241.     {'S', "Number of Selectors",           &num_selects},
  242.     {'t', "Number of Type Constructors",       &num_tycon},
  243.     {'T', "Number of Tuple Types",           &num_tuples},
  244.     {'v', "Number of Type Variables",           &num_tyvars},
  245.     {'x', "Size of Text Buffer for Identifiers",   &num_text},
  246.     {'y', "Number of Operators Allowed",       &num_syntax},
  247. #endif
  248.     {0,   0,                       0}
  249. };
  250.  
  251.  
  252. static Void local initialise(argc,argv)/* compiler initialisation       */
  253. Int    argc;
  254. String argv[]; {
  255.     Module i;
  256.     String proj = 0;
  257.  
  258.     scriptFile      = 0;
  259.     numScripts      = 0;
  260.     namesUpto      = 1;
  261.     scriptName[0] = strCopy(fromEnv("GOFER",STD_PRELUDE));
  262.  
  263.     for (i=1; i<argc; ++i)        /* process command line arguments  */
  264.     if (strcmp(argv[i],"+")==0 && i+1<argc)
  265.         if (proj) {
  266.         ERROR(0) "Multiple project filenames on command line"
  267.         EEND;
  268.         }
  269.         else
  270.         proj = argv[++i];
  271.     else
  272.         addScriptName(argv[i]);
  273.  
  274.     everybody(INSTALL);
  275.     if (proj) {
  276.     if (namesUpto>1)
  277.         fprintf(stderr,
  278.             "\nUsing project file, ignoring additional filenames\n");
  279.     loadProject(strCopy(proj));
  280.     }
  281. }
  282.  
  283. Void errHead(l)                /* print start of error message       */
  284. Int l; {
  285.     failed();                   /* failed to reach target ...       */
  286.     fprintf(errorStream,"ERROR");
  287.  
  288.     if (scriptFile) {
  289.     fprintf(errorStream," \"%s\"", scriptFile);
  290.     if (l) fprintf(errorStream," (line %d)",l);
  291.     }
  292.     fprintf(errorStream,": ");
  293.     fflush(errorStream);
  294. }
  295.  
  296. Void errFail() {               /* terminate error message       */
  297.     fprintf(errorStream,"\nAborting compilation\n");
  298.     fflush(errorStream);
  299.     exit(1);
  300. }
  301.  
  302. Void errAbort() {            /* altern. form of error handling  */
  303.     failed();                /* used when suitable error message*/
  304.     errFail();
  305. }
  306.  
  307. Void internal(msg)            /* handle internal error       */
  308. String msg; {
  309.     fatal(msg);                /* treat as fatal condition       */
  310. }
  311.  
  312. Void fatal(msg)                /* handle fatal error            */
  313. String msg; {
  314.     fflush(stdout);
  315.     printf("\nINTERNAL ERROR: %s\n",msg);
  316.     everybody(EXIT);
  317.     exit(1);
  318. }
  319.  
  320. sigHandler(breakHandler) {           /* respond to break interrupt       */
  321.     breakOn(TRUE);
  322.     printf("{Interrupted!}\n");
  323.     everybody(BREAK);
  324.     fflush(stdout);
  325.     errAbort();
  326.     sigResume;/*NOTREACHED*/
  327. }
  328.  
  329. /*-------------------------------------------------------------------------*/
  330.