////////////////////////
// Written by Alberto González Palomo and Ayal Pinkus.
////////////////////////

/* The read-eval-print loop */
/* It can take one parameter, that is the evaluation count. If it is greater
   than zero, only that number of iterations will be performed before
   exiting. This is particularly useful when connecting to Yacas via pipes.
*/
RuleBase("OMREP",{});
Rule("OMREP",0,1,True)
[
  OMREP(0);// 0 means keep repeating, as usual.
];
RuleBase("OMREP",{count});
LocalSymbols(input,stringOut,result)
Rule("OMREP",1,1,True)
[
  Local(input,stringOut,result);
  While(Not(IsExitRequested()))
  [
    Set(errorObject, "");
    TrapError(Set(input, FromString(ConcatStrings(ReadCmdLineString("")," "))OMRead()),Set(errorObject,OMGetCoreError()));
    If(Not(errorObject = ""), errorObject);
    If (Not(IsExitRequested()) And errorObject="",
    [
      Set(stringOut,"");
      Set(result,False);
      TrapError(Set(stringOut,ToString()[Secure(Set(result,Eval(input)));]),Set(errorObject,OMGetCoreError()));
      If(Not(errorObject = ""), errorObject);
      If(Not(stringOut = ""), WriteString(stringOut));
      SetGlobalLazyVariable(%,result);
      If(PrettyPrinter'Get()="",
      [
        Apply("OMForm",{result});
      ],
      Apply(PrettyPrinter'Get(),{result}));
      If(count > 0 And (count:=count-1) = 0, Exit());
    ]);
  ];
];


LocalSymbols(omindent) [
  // Function definitions
  OMIndent() := [omindent := omindent + 2;];
  OMUndent() := [omindent := omindent - 2;];
  OMClearIndent() := [omindent := 0;];
  OMIndentSpace() := Space(omindent);

  // Initialization of indentation
  OMClearIndent();
]; // LocalSymbols(omindent)

///////////////////////////////////////////////////////////////////////
// Output

10 # OMForm(_expression)
     <--
     [
     OMClearIndent();
     OMEcho("<OMOBJ>");
     OMIndent();
     If(IsAtom(expression),
        If(expression = Atom("%"),
           Secure(expression := Eval(expression))
           )
        );
     OMFormExpression(expression);
     OMUndent();
     OMEcho("</OMOBJ>");
     ];

10 # OMFormExpression(i_IsString)  <-- [
  Local (p, s);
  s := "";
  For (p := 1, p <= Length(i), p++) [
    Local (c);
    c := i[p];
    c := If (c = "&", "&amp;", c);
    c := If (c = "<", "&lt;", c);
    c := If (c = ">", "&gt;", c);
    c := If (c = "\"", "&quot;", c);
    c := If (c = "'", "&apos;", c);
    s := s : c;
  ];
  OMEcho("<OMSTR>":s:"</OMSTR>");
];
11 # OMFormExpression(i_IsInteger) <-- OMEcho("<OMI>":String(i):"</OMI>");
12 # OMFormExpression(i_IsNumber)  <-- OMEcho("<OMF dec=\"":String(i):"\"/>");
13 # OMFormExpression(i_IsConstant)_(OMSymbol()[ String(i) ] != Empty)
     <-- OMEcho("<OMS cd=\"":OMSymbol()[ String(i) ][1]
                :"\" name=\"":OMSymbol()[ String(i) ][2]:"\"/>"
                );
14 # OMFormExpression(i_IsConstant)// Should we rather evaluate it?
     <-- OMEcho("<OMV name=\"":String(i):"\"/>");
15 # OMFormExpression(i_IsVariable)_(OMSymbol()[ String(i) ] != Empty)
     <-- OMEcho("<OMS cd=\"":OMSymbol()[ String(i) ][1]
                :"\" name=\"":OMSymbol()[ String(i) ][2]:"\"/>"
                );
16 # OMFormExpression(i_IsVariable)
     <-- OMEcho("<OMV name=\"":String(i):"\"/>");
16 # OMFormExpression(i_IsVariable)_(i = Empty)
     <-- False; // This is useful for void expressions.

10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMError")
     <--
     [
     Local(cd, name);
     If(IsList(function[1]),
        [ cd := function[1][1]; name := function[1][2]; ],
        [ cd := "error";        name := function[1];    ]);
     OMEcho("<OME>");
     OMIndent();
     OMEcho("<OMS cd=\"":cd:"\" name=\"":name:"\"/>");
     ForEach(i, Tail(function)) OMFormExpression(i);
     OMUndent();
     OMEcho("</OME>");
     ];
10 # OMFormExpression(function_IsFunction)_(Type(function) = "OME")
     <--
     [
     OMEcho("<OME>");
     OMIndent();
     ForEach(i, function) OMFormExpression(i);
     OMUndent();
     OMEcho("</OME>");
     ];
10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMS")
     <-- OMEcho("<OMS cd=\"":function[1]:"\" name=\"":function[2]:"\"/>");
10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMBIND")
     <--
     [
     OMEcho("<OMBIND>");
     OMIndent();
     ForEach(i, function) OMFormExpression(i);
     OMUndent();
     OMEcho("</OMBIND>");
     ];
10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMBVAR")
     <--
     [
     OMEcho("<OMBVAR>");
     OMIndent();
     ForEach(i, function) OMFormExpression(i);
     OMUndent();
     OMEcho("</OMBVAR>");
     ];
10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMA")
     <--
     [
     // This is not the same as the next rule: this is OMA(a,b,c,...),
     // which is used for building OMA constructs in the mapping to OM.
     OMEcho("<OMA>");
     OMIndent();
     ForEach(i, function) OMFormExpression(i);
     OMUndent();
     OMEcho("</OMA>");
     ];
11 # OMFormExpression(function_IsFunction)
     <--
     [
     OMEcho("<OMA>");
     OMIndent();
     OMFormFunction(function);
     OMUndent();
     OMEcho("</OMA>");
     ];

11 # OMFormFunction(function_IsFunction)
     <--
     [
     Local(arity);
     arity := Length(function);
     OMEcho("<OMS cd=\"yacas\" name=\"":Type(function):"\"/>");
     If(arity > 0, ForEach(arg, function) OMFormExpression(arg));
     ];
10 # OMFormFunction(function_IsFunction)_(OMSymbol()[ Type(function) ] != Empty)
     <--
     [
     Local(symbolDef);
     // [20051016 AGP] The "signature" feature is an old attempt at pattern
     // matching, but now that we have real predicates in the mappings it's
     // probably obsolete. I'll think about removing it.
     symbolDef := OMSymbol()[ OMSignature(function) ];
     If(symbolDef = Empty, symbolDef := OMSymbol()[ Type(function) ] );
     If(symbolDef = Empty Or Length(symbolDef) < 3 Or symbolDef[3] = {},
        [
        OMEcho("<OMS cd=\"":symbolDef[1]:"\" name=\"":symbolDef[2]:"\"/>");
        ForEach(arg, function) OMFormExpression(arg);
        ],
        [
        Local(result);
        result := OMApplyMapping(function, symbolDef[3]);
        //Check(IsList(result), ToString()Echo("Mapping result is not a list: ", result));
        If(IsList(result),
           [
           result := UnList(Subst($, function[0]) result);
           OMFormExpression(result[0]);
           ForEach(i, result) OMFormExpression(i);
           ],
           If(result = Empty,
              Echo("No rule matched ", function, symbolDef[3]),
              Echo("Unexpected result value from OMApplyMapping(): ", result)
             )
          );
        ]
       );
     ];


OMWrite(_expression) <--
[
  Write(expression);
];

OMEcho(_expression) <--
[
  OMIndentSpace();
  Write(expression);
  NewLine();
];
OMEcho(expression_IsString) <--
[
  OMIndentSpace();
  WriteString(expression);
  NewLine();
];
OMEcho(expression_IsList) <--
[
  ForEach(arg, expression)
  [
    If (IsString(arg), WriteString(arg), Write(arg));
  ];
  NewLine();
];

OMEscape(_expression) <--
[
  "<![CDATA[":String(expression):"]]>";
];
OMEscapeString(_expression_IsString) <--
[
  "<![CDATA[":expression:"]]>";
];
OMWriteEscape(_expression) <--
[
  WriteString(OMEscape(expression));
];
OMWriteStringEscape(expression_IsString) <--
[
  WriteString(OMEscapeString(expression));
];
OMEchoEscape(_expression) <--
[
  OMWriteEscape(expression);
  NewLine();
];
OMEchoEscape(expression_IsString) <--
[
  OMWriteStringEscape(expression);
  NewLine();
];
OMEchoEscape(expression_IsList) <--
[
  WriteString("<![CDATA[");
  ForEach(arg, expression)
  [
    If (IsString(arg), WriteString(arg), Write(arg));
  ];
  WriteString("]]>");
  NewLine();
];


HoldArgNr("OMForm",1,1);
//HoldArgNr("OMFormExpression",1,1);
//HoldArgNr("OMFormFunction",1,1);


OMSignature(_function) <-- "";
OMSignature(function_IsFunction) <--
[
  Local(makeSig);
  makeSig := {ConcatStrings, Type(function), "_"};
  Local(type);
  type := "";// If "function" doesn't have parameters, the signature is "f_".
  ForEach(arg, function)
  [
    If(Type(arg) = "List",
       type := "L",
       If(IsFunction(arg),
          type := "F",
          If(IsInteger(arg),
             type := "I",
             type := "V"
             )
          )
       );
    DestructiveAppend(makeSig, type);
  ];
  Secure(Eval(UnList(makeSig)));
];
HoldArgNr("OMSignature", 1, 1);



///////////////////////////////////////////////////////////////////////
// Input

// Troubleshooting guide:
// "encodingError:unexpected closing brace": this happens in the ReadOMOBJ
//      rules. It means that you forgot to call OMNextToken() from your rule.

LocalSymbols(omtoken) [
  OMNextToken() :=
  [
    omtoken := XmlExplodeTag(String(ReadToken()));
  ];
  OMToken() := omtoken;
]; // LocalSymbols(omtoken)

OMRead():=
[
  Local(result);
  TrapError(
  [
    XmlTokenizer();
    OMNextToken();
    result := MatchOMOBJ(OMToken());
    DefaultTokenizer();
  ],
  [
    result := OMGetCoreError();
    DefaultTokenizer();
  ]);
  result;
];


OMDump(str):=
FromString(str:" EndOfFile")
[
  Local(result);
  XmlTokenizer();
  OMNextToken();
  While(OMToken() != "EndOfFile")
  [
    Echo("Exploded ",OMToken());
    OMNextToken();
  ];
  DefaultTokenizer();
  True;
];



10 # MatchClose(_x)_(x = OMToken()) <-- [OMNextToken();True;];
20 # MatchClose(_x) <-- Check(False,ToString()Echo("encodingError:unexpected closing brace")); //@@@ TODO better error reporting

10 # MatchOMOBJ(XmlTag("OMOBJ",_attributes,"Open")) <--
[
  // Any attributes are ignored.
  Local(result);
  OMNextToken();
  result := ReadOMOBJ(OMToken());
  MatchClose(XmlTag("OMOBJ",{},"Close"));
  result;
];
10 # MatchOMOBJ(XmlTag("OMOBJ",_attributes,"OpenClose")) <--
[
  OMNextToken();
  // Any attributes are ignored.
  // This is a void expression, of the form "<OMOBJ/>".
  Empty;
];
20 # MatchOMOBJ(_rest) <-- Check(False,ToString()Echo("encodingError:not an OMOBJ :",rest));

10 # ReadOMOBJ(XmlTag("OMOBJ",_attributes,"Close")) <--
[
  // This is a void expression, of the form "<OMOBJ></OMOBJ>".
  Empty;
];

10 # ReadOMOBJ(XmlTag("OMI",{},"Open")) <--
[
  Local(result);
  OMNextToken();
  result := Atom(OMToken());
  OMNextToken();
  MatchClose(XmlTag("OMI",{},"Close"));
  result;
];

10 # ReadOMOBJ(XmlTag("OMV",{{"NAME",_name}},"OpenClose")) <--
[
  OMNextToken();
  Atom(name);
];

10 # ReadOMOBJ(XmlTag("OMF",{{"DEC",_dec}},"OpenClose")) <--
[
  OMNextToken();
  If (dec = "INF", Infinity,
    If (dec = "-INF", -Infinity,
      If (dec = "NaN", Undefined,
        Atom(dec) + 0.0
      )
    )
  );
];

10 # ReadOMOBJ(XmlTag("OMSTR",{},"Open")) <--
[
  Local(result,s,i);
  OMNextToken();
  If(IsString(OMToken()), [result := OMToken(); OMNextToken();], result := "");
  MatchClose(XmlTag("OMSTR",{},"Close"));
  s := "";
  For (i := 1, i <= Length(result), i++) [
    Local(c);
    c := result[i];
    If (c != "&", s := s : c, [
      Local(j,ec);
      j := i;
      While (j <= Length(result) And result[j] != ";")
        j := j + 1;

      ec := result[i .. j];
      If (ec = "&amp;", s := s : "&");
      If (ec = "&lt;", s := s : "<");
      If (ec = "&gt;", s := s : ">");
      If (ec = "&quot;", s := s : "\"");
      If (ec = "&apos;", s := s : "'");

      i := j;
    ]);
  ];
  s;
];
10 # ReadOMOBJ(XmlTag("OMSTR",{},"OpenClose")) <--
[
  OMNextToken();
  "";
];

10 # ReadOMOBJ(XmlTag("OMA",{},"Open")) <--
[
  Local(result, new);
  result:={};
  OMNextToken();
  While (OMToken() != XmlTag("OMA",{},"Close"))
  [
    new:=ReadOMOBJ(OMToken());
    DestructiveAppend(result,new);
  ];
  MatchClose(XmlTag("OMA",{},"Close"));
  OMApplyReverseMapping(UnList(result));
];

10 # ReadOMOBJ(XmlTag("OMBIND",{},"Open")) <--
[
  Local(result, new);
  result:={};
  OMNextToken();
  While (OMToken() != XmlTag("OMBIND",{},"Close"))
  [
    new:=ReadOMOBJ(OMToken());
    DestructiveAppend(result,new);
  ];
  MatchClose(XmlTag("OMBIND",{},"Close"));
  result;
];
10 # ReadOMOBJ(XmlTag("OMBVAR",{},"Open")) <--
[
  Local(result, new);
  result:={};
  OMNextToken();
  While (OMToken() != XmlTag("OMBVAR",{},"Close"))
  [
    new:=ReadOMOBJ(OMToken());
    DestructiveAppend(result,new);
  ];
  MatchClose(XmlTag("OMBVAR",{},"Close"));
  result;
];

10 # OMApplyReverseMapping(yacasExp_IsFunction) <-- yacasExp;
10 # OMApplyReverseMapping(yacasExp_IsFunction)_(OMSymbol()[ Type(yacasExp) ] != Empty)
     <--
     [
     Local(symbolDef, result);
     symbolDef := OMSymbol()[ Type(yacasExp) ];
     If(symbolDef[4] = {},
        result := yacasExp,
        [
          result := OMApplyMapping(yacasExp, symbolDef[4]);
          result := Subst($, yacasExp[0]) result;
          If(IsList(result), result := UnList(result));
        ]
       );
     result;
     ];

10 # OMApplyMapping(_function, _mapping) <--
[
  Local(expandRules, result);
  expandRules := { _(_path) <- OMPathSelect(path, function) };
  expandRules[1][2][2] := function;// the "function" variable is not expanded above.

  mapping := (mapping /: expandRules);// "/:" has lower precedence than ":=".

  Local(ruleMatched);
  ruleMatched := False;
  If(Type(mapping) = "|",
     [
     mapping := Flatten(mapping, "|");
     ForEach(rule, mapping)
       If(Not ruleMatched,
          [
          If(Type(rule) = "_",
             If( Eval(rule[2]), [ result := rule[1]; ruleMatched := True; ] ),
             [ result := rule; ruleMatched := True; ]
            );
          ]
         );
     ],
     [
     If(Type(mapping) = "_",
        If(Eval(mapping[2]),
           result := mapping[1],
           result := Listify(function)
          ),
	result := mapping
       );
     ruleMatched := True;
     ]
    );

  If(ruleMatched,
     If(Type(result) = ":",
        If(Length(result) = 2,
           result[1]:result[2],
           result),// Perhaps we should give a warning here.
        result),
     Empty);
];

11 # OMPathSelect(path_IsNumber, _expression) <--
[
  If(path >= 0 And path <= Length(expression),
     expression[path],
     Undefined);
];
11 # OMPathSelect(path_IsList, _expression) <--
[
  ForEach(i, path)
    If(IsFunction(expression) And i >= 0 And i <= Length(expression),
       expression := expression[i],
       Undefined);
  expression;
];
HoldArgNr("OMPathSelect", 2, 2);

// Previously, any unknown symbols where reported as errors.
// Now, we just store them as OMS(cd, name) since Yacas is perfectly happy
// with such unknown symbols, and will handle them right: When
// producing an OpenMath result from them, they will be output back
// unmodified, forming a valid OpenMath expression.
// This way we don't have to bother defining bogus symbols for concepts that
// Yacas does not handle.
100 # ReadOMOBJ(XmlTag("OMS", _attributes, "OpenClose")) <--
[
  OMNextToken();
  Local(omcd, omname);
  omcd   := attributes["CD"];
  omname := attributes["NAME"];
  If(omcd = Empty Or omname = Empty,
     OMCheck(False,OMError({"moreerrors", "encodingError"}, ToString()Echo("missing \"cd\" or \"name\" attribute: ",attributes))),
     [
     Local(cdTable, yacasform);
     cdTable := OMSymbolReverse()[ omcd ];
     If(cdTable != Empty, yacasform := cdTable[ omname ]);
     // We can not optimize here by checking first whether the CD is "yacas"
     // and avoiding the table lookup then, because for some symbols the
     // OM name have to be different from the Yacas name (e.g. "/@").
     If(yacasform = Empty,
        If(cd = "yacas", Atom(omname), OMS(omcd, omname)),
        If(IsString(yacasform), Atom(yacasform), yacasform));
     ]
    );
];

101 # ReadOMOBJ(_rest) <-- OMCheck(False,OMError({"moreerrors", "encodingError"}, ToString()Echo("unhandled tag: ",rest)));



///////////////////////////////////////////////////////////////////////
// Error reporting

Macro(OMCheck,{predicate,error})
[
  If(Not(@predicate),
  [
    Assert("omErrorObject", @error) False;
    Check(False,"omErrorObject");
  ]
  ,
  True);
];
OMGetCoreError():=
[
  Local(result);
  result := GetCoreError();
  If(result != "",
     If( IsError("omErrorObject"),
        [result := GetError("omErrorObject");                     ],
        [result := OMError({"moreerrors", "unexpected"}, result); ])
    );
  result;
];



///////////////////////////////////////////////////////////////////////
// Symbol mapping tables

LocalSymbols(omsymbol, omsymbolreverse) [
  // Initialization of the openmath symbol dictionaries
  omsymbol := {};
  omsymbolreverse := {};

  // Access to the dictionaries
  OMSymbol() := omsymbol;
  OMSymbolReverse() := omsymbolreverse;

]; // LocalSymbols(omsymbol, omsymbolreverse)

OMDef(_yacasform, omcd_IsString, omname_IsString, _directMapping, _reverseMapping) <--
[
  Local(cdTable);
  If(IsString(yacasform),
     OMSymbol()[ yacasform ] := {omcd, omname, directMapping, reverseMapping}
     );
  cdTable := OMSymbolReverse()[ omcd ];
  If(cdTable = Empty,
     OMSymbolReverse()[ omcd ] := {{omname, yacasform}},
     [
       Local(oldYacasform);
       oldYacasform := cdTable[ omname ];
       If(oldYacasform = Empty,
          cdTable[ omname ] := yacasform,
          [
          If(oldYacasform != yacasform,
             [
             cdTable[ omname ] := yacasform;
             Echo("Warning: the mapping for ", omcd, ":", omname,
                  " was already defined as ", oldYacasform,
                  ", but is redefined now as ", yacasform
                  );
             ]
            );
          ]
         );
      ]
     );
  True;
];

OMDef(_yacasform, omcd_IsString, omname_IsString)
<-- OMDef(yacasform, omcd, omname, {}, {});

OMDef(yacasalias_IsString, yacasname_IsString) <--
[
  OMSymbol()[ yacasalias ] := OMSymbol()[ yacasname ];
];
HoldArgNr("OMDef", 5, 4);
HoldArgNr("OMDef", 5, 5);

// Many objects, such as matrices and sets, do not have a specific
// encoding in Yacas, but are represented as lists.
OMDef( {},     "set1","emptyset" );
OMDef( "List", "set1","set"      );
OMDef( "List", "linalg2","matrix"    );
OMDef( "List", "linalg2","matrixrow" );
OMDef( "List", "linalg2","vector"    );
OMDef( "List", "list1","list" );

// [20010916 AGP] I couldn't find these symbols in the def files:
//     "E"        ,  "nums1", "e"
//     "Gamma"    ,  "nums1", "gamma"
OMDef( "Infinity" ,  "nums1", "infinity" );
OMDef( "Undefined",  "nums1", "NaN"      );
// [20010916 AGP] From stdopers.ys:
OMDef( "And"   ,  "logic1", "and"        );
OMDef( "=="    ,  "logic1", "equivalent" );
OMDef( "!=="   ,  "logic1", "not",
                { "<OMA><OMS cd=\"logic1\" name=\"equivalent\"/>",
                  1,
                  2,
                  "</OMA>"
                }
      );
OMDef( "False",  "logic1", "false" );
OMDef( "Or"   ,  "logic1", "or"    );
OMDef( "True" ,  "logic1", "true"  );
//[20010916 AGP ] Xor is not available in Yacas.
//     "Xor"  ,  "logic1", "xor"   );
OMDef( "&" ,  "yacas", "bitwise_and" );
OMDef( "|" ,  "yacas", "bitwise_or"  );
OMDef( "%" ,  "yacas", "bitwise_xor" );
OMDef( "/" , "arith1", "divide");// This definition is for OM arith1:divide to Yacas. In all other cases, the next one will be used.
OMDef( "/" , "nums1", "rational", {$, _1, _2}_(IsRational(_1/_2)) | {OMS("arith1", "divide"), _1, _2}, {/, _1, _2});
OMDef( "-" ,  "arith1", "unary_minus");
OMDef( "-" ,  "arith1", "minus"  );// We need a way of testing the arity.
OMDef( "+" ,  "arith1", "plus"   );
OMDef( "^" ,  "arith1", "power"  );
OMDef( "*" ,  "arith1", "times"  );


Use("constants.rep/om.ys");
Use("stdfuncs.rep/om.ys");
Use("stubs.rep/om.ys");
Use("logic.rep/om.ys");
Use("complex.rep/om.ys");
Use("integrate.rep/om.ys");
Use("sums.rep/om.ys");
Use("limit.rep/om.ys");
//Use("numbers.rep/om.ys");// Sqrt is loaded before (stubs.rep) than IntNthRoot.
Use("functional.rep/om.ys");
Use("solve.rep/om.ys");