A Mathematica package to execute FORM programs embedded in Mathematica code. #mma

FORM.m

(*
 * FORM.m
 *
 * Executes a FORM program in Mathematica.
 *
 * https://gist.githubusercontent.com/tueda/e3a2cc73fbed2a8e2ae4/raw/FORM.m
 *
 * Example:
 *
 *   << FORM`
 *   FORM["\
 *     S x,y;
 *     L F = (x+y)^[%1];
 *     P;
 *     .end
 *   ", 2]
 *
 * Refs. - J.A.M. Vermaseren,
 *         New features of FORM,
 *         arXiv:math-ph/0010025.
 *       - J. Kuipers, T. Ueda, J.A.M. Vermaseren and J. Vollinga,
 *         FORM version 4.0,
 *         arXiv:1203.6543 [cs.SC].
 *
 * 2012/10/16  1.1.0  New version.
 * 2012/03/13  1.0.3  Converted for Mathematica ver. 8.
 * 2007/11/13  1.0.2  Fix: Off finalstats in $ExecFORMLines (for FORM 3.2).
 * 2007/08/22  1.0.1  Fix: cd $HOME on executing FORM program (for Vista).
 * 2006/10/13  1.0.0  Initial version.
 *)

$FORMPackageVersion = "1.1.0";
$FORMPackageDateVersion = "(2012/10/16)";

If[$PrintFORMPackageVersion =!= 0,
  If[$Notebooks === True,
    Print[Style["FORM", FontWeight -> "Bold"], " in ",
          Style["Mathematica", FontSlant -> "Italic"],
          " ver. ", $FORMPackageVersion <> " ", $FORMPackageDateVersion],
    Print["FORM in Mathematica ver. ", $FORMPackageVersion, " ",
          $FORMPackageDateVersion]
  ];
];

BeginPackage["FORM`"];

FORM::usage = "FORM[text] executes the given text as a FORM program.";

FORMOutput::usage = "FORMOutput[texts] represents an output of FORM programs.";

FORMBIN::usage = "FORMBIN is an option for FORM specifying the file name of \
a FORM binary file."

Print;
ToExpression;

Math2FORM::usage = "Math2FORM[expr] converts a Mathematica expression into \
that in FORM programs.";

FORM2Math::usage = "FORM2Math[text] converts a FORM expression into \
that in Mathematica.";

Begin["`Private`"];

Options[FORM] = {
  FORMBIN -> "form",
  Print -> True,
  ToExpression -> Automatic
};

FORM[text_String, args___?(!OptionQ[#]&), opts___?OptionQ] := Module[
  {source, bin, tmp, str, shell, cmd},

  source = StringReplace[text, {
    "[%1]" :> GetArg[args, 1],
    "[%2]" :> GetArg[args, 2],
    "[%3]" :> GetArg[args, 3],
    "[%4]" :> GetArg[args, 4],
    "[%5]" :> GetArg[args, 5],
    "[%6]" :> GetArg[args, 6],
    "[%7]" :> GetArg[args, 7],
    "[%8]" :> GetArg[args, 8],
    "[%9]" :> GetArg[args, 9]
  }];
  While[StringLength[source] > 0 && StringTake[source, 1] == "\n",
    source = StringDrop[source, 1]
  ];
  While[StringLength[source] > 0 && StringTake[source, -1] == "\n",
    source = StringDrop[source, -1]
  ];
  source = source <> "\n";

  bin = FORMBIN /. {opts} /. Options[FORM];
  tmp = If[$VersionNumber >= 7, $TemporaryDirectory, $HomeDirectory]
          <> $PathnameSeparator
          <> "Math2FORM_tmp" <> ToString[$ProcessID] <> ".frm";
  str = OpenWrite[tmp];
  WriteString[str, source];
  Close[str];
  result = FORMOutput[ReadList["! " <> bin <> " " <> tmp, String]];
  DeleteFile[tmp];

  If[Print /. {opts} /. Options[FORM], Print[result]];
  Switch[ToExpression /. {opts} /. Options[FORM],
    Automatic, result = ToExpression[result];
      If[Length[result] > 0, result, Null],
    True, ToExpression[result],
    _, result
  ]
];

GetArg[args___, i_Integer] := Module[{item},
  If[i > Length[{args}],
    Message[FORM::nargs];
    Abort[];
  ];
  item = {args}[[i]];
  If[Head[item] =!= String,
    item = Math2FORM[item];
  ];
  "(" <> item <> ")"
];

FORM::nargs = "the number of the arguments is not enough";

FORMOutput /: MakeBoxes[FORMOutput[texts_List],
    form:StandardForm|TraditionalForm] :=
  InterpretationBox[
    RowBox[{"\[SkeletonIndicator] FORM Output \[SkeletonIndicator]"}],
    FORMOutput[texts, opts], Editable -> False];

FORMOutput /: Format[FORMOutput[texts_List], OutputForm] :=
  "- FORM Output -";

FORMOutput /: Print[FORMOutput[texts_List]] := Module[{str},
  str = If[Length[texts] > 0,
           StringDrop[("\n" <> # &) /@ texts // StringJoin, 1],
           "< No Output >"];
  If[$Notebooks === True,
    CellPrint[Cell[str, "Output"]],
    Print[str]
  ];
];

FORMOutput /: ToExpression[FORMOutput[texts_List]] :=
    Module[{result, startindex, i, c},
  result = {};
  startindex = 0;
  Do[
    If[StringLength[texts[[i]]] >= 1,
      c = StringTake[texts[[i]], -1];
      If[startindex == 0,
        If[c == "=", startindex = i],
        If[c == ";",
          result = Append[result,
                          FORM2Math[StringDrop[texts[[startindex]], -1] <> "->"
                            <> StringJoin[Take[texts, {startindex + 1, i - 1}]]
                            <> StringDrop[texts[[i]], -1]]];
          startindex = 0
        ]
      ]
    ],
    {i, 1, Length[texts]}
  ];
  result
];

SetAttributes[Math2FORM, Listable];

Math2FORM[expr_] := Module[{str},
  str = expr /. {
    x_Complex -> Re[x] + Im[x] * "i_",
    (-1)^x_ -> "sign_"[x],
    Log[x_] -> "ln_"[x]
  } // InputForm // ToString;
  str ~ StringReplace ~ {
    "[" -> "(",
    "]" -> ")",
    "{" -> "List(",
    "}" -> ")",
    "\"" -> "",
    "$" -> "_",
    " " -> ""
  }
];

SetAttributes[FORM2Math, Listable];

FORM2Math[text_String] := Module[{ex},
  ex = text ~ StringReplace ~ { " " -> "" }
            ~ StringReplace ~ {
              "[" -> "Hold[",
              "_" -> "$"
            } // ToExpression[#, TraditionalForm] &;
  ex /. {
    Global`i$ -> I,
    Global`sign$[x_] -> (-1)^x,
    Global`log$[x_] -> Log[x]
  }
];

End[];
EndPackage[];
(* vim: set ft=mma et ts=8 sts=2 sw=2: *)