gf-3.4: src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.c
//////////////////////////////////////////////////////////////////////////////
// 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 <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/***************************************************************************/
/* ocamlcode.c. */
/* This file defines auxiliary functions in making pervasive.mli and */
/* pervasive.ml. */
/* Since space and time efficiency is not an important concern in the */
/* system source code generation phase, the code here is structured in the */
/* way for the convenience of making changes on pervasive.mli{ml}. */
/***************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "ocamlcode.h"
/***************************************************************************/
/* Functions for making various language constructs */
/***************************************************************************/
/* Make a string of form <first>.<second> */
static char* OC_mkDotStr(char* first, char* second)
{
size_t length = strlen(first) + strlen(second) + 1;
char* ptr = UTIL_mallocStr(length+1);
strcpy(ptr, first);
strcat(ptr, ".");
strcat(ptr, second);
return ptr;
}
/*
(Some <info>)
*/
char* OC_mkSome(char* info)
{
size_t length = strlen(info) + 10;
char* rtptr = UTIL_mallocStr(length + 1);
strcpy(rtptr, "(Some ");
strcat(rtptr, info);
strcat(rtptr, ")");
return rtptr;
}
/*
(ref <info>)
*/
char* OC_mkRef(char* info)
{
size_t length = strlen(info) + 10;
char* rtptr = UTIL_mallocStr(length + 1);
strcpy(rtptr, "(ref ");
strcat(rtptr, info);
strcat(rtptr, ")");
return rtptr;
}
/* Make a variable definition:
let <varName> = <defs>
*/
static char* OC_mkVarDef(char* varName, char* defs)
{
size_t length = strlen(varName) + strlen(defs) + 10;
char* vardef = UTIL_mallocStr(length + 1);
strcpy(vardef, "let ");
strcat(vardef, varName);
strcat(vardef, " = ");
strcat(vardef, defs);
return vardef;
}
/* Make a variable declaration:
val <varName> : <varType>"\n"
*/
static char* OC_mkVarDec(char* varName, char* varType)
{
size_t length = strlen(varName) + strlen(varType) + 10;
char* vardec = UTIL_mallocStr(length + 1);
strcpy(vardec, "val ");
strcat(vardec, varName);
strcat(vardec, " : ");
strcat(vardec, varType);
strcat(vardec, "\n");
return vardec;
}
/* Make arrow type:
<type1> -> <type2>
*/
static char* OC_mkArrowType(char* ty1, char* ty2)
{
size_t length = strlen(ty1) + strlen(ty2) + 5;
char* arrowType = UTIL_mallocStr(length);
strcpy(arrowType, ty1);
strcat(arrowType, " -> ");
strcat(arrowType, ty2);
return arrowType;
}
/**************************************************************************/
/* Names from other modules */
/**************************************************************************/
/********************************************************/
/* Fixities */
/********************************************************/
#define INFIX "Absyn.Infix"
#define INFIXL "Absyn.Infixl"
#define INFIXR "Absyn.Infixr"
#define PREFIX "Absyn.Prefix"
#define PREFIXR "Absyn.Prefixr"
#define POSTFIX "Absyn.Postfix"
#define POSTFIXL "Absyn.Postfixl"
#define NOFIXITY "Absyn.NoFixity"
#define MAXPREC "maxPrec + 1"
/********************************************************/
/* module names */
/********************************************************/
#define ABSYN "Absyn"
#define SYMBOL "Symbol"
#define ERRORMSG "Errormsg"
#define TABLE "Table"
/********************************************************/
/* types */
/********************************************************/
//absyn
#define TY_KIND "akind"
#define TY_CONST "aconstant"
#define TY_TERM "aterm"
#define TY_TYABBREV "atypeabbrev"
//table
#define TY_SYMTAB "SymbolTable.t"
/********************************************************/
/* value constructors */
/********************************************************/
//absyn
#define VCTR_KIND "Kind"
#define VCTR_KINDTYPE "PervasiveKind"
#define VCTR_CONSTANT "Constant"
#define VCTR_PERVCONST "PervasiveConstant"
#define VCTR_TYSKEL "Skeleton"
#define VCTR_APPTYPE "ApplicationType"
#define VCTR_ARROWTYPE "ArrowType"
#define VCTR_SKELVARTYPE "SkeletonVarType"
#define VCTR_BUILTIN "Builtin"
//errormsg
#define VCTR_NULLPOS "none"
//symbol
#define VCTR_SYMBOL "symbol"
#define VCTR_SYMBOL_ALIAS "symbolAlias"
//table
#define VCTR_EMPTYTAB "SymbolTable.empty"
/********************************************************/
/* functions */
/********************************************************/
//table
#define FUNC_ADD "add"
//absyn
#define FUNC_MAKETYSETVAR "makeTypeSetVariable"
/***************************************************************************/
/* Local names */
/***************************************************************************/
#define BUILDPERVKIND "buildPervasiveKinds"
#define BUILDPERVCONST "buildPervasiveConstants"
#define PERVKIND "pervasiveKinds"
#define PERVCONST "pervasiveConstants"
#define PERVTYABBR "pervasiveTypeAbbrevs"
#define KVAR_PREFIX "k"
#define CVAR_POSTFIX "Constant"
#define TSKVAR_PREFIX "tyskel"
#define TAB "t"
#define IS "is"
#define SETVARIR "tysetvarIR"
#define SETVARIRS "tysetvarIRS"
#define OVERLOADTYSKEL1 "overloadTySkel1"
#define OVERLOADTYSKEL2 "overloadTySkel2"
#define OVERLOADTYSKEL3 "overloadTySkel3"
/***************************************************************************/
/* Functions for making program components */
/***************************************************************************/
/*
(Symbol.symbol "<name>")
*/
static char* OC_mkSymbol(char* name)
{
char* symbolCtr = OC_mkDotStr(SYMBOL, VCTR_SYMBOL);
size_t length = strlen(symbolCtr) + strlen(name) + 10;
char* rtptr= UTIL_mallocStr(length + 1);
strcpy(rtptr, "(");
strcat(rtptr, symbolCtr); free(symbolCtr);
strcat(rtptr, " \"");
strcat(rtptr, name);
strcat(rtptr, "\")");
return rtptr;
}
/*
(Symbol.symbolAlias "<name>" "<printName>")
*/
static char* OC_mkSymbolAlias(char *name, char *printName)
{
char* symbolCtr = OC_mkDotStr(SYMBOL, VCTR_SYMBOL_ALIAS);
size_t length = strlen(symbolCtr) + strlen(name) + strlen(printName) + 10;
char* rtptr= UTIL_mallocStr(length + 1);
strcpy(rtptr, "(");
strcat(rtptr, symbolCtr); free(symbolCtr);
strcat(rtptr, " \"");
strcat(rtptr, name);
strcat(rtptr, "\" \"");
strcat(rtptr, printName);
strcat(rtptr, "\")");
return rtptr;
}
/* let t = Table.add (Symbol.symbol "<name>") <varName> t in\n
*/
char* OC_mkTabEntry(char* name, char* varName)
{
char* entry;
char* tableAdd = OC_mkDotStr(TABLE, FUNC_ADD);
char* symbol = OC_mkSymbol(name);
size_t length = strlen(tableAdd) + strlen(symbol) + strlen(varName) +
strlen(TAB) + 15;
char* def = UTIL_mallocStr(length + 1);
strcpy(def, tableAdd); free(tableAdd);
strcat(def, " ");
strcat(def, symbol); free(symbol);
strcat(def, " ");
strcat(def, varName);
strcat(def, " ");
strcat(def, TAB);
strcat(def, " in\n ");
entry = OC_mkVarDef(TAB, def); free(def);
return entry;
}
/* let t = Table.SymbolTable.empty in \n*/
static char* OC_mkTabInit()
{
char* init;
char* emptyTab = OC_mkDotStr(TABLE, VCTR_EMPTYTAB);
size_t length = strlen(emptyTab) + 10;
char* def = UTIL_mallocStr(length + 1);
strcpy(def, emptyTab); free(emptyTab);
strcat(def, " in\n ");
init = OC_mkVarDef(TAB, def); free(def);
return init;
}
/* let <funcName> = function () ->\n
let t = Table.SymbolTable.empty in <entries> t\n\n */
static char* OC_mkBuildTabFunc(char* funcName, char* entries)
{
char* func;
char* inits = OC_mkTabInit();
size_t length = strlen(entries) + strlen(TAB) + strlen(inits) + 30;
char* def = UTIL_mallocStr(length + 1);
strcpy(def, "function () ->\n ");
strcat(def, inits); free(inits);
strcat(def, entries);
strcat(def, TAB);
strcat(def, "\n\n");
func = OC_mkVarDef(funcName, def); free(def);
return func;
}
/* let <tabName> = <buildFunc> ()\n\n */
static char* OC_mkTab(char* tabName, char* buildFuncName)
{
char* tab;
size_t length = strlen(buildFuncName) + 10;
char* def = UTIL_mallocStr(length + 1);
strcpy(def, buildFuncName);
strcat(def, " ()\n\n");
tab = OC_mkVarDef(tabName, def); free(def);
return tab;
}
/* val <tabName> = Absyn.<typeName> Table.SymbolTable.t\n */
static char* OC_mkTabDec(char* tabName, char* typeName)
{
char* dec;
char* symbolTab = OC_mkDotStr(TABLE, TY_SYMTAB);
char* myType = OC_mkDotStr(ABSYN, typeName);
size_t length = strlen(symbolTab) + strlen(myType) + 5;
char* typedec = UTIL_mallocStr(length + 1);
strcpy(typedec, myType); free(myType);
strcat(typedec, " ");
strcat(typedec, symbolTab); free(symbolTab);
strcat(typedec, "\n");
dec = OC_mkVarDec(tabName, typedec); free(typedec);
return dec;
}
/****************************************************************************/
/* functions for making pervasive kind relevant components */
/****************************************************************************/
/* k<name> */
char* OC_mkKVarName(char* name)
{
return UTIL_appendStr(KVAR_PREFIX, name);
}
/* is<name> */
char* OC_mkIsKindFuncName(char* name)
{
return UTIL_appendStr(IS, name);
}
/* val <kindVarName> : Absyn.akind \n*/
char* OC_mkKindVarDec(char* kindVarName)
{
char* kindType = OC_mkDotStr(ABSYN, TY_KIND);
char* dec = OC_mkVarDec(kindVarName, kindType);
free(kindType);
return dec;
}
/* val <funcName> : Absyn.akind -> bool */
char* OC_mkIsKindFuncDec(char* funcName)
{
char* kindType = OC_mkDotStr(ABSYN, TY_KIND);
char* arrowType = OC_mkArrowType(kindType, "bool");
char* dec = OC_mkVarDec(funcName, arrowType);
free(kindType); free(arrowType);
return dec;
}
/* let <funcName> tm = tm == <kindVarName> */
char* OC_mkIsKindFuncDef(char* funcName, char* kindVarName)
{
char* funchead = UTIL_mallocStr(strlen(funcName) + 3);
char* defbody = UTIL_mallocStr(strlen(kindVarName) + 10);
char* def;
strcpy(funchead, funcName);
strcat(funchead, " tm");
strcpy(defbody, "(tm == ");
strcat(defbody, kindVarName);
strcat(defbody, ")");
def = OC_mkVarDef(funchead, defbody); free(funchead); free(defbody);
return def;
}
/*Kind variable definition:
let <varName> = Absyn.PervasiveKind(Symbol.symbol "<kindName>",
(Some <arity>), ref offset, Errormsg.none)
*/
char* OC_mkKindVar(char* varName, char* kindName, char* arity, char* offset)
{
char* kindvar;
char* ctr = OC_mkDotStr(ABSYN, VCTR_KIND);
char* symbol = OC_mkSymbol(kindName);
char* nargs = OC_mkSome(arity);
char* index = OC_mkRef(offset);
char* ktype = OC_mkDotStr(ABSYN, VCTR_KINDTYPE);
char* pos = OC_mkDotStr(ERRORMSG, VCTR_NULLPOS);
size_t length = strlen(ctr) + strlen(symbol) + strlen(nargs) +
strlen(index) + strlen(ktype) + strlen(pos) + 10;
char* def = UTIL_mallocStr(length + 1);
strcpy(def, ctr); free(ctr);
strcat(def, "(");
strcat(def, symbol); free(symbol);
strcat(def, ", ");
strcat(def, nargs); free(nargs);
strcat(def, ", ");
strcat(def, index); free(index);
strcat(def, ", ");
strcat(def, ktype); free(ktype);
strcat(def, ", ");
strcat(def, pos); free(pos);
strcat(def, ")");
kindvar = OC_mkVarDef(varName, def); free(def);
return kindvar;
}
/* let buildPervasiveKinds =
function () ->\n <inits> <entries>\n <tabName>\n\n */
char* OC_mkBuildKTabFunc(char* entries)
{
return OC_mkBuildTabFunc(BUILDPERVKIND, entries);
}
/****************************************************************************/
/* functions for making pervasive type skeleton components */
/****************************************************************************/
/* Absyn.SkeletonVarType(ref <ind>)
*/
static char* genTySkelVar(char* ind)
{
char* ctr = OC_mkDotStr(ABSYN, VCTR_SKELVARTYPE);
char* ref = OC_mkRef(ind);
size_t length = strlen(ctr) + strlen(ref) + 5;
char* skelVar = UTIL_mallocStr(length + 1);
strcpy(skelVar, ctr); free(ctr);
strcat(skelVar, "(");
strcat(skelVar, ref); free(ref);
strcat(skelVar, ")");
return skelVar;
}
/* Absyn.ArrowType(<type1>, <type2>)
*/
static char* genTySkelArrow(char* type1, char* type2)
{
char* ctr = OC_mkDotStr(ABSYN, VCTR_ARROWTYPE);
size_t length = strlen(ctr) + strlen(type1) + strlen(type2) + 5;
char* arrowtype = UTIL_mallocStr(length + 1);
strcpy(arrowtype, ctr); free(ctr);
strcat(arrowtype, "(");
strcat(arrowtype, type1);
strcat(arrowtype, ", ");
strcat(arrowtype, type2);
strcat(arrowtype, ")");
return arrowtype;
}
/* Absyn.AppType(k<sortName>, <args>)
*/
static char* genTySkelApp(char* sortName, char* args)
{
char* ctr = OC_mkDotStr(ABSYN, VCTR_APPTYPE);
char* sortVar = OC_mkKVarName(sortName);
size_t length = strlen(ctr) + strlen(sortVar) + strlen(args) + 5;
char* apptype = UTIL_mallocStr(length + 1);
strcpy(apptype, ctr); free(ctr);
strcat(apptype, "(");
strcat(apptype, sortVar); free(sortVar);
strcat(apptype, ", ");
strcat(apptype, args);
strcat(apptype, ")");
return apptype;
}
/* Absyn.AppType(k<sortName>, [])
*/
static char* genTySkelSort(char* sortName)
{
return genTySkelApp(sortName, "[]");
}
//forward declaration
char* OC_genTySkel(Type args);
static char* OC_genTySkelArgs(TypeList args)
{
size_t length;
char* mytext1 = NULL;
char* mytext = NULL;
char* oneTypeText = NULL;
Type oneType = args -> oneType;
args = args -> next;
mytext1 = OC_genTySkel(oneType);
while (args) {
oneType = args -> oneType;
args = args -> next;
oneTypeText = OC_genTySkel(oneType);
length = strlen(mytext1) + strlen(oneTypeText) + 5;
mytext = UTIL_mallocStr(length + 1);
strcpy(mytext, mytext1); free(mytext1);
strcat(mytext, " :: ");
strcat(mytext, oneTypeText); free(oneTypeText);
mytext1 = mytext;
}
length = strlen(mytext1) + 10;
mytext = UTIL_mallocStr(length + 1);
strcpy(mytext, "(");
strcat(mytext, mytext1); free(mytext1);
strcat(mytext, " :: [])");
return mytext;
}
char* OC_genTySkel(Type tyskel)
{
char* mytext1;
char* mytext2;
char* mytext3;
switch(tyskel -> tag) {
case SORT:
{
mytext1 = genTySkelSort(tyskel -> data.sort);
return mytext1;
}
case SKVAR:
{
mytext1 = genTySkelVar(tyskel -> data.skvar);
return mytext1;
}
case STR:
{
mytext1 = OC_genTySkelArgs(tyskel -> data.str.args);
mytext2 = genTySkelApp((tyskel -> data.str.functor)->data.func.name,
mytext1);
free(mytext1);
return mytext2;
}
case ARROW:
{
mytext1 = OC_genTySkel(tyskel -> data.arrow.lop);
mytext2 = OC_genTySkel(tyskel -> data.arrow.rop);
mytext3 = genTySkelArrow(mytext1, mytext2);
free(mytext1); free(mytext2);
return mytext3;
}
default:
return strdup("");
}
}
/* tyskel<number> */
char* OC_mkTySkelVarName(char* number)
{
return UTIL_appendStr(TSKVAR_PREFIX, number);
}
/* Type Skeleton variable definition:
let <varName> = Some(Absyn.Skeleton(<tySkel>, ref None, ref false))
*/
char* OC_mkTYSkelVar(char* varName, char* tySkel)
{
char* tyskelvar;
char* ctr = OC_mkDotStr(ABSYN, VCTR_TYSKEL);
char* index = OC_mkRef("None");
char* adjust = OC_mkRef("false");
size_t length = strlen(ctr) + strlen(index) + strlen(adjust) +
strlen(tySkel) + 15;
char* def = UTIL_mallocStr(length + 1);
char* somedef;
strcpy(def, "(");
strcat(def, ctr); free(ctr);
strcat(def, "(");
strcat(def, tySkel);
strcat(def, ", ");
strcat(def, index); free(index);
strcat(def, ", ");
strcat(def, adjust); free(adjust);
strcat(def, "))");
somedef = OC_mkSome(def); free(def);
tyskelvar = OC_mkVarDef(varName, somedef); free(somedef);
return tyskelvar;
}
static char* OC_mkTypeSetVar(char* defaultty, char* arglist, char* tyName)
{
char* setVar;
char* func = OC_mkDotStr(ABSYN, FUNC_MAKETYSETVAR);
char* def = UTIL_mallocStr(strlen(func) + strlen(arglist) + strlen(defaultty) + 2);
strcpy(def, func); free(func);
strcat(def, " ");
strcat(def, defaultty);
strcat(def, " ");
strcat(def, arglist);
setVar = OC_mkVarDef(tyName, def); free(def);
return setVar;
}
/*********************************************/
/* generate tyskels for overloaded constants */
/*********************************************/
static char* OC_mkTySkelRef(char* tySkel)
{
char* ctr = OC_mkDotStr(ABSYN, VCTR_TYSKEL);
char* index = OC_mkRef("None");
char* adjust = OC_mkRef("false");
size_t length = strlen(ctr) + strlen(index) + strlen(adjust) +
strlen(tySkel) + 15;
char* def = UTIL_mallocStr(length + 1);
char* somedef;
char* ref;
strcpy(def, "(");
strcat(def, ctr); free(ctr);
strcat(def, "(");
strcat(def, tySkel);
strcat(def, ", ");
strcat(def, index); free(index);
strcat(def, ", ");
strcat(def, adjust); free(adjust);
strcat(def, "))");
somedef = OC_mkSome(def); free(def);
ref = OC_mkRef(somedef); free(somedef);
return ref;
}
char* OC_mkFixedTySkels(char* tySkels)
{
char *text;
char* setvarIntReal =
OC_mkTypeSetVar("(Absyn.ApplicationType(kint,[]))",
"(Absyn.ApplicationType(kint,[]) :: Absyn.ApplicationType(kreal,[]) :: [])", SETVARIR);
char* setvarIntRealStr =
OC_mkTypeSetVar("(Absyn.ApplicationType(kint,[]))",
"(Absyn.ApplicationType(kint,[]) :: Absyn.ApplicationType(kreal,[]) :: Absyn.ApplicationType(kstring, []) :: [])", SETVARIRS);
char *tyskelBody, *tyskelBody2;
char *tyskel, *tyskelText;
text = UTIL_appendStr(tySkels, setvarIntReal); free(setvarIntReal);
tySkels = UTIL_appendStr(text, "\n"); free(text);
tyskelBody = genTySkelArrow(SETVARIR, SETVARIR);
tyskelText = OC_mkTySkelRef(tyskelBody);
tyskel = OC_mkVarDef(OVERLOADTYSKEL1, tyskelText); free(tyskelText);
text = UTIL_appendStr(tySkels, tyskel); free(tyskel);
tySkels = UTIL_appendStr(text, "\n"); free(text);
tyskelBody2 = genTySkelArrow(SETVARIR, tyskelBody); free(tyskelBody);
tyskelText = OC_mkTySkelRef(tyskelBody2); free(tyskelBody2);
tyskel = OC_mkVarDef(OVERLOADTYSKEL2, tyskelText); free(tyskelText);
text = UTIL_appendStr(tySkels, tyskel); free(tyskel);
tySkels = UTIL_appendStr(text, "\n\n"); free(text);
text = UTIL_appendStr(tySkels, setvarIntRealStr); free(setvarIntRealStr);
tySkels = UTIL_appendStr(text, "\n"); free(text);
tyskelBody = genTySkelArrow(SETVARIRS, "Absyn.ApplicationType(kbool, [])");
tyskelBody2 = genTySkelArrow(SETVARIRS, tyskelBody); free(tyskelBody);
tyskelText = OC_mkTySkelRef(tyskelBody2); free(tyskelBody2);
tyskel = OC_mkVarDef(OVERLOADTYSKEL3, tyskelText); free(tyskelText);
text = UTIL_appendStr(tySkels, tyskel); free(tyskel);
tySkels = UTIL_appendStr(text, "\n\n"); free(text);
return tySkels;
}
/****************************************************************************/
/* functions for making pervasive constants components */
/****************************************************************************/
/* <name>Constant */
char* OC_mkCVarName(char* name)
{
return UTIL_appendStr(name, CVAR_POSTFIX);
}
/* is<name>Constant */
char* OC_mkIsConstFuncName(char* name)
{
return UTIL_appendStr(IS, name);
}
/* val <constVarName> : Absyn.aconstant \n*/
char* OC_mkConstVarDec(char* constVarName)
{
char* constType = OC_mkDotStr(ABSYN, TY_CONST);
char* dec = OC_mkVarDec(constVarName, constType);
free(constType);
return dec;
}
/* val <funcName> : Absyn.aconstant -> bool */
char* OC_mkIsConstFuncDec(char* funcName)
{
char* constType = OC_mkDotStr(ABSYN, TY_CONST);
char* arrowType = OC_mkArrowType(constType, "bool");
char* dec = OC_mkVarDec(funcName, arrowType);
free(constType); free(arrowType);
return dec;
}
/* let <funcName> tm = tm == <constVarName> */
char* OC_mkIsConstFuncDef(char* funcName, char* constVarName)
{
char* funchead = UTIL_mallocStr(strlen(funcName) + 3);
char* defbody = UTIL_mallocStr(strlen(constVarName) + 10);
char* def;
strcpy(funchead, funcName);
strcat(funchead, " tm");
strcpy(defbody, "(tm == ");
strcat(defbody, constVarName);
strcat(defbody, ")");
def = OC_mkVarDef(funchead, defbody); free(funchead); free(defbody);
return def;
}
/* (ref fixity) */
static char* OC_mkFixity(OP_Fixity fixity)
{
switch (fixity){
case OP_INFIX : return OC_mkRef(strdup(INFIX));
case OP_INFIXL : return OC_mkRef(strdup(INFIXL));
case OP_INFIXR : return OC_mkRef(strdup(INFIXR));
case OP_PREFIX : return OC_mkRef(strdup(PREFIX));
case OP_PREFIXR : return OC_mkRef(strdup(PREFIXR));
case OP_POSTFIX : return OC_mkRef(strdup(POSTFIX));
case OP_POSTFIXL : return OC_mkRef(strdup(POSTFIXL));
case OP_NONE : return OC_mkRef(strdup(NOFIXITY));
default : return OC_mkRef(strdup(NOFIXITY));
}
}
/* (ref prec) */
static char* OC_mkPrec(OP_Prec prec)
{
char* precNum;
char* precText;
if (OP_precIsMax(prec)) {
char* temp = OC_mkDotStr(ABSYN, MAXPREC);
precNum = UTIL_mallocStr(strlen(temp) + 2);
strcpy(precNum, "(");
strcat(precNum, temp);
strcat(precNum, ")");
} else precNum = UTIL_itoa(prec.data.prec);
precText = OC_mkRef(precNum); free(precNum);
return precText;
}
/* (ref true/false ) */
static char* OC_mkRefBool(UTIL_Bool value)
{
if (value) return OC_mkRef("true");
else return OC_mkRef("false");
}
static char* OC_mkRefInt(int value)
{
char* valueText = UTIL_itoa(value);
char* text = OC_mkRef(valueText);
free(valueText);
return text;
}
static char* OC_mkCodeInfo(OP_Code codeInfo)
{
char* code;
char* ref;
if (OP_codeInfoIsNone(codeInfo)) {
code = strdup("None");
} else {
char* codeInd = UTIL_itoa(codeInfo);
char* ctr = OC_mkDotStr(ABSYN, VCTR_BUILTIN);
char* codeText = UTIL_mallocStr(strlen(codeInd) + strlen(ctr) + 10);
strcpy(codeText, "(");
strcat(codeText, ctr); free(ctr);
strcat(codeText, "(");
strcat(codeText, codeInd); free(codeInd);
strcat(codeText, "))");
code = OC_mkSome(codeText); free(codeText);
}
ref = OC_mkRef(code); free(code);
return ref;
}
static char* OC_mkConstCat(UTIL_Bool redef)
{
char* ctr = OC_mkDotStr(ABSYN,VCTR_PERVCONST);
char* boolValue;
char* cat;
char* ref;
if (redef) boolValue = strdup("true");
else boolValue = strdup("false");
cat = UTIL_mallocStr(strlen(ctr) + strlen(boolValue) + 10);
strcpy(cat, "(");
strcat(cat, ctr); free(ctr);
strcat(cat, "(");
strcat(cat, boolValue); free(boolValue);
strcat(cat, "))");
ref = OC_mkRef(cat); free(cat);
return ref;
}
static char* OC_mkSkelNeededness(int tyenvsize)
{
char* length = UTIL_itoa(tyenvsize);
char* some;
char* ref;
char* init = UTIL_mallocStr(strlen(length) + 20);
strcpy(init, "(Array.make ");
strcat(init, length); free(length);
strcat(init, " true)");
some = OC_mkSome(init); free(init);
ref = OC_mkRef(some); free(some);
return ref;
}
static char* OC_mkNeededness(int neededness, int tyenvsize)
{
char* length = UTIL_itoa(tyenvsize);
char* init;
char* some;
char* ref;
if (neededness == tyenvsize) {
init = UTIL_mallocStr(strlen(length) + 20);
strcpy(init, "(Array.make ");
strcat(init, length); free(length);
strcat(init, " true)");
} else {
char* num = UTIL_itoa(neededness);
init = UTIL_mallocStr(strlen(length) + strlen(num) + 60);
strcpy(init, "(Array.init ");
strcat(init, length); free(length);
strcat(init, " (fun x -> if x >= ");
strcat(init, num); free(num);
strcat(init, " then false else true))");
}
some = OC_mkSome(init); free(init);
ref = OC_mkRef(some); free(some);
return ref;
}
static char* OC_mkConstVarText(char* constName, char* fixity, char* prec,
char* typrev, char* tyskel, char* tyenvsize,
char* skelneededness, char* neededness, char* codeinfo,
char* constcat, char* varname, char* offset,
char* printName)
{
char* constVar;
char* ctr = OC_mkDotStr(ABSYN, VCTR_CONSTANT);
char* symbol = OC_mkSymbolAlias(constName, printName);
char* refFalse = OC_mkRef("false");
char* refTrue = OC_mkRef("true");
char* index = OC_mkRef(offset);
char* pos = OC_mkDotStr(ERRORMSG, VCTR_NULLPOS);
size_t length = strlen(ctr) + strlen(symbol) + strlen(fixity) +
strlen(prec) + strlen(typrev) + strlen(tyskel) + strlen(tyenvsize) +
strlen(skelneededness) + strlen(neededness) + strlen(codeinfo) +
strlen(constcat) + strlen(index) + strlen(pos) + strlen(refFalse) * 6 + 35;
char* def = UTIL_mallocStr(length);
strcpy(def, ctr); free(ctr);
strcat(def, "(");
strcat(def, symbol); free(symbol);
strcat(def, ", ");
strcat(def, fixity);
strcat(def, ", ");
strcat(def, prec);
strcat(def, ", ");
strcat(def, refFalse);
strcat(def, ", ");
strcat(def, refFalse);
strcat(def, ", ");
strcat(def, refTrue); free(refTrue); /* no defs */
strcat(def, ", ");
strcat(def, refFalse);
strcat(def, ", ");
strcat(def, typrev);
strcat(def, ", ");
strcat(def, refFalse); free(refFalse);
strcat(def, ", ");
strcat(def, tyskel);
strcat(def, ", ");
strcat(def, tyenvsize);
strcat(def, ", ");
strcat(def, skelneededness);
strcat(def, ", ");
strcat(def, neededness);
strcat(def, ", ");
strcat(def, codeinfo);
strcat(def, ", ");
strcat(def, constcat);
strcat(def, ", ");
strcat(def, index); free(index);
strcat(def, ", ");
strcat(def, pos); free(pos);
strcat(def, ")");
constVar = OC_mkVarDef(varname, def); free(def);
return constVar;
}
/* Constant variable definition :
let <varName> = Absyn.Constant(Symbol.symbolAlias "<constName>" "<printName>",
ref <fixity>, ref <prec>, ref false, ref false, ref false, ref false,
ref false, ref <typrev>, ref false, ref <tySkel>,
ref <tyenvsize>, ref (Some <skelneededness>),
ref (Some <neededness>), ref <codeInfo>,
ref <constantCat>, ref 0, Errormsg.none)
*/
char* OC_mkConstVar(char* constName, OP_Fixity fixity, OP_Prec prec,
UTIL_Bool typrev, char* tySkel, int tyenvsize,
int neededness, OP_Code codeInfo, UTIL_Bool reDef,
char* varName, char* offset, char* printName)
{
char* constVar;
char* fixityText = OC_mkFixity(fixity);
char* precText = OC_mkPrec(prec);
char* typrevText = OC_mkRefBool(typrev);
char* tySkelText = OC_mkRef(tySkel);
char* tyenvsizeText = OC_mkRefInt(tyenvsize);
char* skelneedednessText = OC_mkSkelNeededness(tyenvsize);
char* needednessText = OC_mkNeededness(neededness, tyenvsize);
char* codeInfoText = OC_mkCodeInfo(codeInfo);
char* constCatText = OC_mkConstCat(reDef);
constVar = OC_mkConstVarText(constName, fixityText, precText,
typrevText, tySkelText, tyenvsizeText,
skelneedednessText, needednessText, codeInfoText,
constCatText, varName, offset, printName);
free(fixityText); free(precText); free(typrevText); free(tySkelText);
free(tyenvsizeText); free(skelneedednessText); free(needednessText);
free(codeInfoText); free(constCatText);
return constVar;
}
#define GENERICAPPLY "genericApplyConstant"
#define OVERLOADUMINUS "overloadUMinusConstant"
#define OVERLOADABS "overloadAbsConstant"
#define OVERLOADPLUS "overloadPlusConstant"
#define OVERLOADMINUS "overloadMinusConstant"
#define OVERLOADTIME "overloadTimeConstant"
#define OVERLOADLT "overloadLTConstant"
#define OVERLOADGT "overloadGTConstant"
#define OVERLOADLE "overloadLEConstant"
#define OVERLOADGE "overloadGEConstant"
static char* OC_mkOverLoadConstVar(char* name, char* fixity, char* prec,
char* tyskel, char* varName)
{
char* constVar;
constVar = OC_mkConstVarText(name, fixity, prec, "ref true", tyskel,
"ref 0", "ref(Some(Array.make 0 true))", "ref None", "ref None",
"ref(Absyn.PervasiveConstant(false))",
varName, "0", name);
return constVar;
}
/* generate fixed constants */
char* OC_mkGenericConstVar(char* varList)
{
char* text;
char* constVar;
constVar = OC_mkConstVarText(" apply", "ref Absyn.Infixl",
"ref (Absyn.maxPrec + 2)", "ref false",
"ref(Some(Absyn.Skeleton(Absyn.ErrorType, ref None, ref false)))",
"ref 0", "ref(Some(Array.make 0 true))", "ref None", "ref None",
"ref(Absyn.PervasiveConstant(false))", GENERICAPPLY, "0",
" apply");
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkOverLoadConstVar("~", "ref Absyn.Prefix",
"ref (Absyn.maxPrec + 1)", OVERLOADTYSKEL1,
OVERLOADUMINUS);
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkConstVarText("abs", "ref Absyn.NoFixity",
"ref 0", "ref true",
OVERLOADTYSKEL1,
"ref 0", "ref(Some(Array.make 0 true))",
"ref None", "ref None",
"ref(Absyn.PervasiveConstant(true))",
OVERLOADABS, "0", "abs");
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkOverLoadConstVar("+", "ref Absyn.Infixl", "ref 150",
OVERLOADTYSKEL2, OVERLOADPLUS);
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkOverLoadConstVar("-", "ref Absyn.Infixl", "ref 150",
OVERLOADTYSKEL2, OVERLOADMINUS);
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkOverLoadConstVar("*", "ref Absyn.Infixl", "ref 160",
OVERLOADTYSKEL2, OVERLOADTIME);
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkOverLoadConstVar("<", "ref Absyn.Infix", "ref 130",
OVERLOADTYSKEL3, OVERLOADLT);
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkOverLoadConstVar(">", "ref Absyn.Infix", "ref 130",
OVERLOADTYSKEL3, OVERLOADGT);
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkOverLoadConstVar("<", "ref Absyn.Infix", "ref 130",
OVERLOADTYSKEL3, OVERLOADLE);
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
constVar = OC_mkOverLoadConstVar(">=", "ref Absyn.Infix", "ref 130",
OVERLOADTYSKEL3, OVERLOADGE);
text = UTIL_appendStr(varList, constVar); free(constVar);
varList = UTIL_appendStr(text, "\n\n"); free(text);
return varList;
}
/* generate fixed constants decs */
char* OC_mkGenericConstVarDec(char* decList)
{
char* text;
char* dec;
dec = OC_mkConstVarDec(GENERICAPPLY);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADUMINUS);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADABS);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADPLUS);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADMINUS);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADTIME);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADLT);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADGT);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADLE);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
dec = OC_mkConstVarDec(OVERLOADGE);
text = UTIL_appendStr(decList, dec); free(decList); free(dec);
decList = text;
return decList;
}
/* generate fixed constants entry in buildConstant function */
char* OC_mkGenericConstTabEntry(char* entries)
{
char* text;
char* tabEntry;
tabEntry = OC_mkTabEntry("~", OVERLOADUMINUS);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
tabEntry = OC_mkTabEntry("abs", OVERLOADABS);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
tabEntry = OC_mkTabEntry("+", OVERLOADPLUS);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
tabEntry = OC_mkTabEntry("-", OVERLOADMINUS);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
tabEntry = OC_mkTabEntry("*", OVERLOADTIME);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
tabEntry = OC_mkTabEntry("<", OVERLOADLT);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
tabEntry = OC_mkTabEntry(">", OVERLOADGT);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
tabEntry = OC_mkTabEntry("<=", OVERLOADLE);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
tabEntry = OC_mkTabEntry(">=", OVERLOADGE);
text = UTIL_appendStr(entries, tabEntry);
free(tabEntry); free(entries);
entries = text;
return entries;
}
/* let buildPervasiveKinds =
function () ->\n <inits> <entries>\n <tabName>\n\n */
char* OC_mkBuildCTabFunc(char* entries)
{
return OC_mkBuildTabFunc(BUILDPERVCONST, entries);
}
/* make generaic const is function decs */
char* OC_mkGenericConstFuncDecs(char* funcDefs)
{
char* funcName;
char* def;
char* text;
funcName = OC_mkIsConstFuncName(GENERICAPPLY);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADUMINUS);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADABS);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADPLUS);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADMINUS);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADTIME);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADLT);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADGT);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADLE);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
funcName = OC_mkIsConstFuncName(OVERLOADGE);
def = OC_mkIsConstFuncDec(funcName); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = text;
return funcDefs;
}
/* make generaic const is function defs */
char* OC_mkGenericConstFuncDefs(char* funcDefs)
{
char* funcName;
char* def;
char* text;
funcName = OC_mkIsConstFuncName(GENERICAPPLY);
def = OC_mkIsConstFuncDef(funcName, GENERICAPPLY); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADUMINUS);
def = OC_mkIsConstFuncDef(funcName, OVERLOADUMINUS); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADABS);
def = OC_mkIsConstFuncDef(funcName, OVERLOADABS); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADPLUS);
def = OC_mkIsConstFuncDef(funcName, OVERLOADPLUS); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADMINUS);
def = OC_mkIsConstFuncDef(funcName, OVERLOADMINUS); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADTIME);
def = OC_mkIsConstFuncDef(funcName, OVERLOADTIME); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADLT);
def = OC_mkIsConstFuncDef(funcName, OVERLOADLT); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADGT);
def = OC_mkIsConstFuncDef(funcName, OVERLOADGT); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADLE);
def = OC_mkIsConstFuncDef(funcName, OVERLOADLE); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
funcName = OC_mkIsConstFuncName(OVERLOADGE);
def = OC_mkIsConstFuncDef(funcName, OVERLOADGE); free(funcName);
text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
return funcDefs;
}
char* OC_mkCompare(char* name)
{
char* text = UTIL_mallocStr(strlen(name) + 15);
strcpy(text, "(const == ");
strcat(text, name);
strcat(text, ")");
return text;
}
char* OC_mkOr(char* operandl, char* operandr)
{
char* text = UTIL_mallocStr(strlen(operandl) + strlen(operandr) + 5);
strcpy(text, operandl);
strcat(text, " || ");
strcat(text, operandr);
return text;
}
#define PERV_REGCLOB_DEF_BEG "let regClobberingPerv const = \n if ("
#define PERV_REGCLOB_DEF_END ") then true else false \n\n"
char* OC_mkRegClobFunc(char* body)
{
char* text = UTIL_mallocStr(strlen(PERV_REGCLOB_DEF_BEG) + strlen(body) +
strlen(PERV_REGCLOB_DEF_END));
strcpy(text, PERV_REGCLOB_DEF_BEG);
strcat(text, body);
strcat(text, PERV_REGCLOB_DEF_END);
return text;
}
#define PERV_BCK_DEF_BEG "let backtrackablePerv const = \n if ("
#define PERV_BCK_DEF_END ") then true else false \n\n"
char* OC_mkBackTrackFunc(char* body)
{
char* text = UTIL_mallocStr(strlen(PERV_BCK_DEF_BEG) + strlen(body) +
strlen(PERV_BCK_DEF_END));
strcpy(text, PERV_BCK_DEF_BEG);
strcat(text, body);
strcat(text, PERV_BCK_DEF_END);
return text;
}
/*****************************************************************************/
/* functions for making the fixed part of pervasive.mli */
/*****************************************************************************/
#define TERM_DECS \
"val implicationTerm : Absyn.aterm\nval andTerm : Absyn.aterm\n"
#define PERV_FUNC_DECS \
"val isPerv : Absyn.aconstant -> bool \nval regClobberingPerv : Absyn.aconstant -> bool \nval backtrackablePerv : Absyn.aconstant -> bool\n"
/*
val pervasiveKinds : Absyn.akind Table.SymbolTable.t
val pervasiveConstants : Absyn.aconstant Table.SymbolTable.t
val pervasiveTypeAbbrevs : Absyn.atypeabbrev Table.SymbolTable.t
*/
char* OC_mkFixedMLI()
{
char* kindDec = OC_mkTabDec(PERVKIND, TY_KIND);
char* constDec = OC_mkTabDec(PERVCONST, TY_CONST);
char* tyabbrDec = OC_mkTabDec(PERVTYABBR, TY_TYABBREV);
size_t length = strlen(kindDec) + strlen(constDec) + strlen(tyabbrDec) +
strlen(TERM_DECS) + strlen(PERV_FUNC_DECS) + 10;
char* decs = UTIL_mallocStr(length + 1);
strcpy(decs, kindDec); free(kindDec);
strcat(decs, constDec); free(constDec);
strcat(decs, tyabbrDec); free(tyabbrDec);
strcat(decs, "\n");
strcat(decs, TERM_DECS);
strcat(decs, "\n");
strcat(decs, PERV_FUNC_DECS);
strcat(decs, "\n");
return decs;
}
/*****************************************************************************/
/* functions for making the fixed part of pervasive.ml */
/*****************************************************************************/
#define TERM_DEFS \
"let andTerm = Absyn.ConstantTerm(andConstant, [], false, Errormsg.none) \nlet implicationTerm = Absyn.ConstantTerm(implConstant, [], false, Errormsg.none)\n"
#define PERV_ISPERV_DEF \
"let isPerv const = \n let constCat = Absyn.getConstantType(const) in \n match constCat with \n Absyn.PervasiveConstant(_) -> true \n | _ -> false \n"
/*
let pervasiveKinds = buildPervasiveKinds ()
let pervasiveConstants = buildPervasiveConstants ()
let pervasiveTypeAbbrevs = Table.SymbolTable.empty
*/
char* OC_mkFixedML()
{
char* kindDef = OC_mkTab(PERVKIND, BUILDPERVKIND);
char* constDef = OC_mkTab(PERVCONST, BUILDPERVCONST);
char* emptyTab = OC_mkDotStr(TABLE, VCTR_EMPTYTAB);
char* tyabbrDef = OC_mkVarDef(PERVTYABBR, emptyTab);
size_t length = strlen(kindDef) + strlen(constDef) + strlen(tyabbrDef) +
strlen(TERM_DEFS) + strlen(PERV_ISPERV_DEF) + 10;
char* defs = UTIL_mallocStr(length + 1);
free(emptyTab);
strcpy(defs, kindDef); free(kindDef);
strcat(defs, constDef); free(constDef);
strcat(defs, tyabbrDef); free(tyabbrDef);
strcat(defs, "\n\n");
strcat(defs, TERM_DEFS);
strcat(defs, "\n");
strcat(defs, PERV_ISPERV_DEF);
strcat(defs, "\n");
return defs;
}