:Begin: :Function: formget :Pattern: FormGet[filename_String, debug_Integer:0] :Arguments: {filename, debug} :ArgumentTypes: {String, Integer} :ReturnType: Manual :End: :Evaluate: FormGet::nofile = "Cannot open `1`." :Evaluate: FormGet::nooutput = "Something went wrong, there was no output from FORM." :Evaluate: FormGet::formerror = "`1`" :Evaluate: FormGet::parse = "Unclosed bracket in line `1`." /* FormGet.tm [last modified 1 Mar 10, Thomas Hahn ] This program provides a Mathematica function FormGet which reads output files of FORM into Mathematica. (FORM is a computer algebra system commonly used in high-energy physics.) The output format of FORM is slightly different from Mathematica's InputForm, and while the translations (e.g. round brackets into square brackets for functions) are in most cases straightforward to perform with any decent pattern-matching language like perl or awk, it becomes a pain to program this for every FORM file one may want to read. In addition, FormGet preserves the structure of the FORM output if it was grouped into common factors with the bracket command. COMPILATION: Type "mcc -O -o FormGet FormGet.tm", then if you want, copy the executable FormGet to some convenient location like /usr/local/bin. USAGE: Install the package in Mathematica: Install["FormGet"]. Read an existing FORM output file: FormGet["filename"]. Read output from a FORM pipe: FormGet["!form arguments"]. OUTPUT: An expression which is written out by FORM as expr = a + b + c; arrives in Mathematica as "expr -> a + b + c". If several expressions are present in the FORM file, a list of such rules is returned. Bracketed parts are returned inside the function "Br". The imaginary unit ("i_" in FORM) is converted to Mathematica's I, and all underscores are replaced by "$" characters to make the expression acceptable for Mathematica. Identifiers with square brackets are returned as strings, i.e. are not directly evaluated. For instance, the FORM expression [a+b] + c becomes "a+b" + c in Mathematica. FormGet should normally steer clear of source listing and statistics messages. In the case of problems, however, please try turning off source listing with "#-" and/or statistics with "nwrite statistics" in FORM. RESTRICTIONS: In FORM it is possible to have noncommuting functions, whose product is also written with the ordinary "*" operator. Hence, if transferred to Mathematica using FormGet, the order of such a product will most likely get destroyed. One way of working around this is something like FormGetNC[file_] := Block[{Times = times}, FormGet[file]] NCFunctions = a | b | c | d (* the functions which are noncommuting *) times[n__] := Times[n] /; FreeQ[{n}, NCFunctions] times[n__] := NonCommutativeMultiply[n] */ #include "mathlink.h" #include #include #include typedef struct rhs { struct rhs *next; char expr[1024]; } RHS; typedef struct expr { struct expr *next; RHS *rhs; int nrhs; char lhs[128]; } EXPR; typedef const int cint; typedef char *string; typedef MLCONST char *cstring; static inline void MLMessage(MLINK mlp, cstring tag, cstring arg) { MLPutFunction(mlp, "CompoundExpression", 2); MLPutFunction(mlp, "Message", (arg) ? 2 : 1); MLPutFunction(mlp, "MessageName", 2); MLPutSymbol(mlp, "FormGet"); MLPutString(mlp, tag); if( arg ) MLPutString(mlp, arg); } static inline void MLFail(MLINK mlp, cstring tag, cstring arg) { MLMessage(mlp, tag, arg); MLPutSymbol(mlp, "$Failed"); MLEndPacket(mlp); } static inline void MLPutTerm(MLINK mlp, cstring s) { MLPutFunction(mlp, "ToExpression", 1); MLPutString(mlp, s); } static void sendexpr(EXPR *expr, cint nexpr, cint debug) { EXPR *ep, *epnext; RHS *rp, *rpnext; if( nexpr == 0 ) MLMessage(stdlink, "nooutput", NULL); MLPutFunction(stdlink, "List", nexpr); for( ep = expr; (epnext = ep->next); ep = epnext ) { MLPutFunction(stdlink, "Rule", 2); MLPutFunction(stdlink, "ToExpression", 1); MLPutString(stdlink, ep->lhs); if( debug & 2 ) fprintf(stderr, "lhs = |%s|\n", ep->lhs); MLPutFunction(stdlink, "ToExpression", 1); if( ep->nrhs > 1 ) MLPutFunction(stdlink, "StringJoin", ep->nrhs); for( rp = ep->rhs; rp; rp = rpnext ) { MLPutString(stdlink, rp->expr); if( debug & 2 ) fprintf(stderr, "expr = |%s|\n", rp->expr); rpnext = rp->next; free(rp); } free(ep); } free(ep); MLEndPacket(stdlink); } static void formget(cstring filename, int debug) { FILE *file; char *s, *d, *x, last; char br[64], *brpos; int nexpr = -1, inexpr = 0, b = 0, verb = 0, n, nx; int justbr; char line[512], errmsg[512], *errend = errmsg; EXPR *cur, *expr, **nextexpr = &expr; RHS **nextrhs; file = (*filename == '!') ? popen(filename + 1, "r") : fopen(filename, "r"); if( file == NULL ) { MLFail(stdlink, "nofile", filename); return; } nextexpr: ++nexpr; *nextexpr = cur = malloc(sizeof(EXPR)); nextexpr = &cur->next; *nextexpr = NULL; nextrhs = &cur->rhs; *nextrhs = NULL; cur->nrhs = 0; d = cur->lhs; n = sizeof(cur->lhs); nx = justbr = 0; brpos = NULL; last = '+'; nextline: do { if( fgets(line, sizeof line, file) == NULL ) { (*filename == '!' ? pclose : fclose)(file); if( errend == errmsg ) sendexpr(expr, nexpr, debug); else { errend[-1] = 0; /* discard last \n */ MLFail(stdlink, "formerror", errmsg); } return; } if( debug & 1 ) fputs(line, stderr); if( *line == '\n' ) continue; if( (s = strstr(line, "-->")) || (s = strstr(line, "==>")) || (s = strstr(line, "===")) ) { strncpy(errend, s + 4, errmsg + sizeof(errmsg) - errend); errend += strlen(errend); continue; } } while( errend > errmsg ); if( inexpr == 0 ) { int tok = 0, verb = 0; char *eq = strchr(line, '='); if( eq == NULL || strchr(eq + 1, '=') ) goto nextline; for( s = line; s < eq; ++s ) switch( *s | verb ) { case ' ': tok |= 2*(tok & 1); break; case '[': case ']' + 256: verb ^= 256; default: if( tok == 3 ) goto nextline; tok |= 1; } } #define ASSOCIATIVE strchr("+-*/^,([", last) if( justbr ) nx = 4, x = " ", brpos = d; justbr = 0; for( s = line; *s; ++s ) { char c = *s; if( c <= ' ' ) continue; switch( c | verb ) { case ';': inexpr = 0; if( brpos && justbr == 0 ) { memcpy(brpos, "+Br[", 4); *d++ = ']'; } *d = 0; goto nextexpr; case '=': inexpr = 1; n = 0; *d = 0; continue; case '(': if( ASSOCIATIVE ) { if( b ) { br[b++] = ')'; break; } nx = 2, x = "Br"; } c = '[', br[b++] = ']' | (nx << 6); break; case ')': case ']': if( b > 0 ) c = br[--b]; justbr |= c >> 7; c &= 0x7f; break; case '[': if( ASSOCIATIVE ) verb = 256, c = '\"'; else br[b++] = ']'; break; case ']' + 256: verb = 0; c = '\"'; break; case '_': c = '$'; break; case '?': continue; } if( n <= nx + 2 ) { RHS *rhs = *nextrhs = malloc(sizeof(RHS)); nextrhs = &rhs->next; *nextrhs = NULL; *d = 0; d = rhs->expr; n = sizeof(rhs->expr) - 1; ++cur->nrhs; } if( nx ) { memcpy(d, x, nx); d += nx; n -= nx; nx = 0; } *d++ = last = c; --n; } goto nextline; } int main(int argc, char **argv) { return MLMain(argc, argv); }