/* This is file infixw.mac. The following line
 will have to be changed, or the file_search_lisp list ammended
 for the named files on windows, mac, unix, etc.
WARNING -- some of the infix syntax includes characters that interact with
wxmaxima front ends, and so the commands may not work if you type them in there.
Commands that use ; or $, in particular, in sympathy with Mathematica, will not
always work.  Using Maxima in a text window  (e.g. run maxima.bat in a terminal
  or emacs windows) works better. */
file_search_maxima: append (file_search_maxima,
              ["c:/lisp/mmasim2015/###.mac"])$
file_search_lisp: append (file_search_lisp,
              ["c:/lisp/mmasim2015/###.lisp"])$

load("e19a.lisp");
kill("->",":>","?$", "|", ":$", "?$","/.", "//.","/.","&&","||",
RuleToFnG,RuleToFnGC)$
/* set up syntax extension */

[infix("->", 49,49),
infix (":>", 49,49),
/*infix ("?$",150,150), */
infix ("?$",300,300),
infix ("/;", 49,49),
infix ("|",50,50),
nary  ("|"),
infix (":$",50,50), 
infix ("/.",48,48),
infix ("//.",48,48),
infix ("@",160,160),
infix ("//",60,60),
postfix (".$",150),
nary ("&&",65,65),
nary ("||", 60,60)
]$

/* set up definitions*/

[ "|"([b%]):=apply(Alternatives,pt(b%)),
/*  "/;"(a%,b%):=Condition(a%,b%), need to avoid evaluation of %b. See lisp?? */
 "/."(a%,b%):=ReplaceAll(a%,b%),
 ":$"(a%,b%):=Pattern(a%, b%),
 ".$"(a%) :=Optional(a%),
"//"(a%,b%):=apply(b%,[a%]),
 define(funmake(nounify("@"),[a%,b%]),apply(a%,[b%])),
"//."(a%,b%):=ReplaceRepeated(a%,b%),
"?$"(a%,b%):=PatternTest(a%,b%),
 "->"(a%,b%):=Rule(pt(a%),b%)/* or define in lisp? */
 /* ":>"(a%,b%)::=Rule(pt(ev(a%)),b%) defined in lisp as mfexpr*/
/* mand:inpart('a and 'b,0), mor:inpart('a or 'b,0),
"&&"(a%)::=apply(''mand,a%),
"||"(a%)::=apply(''mor,a%) */
]$

/*We use the lisp program pt() to  converts atoms with _ in them into lists..

now much of mma syntax can be just typed in to maxima.
Since all the built-in Maxima names are lower-case, it does
not interfere with these to add functions, commands beginning
with upper-case, so long as the syntax is in functional form.
Fore example one could consider adding If(...) in terms of Maxima
 if-then-else,  Do, For, etc., except one must be careful
in terms of evaluation (for example, Mma "If" has Attribute HoldRest).
It gets tiresome. If you really want Mathematica, 
try Mathics or MockMMA. Or Mathematica.  Anyway 

pt(a_foo?$bar);    you have generated internally the same thing as if
you had typed in
PatternTest(Pattern(a,Blank(foo)),bar) */

mp1(p,e):= m1(ProcOptional(pt(p)),e)$
mp1all(p,e):=m1all(ProcOptional(pt(p)),e)$  /* show all the ways p matches e */

/* We use RuleToFn, which we had to define in lisp 
   so that the defined, named, function
   returns multiple-values, as used by defrule and apply1 ( etc.) */

oprule(rr):= (  rr:movecond(flatexpand(rr)),/*  rr:movecond(rr), */
   if not(atom(rr) and inpart(rr,0)=Rule)
           then apply(Rule,oppat(rr)) else merror("notarule ~m", rr))$

oppat(rr):=[ProcOptional(first(rr)), second(rr)]$ 

 ReplaceAll(exp,onerule):=   /* implements  /.  */
  (onerule: pt(onerule),
 if listp(onerule) then 
           apply (matapply1, cons (exp, map(RuleToFnG,onerule)))
      else apply (matapply1, [exp, RuleToFnG(onerule)] ))$

ReplaceRepeated(exp, therules):=
 block([saved:exp, new:ReplaceAll(exp,therules)],
  while not(?alike1(saved,new)) do 
     (saved:new, new:ReplaceAll(saved,therules)),
 saved)$

/* Replace1(exp,onerule):= /* just applies to the whole expression, not parts */
block([trial: m1(first(onerule), exp)], /*assume it's a Rule */
 if trial=false then trial else Substall(trial,second(onerule)))$ */


Replace1(exp,onerule):= /* just applies to the whole expression, not parts */
block([trial: apply( RuleToFnG(onerule),[exp])],
 if trial=false then exp else trial)$

Replace (exp,onerule) := /* maybe a list of rules*/
 if listp(onerule) then 
   (for r in onerule do exp:Replace1(exp,pt(r)),exp) else Replace1(exp,pt(onerule))
$



/* cache this so the conversion is done only one time for each rule */
RuleToFnG(R):=RuleToFnGC[R]$
kill(RuleToFnGC)$ /*clear cache*/
RuleToFnGC[R]:=block([gg:gensym("r")], ?ruletofn1(gg,oprule(R)),gg)$

