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