////////////////////////////////////////////////////////////////////////////// // This file is part of Teyjus. // // // // Teyjus is free software: you can redistribute it and/or modify // // it under the terms of the GNU General Public License as published by // // the Free Software Foundation, either version 3 of the License, or // // (at your option) any later version. // // // // Teyjus is distributed in the hope that it will be useful, // // but WITHOUT ANY WARRANTY; without even the implied warranty of // // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // // GNU General Public License for more details. // // // // You should have received a copy of the GNU General Public License // // along with Teyjus. If not, see . // ////////////////////////////////////////////////////////////////////////////// /*****************************************************************************/ /* File pervgen-ocaml.c. This files contains function definitions for */ /* generating files pervasive.mli and pervasive.ml. */ /*****************************************************************************/ #include #include #include #include "pervgen-ocaml.h" #include "ocamlcode.h" static char* addLine(char* str, char* addOn) { size_t length = (str ? strlen(str) : 0) + strlen(addOn) + 2; char* newStr = UTIL_mallocStr(length); if (str) { strcpy(newStr, str); strcat(newStr, addOn); } else strcpy(newStr, addOn); strcat(newStr, "\n\n"); return newStr; } static char* addStr(char* str, char* addOn) { size_t length = (str ? strlen(str) : 0) + strlen(addOn); char* newStr = UTIL_mallocStr(length); if (str) { strcpy(newStr, str); strcat(newStr, addOn); } else strcpy(newStr, addOn); return newStr; } /**************************************************************************/ /* generating pervasive kind relevant part */ /**************************************************************************/ static char* numKindsML = NULL; static char* numKindsMLI = NULL; void ocamlGenNumKinds(char* number) { numKindsMLI = strdup("val numberPervasiveKinds : int"); numKindsML = addStr("let numberPervasiveKinds = ", number); } static char* kindVarList = NULL; //kind variable definitions static char* buildPervKindBody = NULL; //buildPervKind function defs static char* kindVarDecs = NULL; //kind vars in signature static char* isKindFuncDecs = NULL; //is kind function decs static char* isKindFuncDefs = NULL; //is kind function defs void ocamlGenKind(char* kindName, char* kVarName, char* arity, char* offset) { char* kindVarName = OC_mkKVarName(kVarName); char* funcName = OC_mkIsKindFuncName(kindVarName); char* kindVar = OC_mkKindVar(kindVarName, kindName, arity, offset); char* kindTabEntry = OC_mkTabEntry(kindName, kindVarName); char* kindVarDec = OC_mkKindVarDec(kindVarName); char* funcDec = OC_mkIsKindFuncDec(funcName); char* funcDef = OC_mkIsKindFuncDef(funcName, kindVarName); char *myKindVarList, *myBuildPervKindBody, *myKindVarDecs, *myisKindFuncDecs, *myisKindFuncDefs; free(kindVarName); myKindVarList = addLine(kindVarList, kindVar); free(kindVarList); free(kindVar); kindVarList = myKindVarList; myBuildPervKindBody = addStr(buildPervKindBody, kindTabEntry); free(buildPervKindBody); free(kindTabEntry); buildPervKindBody = myBuildPervKindBody; myKindVarDecs = addStr(kindVarDecs, kindVarDec); free(kindVarDecs); free(kindVarDec); kindVarDecs = myKindVarDecs; myisKindFuncDecs = addStr(isKindFuncDecs, funcDec); free(isKindFuncDecs); free(funcDec); isKindFuncDecs = myisKindFuncDecs; myisKindFuncDefs = addLine(isKindFuncDefs, funcDef); free(isKindFuncDefs); free(funcDef); isKindFuncDefs = myisKindFuncDefs; } static char* kindML = NULL; //kind relevant code in pervasive.ml static char* kindMLI = NULL; //kind relevant code in pervasive.mli void ocamlGenKinds() { char* buildTabFunc = OC_mkBuildKTabFunc(buildPervKindBody); size_t length = strlen(kindVarList) + strlen(buildTabFunc) + strlen(isKindFuncDefs) + strlen(numKindsML) + 4; kindML = UTIL_mallocStr(length); strcpy(kindML, kindVarList); strcat(kindML, "\n"); strcat(kindML, numKindsML); strcat(kindML, "\n\n"); strcat(kindML, buildTabFunc); strcat(kindML, "\n"); strcat(kindML, isKindFuncDefs); free(buildPervKindBody); free(buildTabFunc); free(kindVarList); free(isKindFuncDefs); free(numKindsML); length = strlen(kindVarDecs) + strlen(isKindFuncDecs) + strlen(numKindsMLI) + 4; kindMLI = UTIL_mallocStr(length); strcpy(kindMLI, kindVarDecs); strcat(kindMLI, "\n\n"); strcat(kindMLI, numKindsMLI); strcat(kindMLI, "\n\n"); strcat(kindMLI, isKindFuncDecs); free(kindVarDecs); free(isKindFuncDecs); free(numKindsMLI); } /**************************************************************************/ /* generating pervasive type skeleton relevant part */ /**************************************************************************/ static char* tySkelVarList = NULL; //type skel vars void ocamlGenTySkel(char* ind, Type tySkel) { char* varName = OC_mkTySkelVarName(ind); char* tySkelText = OC_genTySkel(tySkel); char* tySkelVarDef = OC_mkTYSkelVar(varName, tySkelText); size_t length = (tySkelVarList ? strlen(tySkelVarList) : 0) + strlen(tySkelVarDef) + 1; char* mytySkelVarList = UTIL_mallocStr(length + 1); free(varName); free(tySkelText); mytySkelVarList = addLine(tySkelVarList, tySkelVarDef); free(tySkelVarList); free(tySkelVarDef); tySkelVarList = mytySkelVarList; } /**************************************************************************/ /* generating pervasive constants relevant part */ /**************************************************************************/ static char* numConstsML = NULL; static char* numConstsMLI = NULL; void ocamlGenNumConsts(char* number) { numConstsMLI = strdup("val numberPervasiveConstants : int"); numConstsML = addStr("let numberPervasiveConstants = ", number); } static char* constVarList = NULL; //constant vars static char* buildPervConstBody = NULL; //buildPervConst function defs static char* constVarDecs = NULL; //constant vars in signature static char* isConstFuncDecs = NULL; //is constant function decs static char* isConstFuncDefs = NULL; //is constant function defs void ocamlGenConst(char* ind, char* name, char* cVarName, OP_Fixity fixity, OP_Prec prec, UTIL_Bool tyPrev, UTIL_Bool redef, int tesize, int tyskelInd, int neededness, OP_Code codeInfo, char* offset, char *printName) { char* constVarName = OC_mkCVarName(cVarName); char* funcName = OC_mkIsConstFuncName(constVarName); char* tyskelText = UTIL_itoa(tyskelInd); char* tyskelName = OC_mkTySkelVarName(tyskelText); char* constVar = OC_mkConstVar(name, fixity, prec, tyPrev, tyskelName, tesize, neededness, codeInfo, redef, constVarName, offset, printName); char* constTabEntry = OC_mkTabEntry(name, constVarName); char* constVarDec = OC_mkConstVarDec(constVarName); char* funcDec = OC_mkIsConstFuncDec(funcName); char* funcDef = OC_mkIsConstFuncDef(funcName, constVarName); char *myConstVarList, *myBuildPervConstBody, *myConstVarDecs, *myisConstFuncDecs, *myisConstFuncDefs; free(constVarName); free(funcName); free(tyskelName); free(tyskelText); myConstVarList = addLine(constVarList, constVar); free(constVarList); free(constVar); constVarList = myConstVarList; myBuildPervConstBody = addStr(buildPervConstBody, constTabEntry); free(buildPervConstBody); free(constTabEntry); buildPervConstBody = myBuildPervConstBody; myConstVarDecs = addStr(constVarDecs, constVarDec); free(constVarDecs); free(constVarDec); constVarDecs = myConstVarDecs; myisConstFuncDecs = addStr(isConstFuncDecs, funcDec); free(isConstFuncDecs); free(funcDec); isConstFuncDecs = myisConstFuncDecs; myisConstFuncDefs = addLine(isConstFuncDefs, funcDef); free(isConstFuncDefs); free(funcDef); isConstFuncDefs = myisConstFuncDefs; } static char* constMLI = NULL; //const relevant code in pervasive.mli static char* constML = NULL; //const relevant code in pervasive.ml void ocamlGenConsts() { char* tyskels = OC_mkFixedTySkels(tySkelVarList); char* varDefs = OC_mkGenericConstVar(constVarList); char* varDecs = OC_mkGenericConstVarDec(constVarDecs); char* buildFuncBody = OC_mkGenericConstTabEntry(buildPervConstBody); char* buildTabFunc = OC_mkBuildCTabFunc(buildFuncBody); char* funcDefs = OC_mkGenericConstFuncDefs(isConstFuncDefs); char* funcDecs = OC_mkGenericConstFuncDecs(isConstFuncDecs); size_t length = strlen(varDefs) + strlen(buildTabFunc) + strlen(funcDefs) + strlen(numConstsML) + 4; tySkelVarList = tyskels; constML = UTIL_mallocStr(length); strcpy(constML, varDefs); free(varDefs); strcat(constML, "\n"); strcat(constML, numConstsML); free(numConstsML); strcat(constML, "\n\n"); strcat(constML, buildTabFunc); free(buildTabFunc); free(buildFuncBody); strcat(constML, "\n"); strcat(constML, funcDefs); free(funcDefs); length = strlen(varDecs) + strlen(funcDecs) + strlen(numConstsMLI) + 4; constMLI = UTIL_mallocStr(length); strcpy(constMLI, varDecs); free(varDecs); strcat(constMLI, "\n\n"); strcat(constMLI, numConstsMLI); free(numConstsMLI); strcat(constMLI, "\n\n"); strcat(constMLI, funcDecs); free(funcDecs); } static char* constProperty = NULL; void ocamlCollectConsts(char* name, int last) { char* constName = OC_mkCVarName(name); char* cond = OC_mkCompare(constName); char* body; free(constName); if (last) body = cond; else { if (constProperty) { body = OC_mkOr(cond, constProperty); free(constProperty); free(cond); } else body = cond; } constProperty = body; } static char* regClob = NULL; void ocamlGenRC() { regClob = OC_mkRegClobFunc(constProperty); free(constProperty); constProperty = NULL; } static char* backTrack = NULL; void ocamlGenBC() { backTrack = OC_mkBackTrackFunc(constProperty); free(constProperty); constProperty = NULL; } /**************************************************************************/ /* generating fixed part of pervasive.ml and pervasive.mli */ /**************************************************************************/ static char* fixedML = NULL; //fixed part of pervasive.ml static char* fixedMLI = NULL; //fixed part of pervasive.mli static void ocamlGenFixedML() { fixedML = OC_mkFixedML(); } static void ocamlGenFixedMLI() { fixedMLI = OC_mkFixedMLI(); } /***************************************************************************/ /* Dump code into pervasive.ml and pervasive.mli */ /***************************************************************************/ /* dump peravsive.ml */ void spitOCPervasiveML(char * root) { FILE* outFile; char * filename = malloc(strlen(root) + 32); strcpy(filename, root); strcat(filename, "compiler/pervasive.ml"); outFile = UTIL_fopenW(filename); ocamlGenFixedML(); fprintf(outFile, "%s\n\n", kindML); free(kindML); fprintf(outFile, "%s\n\n", tySkelVarList); free(tySkelVarList); fprintf(outFile, "%s\n\n", constML); free(constML); fprintf(outFile, "%s\n\n", fixedML); free(fixedML); fprintf(outFile, "%s\n\n", regClob); free(regClob); fprintf(outFile, "%s\n\n", backTrack); free(backTrack); UTIL_fclose(outFile); free(filename); } /* dump peravsive.mli */ void spitOCPervasiveMLI(char * root) { FILE* outFile; char * filename = malloc(strlen(root) + 32); strcpy(filename, root); strcat(filename, "compiler/pervasive.mli"); outFile = UTIL_fopenW(filename); ocamlGenFixedMLI(); fprintf(outFile, "%s\n\n", kindMLI); free(kindMLI); fprintf(outFile, "%s\n\n", constMLI); free(constMLI); fprintf(outFile, "%s\n\n", fixedMLI); free(fixedMLI); UTIL_fclose(outFile); free(filename); }