/* try 
f(a)+g(b)/. a->z;
f(q)+g(4)/. [a_integer-> foo,f(b_symbol)->b];
g(3,4)+g(4,3) /. g(a_integer,b_integer)/;a>b -> BigFirst
;;preferred:
RuleToFn(r1,a_integer-> foo)$
RuleToFn(r2,f(b_symbol)->b)$
RuleToFn(r3, g(a_integer,b_integer)/;a>b -> BigFirst)$
apply1(f(q)+g(4),r1,r2);
apply1(g(3,4)+g(4,3),r3);
 */

/*  how to simulate the definition of a procedure which in mma has
pattern matching explicit in its argument list?
for example,

 f[a_Integer,b_?$EvenQ,0]:=  foo[a,b] 

The trick is to realize that this is NOT,  I repeat NOT
actually defining a procedure in Mathematica.  It is defining
a pattern match/ replacement -- that is, a simplification rule.
Mathematica saves some computation by separating the rules by
their "heads". Thus this rule is queued up with other rules for "f".
The order of the rules is established by some secret method. 

We can do this ourselves,and more-or-less automate it.
We order the rules the way we want. Presumably the more specific first,
and then more general. 
(example:  f[x_Integer]:= ... is more specific than f[x_]:=....)
If the rules do not overlap in applicability, (example f[x_?$EvenQ]:=...., f[x_?$OddQ]:=...)
the order does not affect the result.
 
In Maxima we could do this:

 MakeFn(rulef1,  f(a_integer,b_?$evenp) -> foo(a,b))$
 MakeFn(rulef2,  f(a_integer,b_?$oddp) -> bar(a,b))$

apply1(f(3,4)+f(4,3), rulef1, rulef2);   returns bar(4,3)+foo(3,4).;; uh, no it doesn;t? why

This method is DIFFERENT in Maxima.  It IS defining procedures, effectively.

If we wish to see the equivalent of the mma notation

   f[a_Integer,b_?$EvenQ]:=  foo[a,b] 
   f[a_Integer,b_?$OddQ ]:=  bar[a,b] 

we can use the built-in original Maxima matcher ..
   matchdeclare(a,integerp, b,evenp,c,oddp)
   tellsimp(f(a,b), foo(a,b))$
   tellsimp(f(a,c), bar(a,c))$

OR

We can simulate  mma with the new mma-style patterns and
hook it in to the simplifier this way ..

  r1:  f(a_integer,b_?$evenp) -> foo(a,b)
  r2:  f(a_integer,b_?$oddp ) -> bar(a,b)
  simpf(k):=  k/.[r1,r2])
  matchdeclare(at,true,bt,true)$
  tellsimpafter(f(at,bt), simpf(f(at,bt)))$

or the last 5 lines could be done directly:

  matchdeclare(at,true,bt,true)$
  tellsimpafter(f(at,bt), 
             f(at,bt)/.[ f(a_integer,b_?$evenp) -> foo(a,b),
                         f(a_integer,b_?$oddp) -> bar(a,b)])

Note that we have to queue up rules (as does tellsimp, tellsimpafter)
by our own ordering, and we also have to say explicitly which
Head (here, the function f)  we are simplifying.  It is possible to go through
all the rules in a list of rules and generally (though not always!)
determine the heads, and then simulate the tellsimpafter above, for
each of the separate sets of rules.

Then for each part of the simplifier, we would not consider
the rules that could not possibly match, saving time.  (see, however,
upvalues in Mma, f_[foo]^=g[f] ).

Important:  it is trivial to write rules that erroneously infinitely recursive.
maxapplydepth:10  instead of 10000  will cut that off sooner. maybe.
Enough chatting.
............

Missing from this implementation.
  bare(unnamed) blanks   __ .  This notation conflicts with Maxima syntax,
and convincing others to abandon the use of the name _  to refer to the
previous input, was opposed. You can use anon__  or give it a name: temp__  

Also seriously conflicting with Maxima syntax, is use by mma
of ":" in pattern, hence we use  :$ for this.

Items missing still: Default, OneIdentity, Except, Repeated, RepeatedNull.
Identifying a "head" as a complex number .. unclear.

 mp1 works so that it returns false if there is no match
[ ]  if there is a match but no parameters are bound
 or
 a maxima list  like  [Rule(x,val_of_x), Rule(y, val_of_y),...]

then zz: RuleToLambda(Rule (pattern, replacement)) assigns to zz
a maxima program zz(exp) that does this:
  let ans=mp1(pattern,exp).
  If ans=false then return exp.
  If ans= [ ] then return replacement.
  If ans = [ x=a, y=b, ...]
   then  return subst(ans,replacement).
This is not quite right if  one of the rhs is "Segment".

*/

/* setting defaults so that  in ...  a_$.+b we get
  Optional(Pattern(a,Blank()), 0)+ b ...
get("+",Default)  returns 0 since we have done
put("+", 0, Default)
Here is  how to see defaults. We didn't put it in as default-by-arg-location. Yet.
*/

put("+", 0, Default)$
put("*", 0, Default)$
put("^", 1, Default)$  /*because x^1=x but needs to do mexpt */
GetDefaultOp(op):= get(op,Default) $ /* for now */
/* for testing ... */
maxapplydepth:10$
testrun():=load("testmma.mac")$
reload():=load("infixa.mac")$
MmaInfixLoaded:true$