-- this file contains top level routines that call the C++ code in the engine

use engine;
use common;
use hashtables;
use struct;

-- monomial orderings

header "#include <interface/monomial-ordering.h>";

PositionS := makeProtectedSymbolClosure("Position");
UpS := makeProtectedSymbolClosure("Up");
DownS := makeProtectedSymbolClosure("Down");
PositionMO(b:bool):RawMonomialOrdering := (		    -- b is true for Up, false for Down
    Ccode(RawMonomialOrdering, "rawPositionMonomialOrdering(",b,")"));

LexS      := makeProtectedSymbolClosure("Lex");
LexSmallS := makeProtectedSymbolClosure("LexSmall");
LexTinyS  := makeProtectedSymbolClosure("LexTiny");
LexMO     (n:int):RawMonomialOrdering := Ccode(RawMonomialOrdering, "rawLexMonomialOrdering(",n,",1)");
LexSmallMO(n:int):RawMonomialOrdering := Ccode(RawMonomialOrdering, "rawLexMonomialOrdering(",n,",2)");
LexTinyMO (n:int):RawMonomialOrdering := Ccode(RawMonomialOrdering, "rawLexMonomialOrdering(",n,",4)");

RevLexS := makeProtectedSymbolClosure("RevLex");
RevLexMO(n:int):RawMonomialOrdering := Ccode(RawMonomialOrdering, "rawRevLexMonomialOrdering(",n,")");

GroupLexS := makeProtectedSymbolClosure("GroupLex");
GroupLexMO(n:int):RawMonomialOrdering := Ccode(RawMonomialOrdering, "rawGroupLexMonomialOrdering(",n,")");

GroupRevLexS := makeProtectedSymbolClosure("GroupRevLex");
GroupRevLexMO(n:int):RawMonomialOrdering := Ccode(RawMonomialOrdering, "rawGroupRevLexMonomialOrdering(",n,")");

NCLexS := makeProtectedSymbolClosure("NCLex");
NCLexMO(n:int):RawMonomialOrdering := Ccode(RawMonomialOrdering, "rawNClexMonomialOrdering(",n,")");

GRevLexS      := makeProtectedSymbolClosure("GRevLex");
GRevLexSmallS := makeProtectedSymbolClosure("GRevLexSmall");
GRevLexTinyS  := makeProtectedSymbolClosure("GRevLexTiny");
GRevLexMO     (n:array(int)):RawMonomialOrderingOrNull := Ccode(RawMonomialOrderingOrNull, "rawGRevLexMonomialOrdering(",n,",1)");
GRevLexSmallMO(n:array(int)):RawMonomialOrderingOrNull := Ccode(RawMonomialOrderingOrNull, "rawGRevLexMonomialOrdering(",n,",2)");
GRevLexTinyMO (n:array(int)):RawMonomialOrderingOrNull := Ccode(RawMonomialOrderingOrNull, "rawGRevLexMonomialOrdering(",n,",4)");

WeightsS := makeProtectedSymbolClosure("Weights");
WeightsMO(n:array(int)):RawMonomialOrdering := Ccode(RawMonomialOrdering, "rawWeightsMonomialOrdering(",n,")");

-- TODO: export this
joinMO(s:RawMonomialOrderingArray):RawMonomialOrdering := ( Ccode(RawMonomialOrdering, "rawJoinMonomialOrdering(",s,")") );

funtype := fun1 or fun2 or fun3 or fun4 or fun5;
funtypeornull := fun1 or fun2 or fun3 or fun4 or fun5 or null;
fun1 := {+f:function():RawMonomialOrdering};
fun2 := {+f:function(int):RawMonomialOrdering};
fun3 := {+f:function(arrayint):RawMonomialOrdering};
fun4 := {+f:function(bool):RawMonomialOrdering};
fun5 := {+f:function(arrayint):RawMonomialOrderingOrNull};
-- toFun(f:function():RawMonomialOrdering):fun1 := fun1(f);
toFun(f:function(int):RawMonomialOrdering):fun2 := fun2(f);
toFun(f:function(arrayint):RawMonomialOrdering):fun3 := fun3(f);
toFun(f:function(bool):RawMonomialOrdering):fun4 := fun4(f);
toFun(f:function(arrayint):RawMonomialOrderingOrNull):fun5 := fun5(f);

Maker := { sym:SymbolClosure, fun:funtype };

makers := array(Maker)(
    Maker(PositionS,toFun(PositionMO)),
    Maker(LexS,toFun(LexMO)),
    Maker(LexSmallS,toFun(LexSmallMO)),
    Maker(LexTinyS,toFun(LexTinyMO)),
    Maker(RevLexS,toFun(RevLexMO)),
    Maker(GroupLexS,toFun(GroupLexMO)),
    Maker(GroupRevLexS,toFun(GroupRevLexMO)),
    Maker(NCLexS,toFun(NCLexMO)),
    Maker(GRevLexS,toFun(GRevLexMO)),
    Maker(GRevLexSmallS,toFun(GRevLexSmallMO)),
    Maker(GRevLexTinyS,toFun(GRevLexTinyMO)),
    Maker(WeightsS,toFun(WeightsMO))
    );

getmaker(sym:SymbolClosure):funtypeornull := (
    foreach pair in makers do if sym == pair.sym then (
	when pair.fun
	is f:fun1 do return f
	is f:fun2 do return f
	is f:fun3 do return f
	is f:fun4 do return f
	is f:fun5 do return f
	);
    null());

export rawMonomialOrdering(e:Expr):Expr := (
    -- This routine gets an expression like this:
    -- { GRevLexSmallS => {1,2,3}, PositionS, LexTinyS => 4, LexS => 5, WeightsS => {1,2,3} }
    -- For GRevLexS, the weights are already provided by top level code.
    -- Each member of the sequence results in one monomial ordering, and the sequence
    -- is then "joined".
    -- The weights for grevlex have to be > 0.
    -- Limit the total number of variables to 2^15-1.
    when e is s:List do (
	-- first check it
	foreach spec in s.v do (
	    when spec is sp:List do
	    if sp.Class == optionClass && length(sp.v)==2 then
	    when sp.v.0
	    is sym:SymbolClosure do (
		when getmaker(sym)
		is g:fun1 do (
		    if sp.v.1 != nullE
		    then return buildErrorPacket("expected option value to be 'null'");
		    )
		is g:fun2 do (
		    if !isSmallInt(sp.v.1)
		    then return buildErrorPacket("expected option value to be a small integer");
		    )
		is g:fun3 do (
		    if !isSequenceOfSmallIntegers(sp.v.1)
		    then return buildErrorPacket("expected option value to be a sequence of small integers");
		    )
		is g:fun5 do (
		    if !isSequenceOfSmallIntegers(sp.v.1)
		    then return buildErrorPacket("expected option value to be a sequence of small integers");
		    )
		is g:fun4 do (
		    if g.f == PositionMO then (
			if !(sp.v.1 == UpS || sp.v.1 == DownS)
			then return buildErrorPacket("expected option value to be Up or Down");
			)
		    else (
			if !(sp.v.1 == True || sp.v.1 == False)
			then return buildErrorPacket("expected option value to be true or false");
			))
		is null do return buildErrorPacket("expected option key '"+sym.symbol.word.name+"' to be a monomial ordering key")
		)
	    else return buildErrorPacket("expected option key to be a symbol")
	    else return WrongArg("a list of options")
	    else return WrongArg("a list of options"));
	-- then accumulate it
	errorReturn := nullE;
	ret := toExpr(joinMO(new RawMonomialOrderingArray len length(s.v) do (
		    foreach spec in s.v do
		    when spec is sp:List do
		    when sp.v.0 is sym:SymbolClosure do (
			when getmaker(sym)
			is g:fun1 do provide g.f()
			is g:fun2 do provide g.f(getSmallInt(sp.v.1))
			is g:fun3 do provide g.f(getSequenceOfSmallIntegers(sp.v.1))
			is g:fun4 do provide g.f(if g.f == PositionMO then sp.v.1 == UpS else sp.v.1 == True)
			is g:fun5 do (
			    when g.f(getSequenceOfSmallIntegers(sp.v.1))
			    is m:RawMonomialOrdering do provide m
			    is null do (
				errorReturn = engineErrorMessage();
				)
			    )
			is null do nothing
			)
		    else nothing
		    else nothing;
		    provide PositionMO(true);		    -- just in case, to prevent a loop
		    )));
	if errorReturn == nullE then ret else errorReturn)
    else WrongArg("a list of options"));
setupfun("rawMonomialOrdering", rawMonomialOrdering);

export rawProductMonomialOrdering(e:Expr):Expr := (
    when e
    is RawMonomialOrderingCell do e
    is s:Sequence do if isSequenceOfMonomialOrderings(s)
    then toExpr(Ccode( RawMonomialOrdering, "rawProductMonomialOrdering(", getSequenceOfMonomialOrderings(s), ")" ))
    else WrongArg("a sequence of raw monomial orderings")
    else WrongArg("a sequence of raw monomial orderings"));
setupfun("rawProductMonomialOrdering", rawProductMonomialOrdering);

export rawNumberOfVariables(e:Expr):Expr := (
    when e is m:RawMonomialOrderingCell
    do toExpr(Ccode( int, "rawNumberOfVariables(", m.p, ")" ))
    else WrongArg("a monomial ordering"));
setupfun("rawNumberOfVariables", rawNumberOfVariables);

export rawNumberOfInvertibleVariables(e:Expr):Expr := (
    when e is m:RawMonomialOrderingCell
    do toExpr(Ccode( int, "rawNumberOfInvertibleVariables(", m.p, ")" ))
    else WrongArg("a monomial ordering"));
setupfun("rawNumberOfInvertibleVariables", rawNumberOfInvertibleVariables);

export rawMonomialOrderingToMatrix(e:Expr):Expr := (
    when e is m:RawMonomialOrderingCell
    do toExpr(Ccode( RawArrayIntOrNull, "rawMonomialOrderingToMatrix(", m.p, ")" ))
    else WrongArg("a monomial ordering"));
setupfun("rawMonomialOrderingToMatrix", rawMonomialOrderingToMatrix);
