#############################################################################
##
#W  gap.g               OpenMath Package         Andrew Solomon
##
#H  @(#)$Id: gap.g,v 1.20 2006/01/27 14:55:55 gap Exp $
##
#Y  Copyright (C)  1997,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
#Y  (C) 1998 School Math and Comp. Sci., University of St.  Andrews, Scotland
##
##  This file contains the semantic mappings from parsed openmath
##  expressions to GAP objects.
##

Revision.("openmath/gap/gap.g") :=
    "@(#)$Id: gap.g,v 1.20 2006/01/27 14:55:55 gap Exp $";



######################################################################
##
#F  OMgapId(<obj>)
##
##  Forces GAP to evaluate its argument.
##
BindGlobal("OMgapId",  x->x);




######################################################################
##
#F  OMgapApply(<obj>)
##
##  OMgapApply(f, rest) evaluates to f(rest).
##
BindGlobal("OMgapApply", 
function(head, rest)
	return OMgapId(head)(rest);
end);


######################################################################
##
#F  OMgap1ARGS(<obj>)
#F  OMgap2ARGS(<obj>)
##
##  OMgapnARGS Throws an error if the argument is not of length n.
##
BindGlobal("OMgap1ARGS",
function(x)
  if Length(x) <> 1 then
    Error("argument list of length 1 expected");
  fi;
	return true;
end);

BindGlobal("OMgap2ARGS", 
function(x)
  if Length(x) <> 2 then
    Error("argument list of length 2 expected");
  fi;
	return true;
end);



######################################################################
##
##  Semantic mappings for symbols from arith1.cd
## 
BindGlobal("OMgapPlus", Sum);
BindGlobal("OMgapTimes", Product);
BindGlobal("OMgapDivide", x-> OMgapId([OMgap2ARGS(x), x[1]/x[2]])[2]);
BindGlobal("OMgapPower", x-> OMgapId([OMgap2ARGS(x), x[1]^x[2]])[2]);

######################################################################
##
##  Semantic mappings for symbols from algnums.cd
## 
BindGlobal("OMgapNthRootOfUnity", 
	x-> OMgapId([OMgap2ARGS(x), E(x[1])^x[2]])[2]);
######################################################################
##
##  Semantic mappings for symbols from relation.cd
## 
BindGlobal("OMgapEq", x-> OMgapId([OMgap2ARGS(x), x[1]=x[2]])[2]);
BindGlobal("OMgapNeq", x-> not OMgapEq(x));
BindGlobal("OMgapLt", x-> OMgapId([OMgap2ARGS(x), x[1]<x[2]])[2]);
BindGlobal("OMgapLe",x-> OMgapId([OMgap2ARGS(x), x[1]<=x[2]])[2]);
BindGlobal("OMgapGt", x-> OMgapId([OMgap2ARGS(x), x[1]>x[2]])[2]);
BindGlobal("OMgapGe", x-> OMgapId([OMgap2ARGS(x), x[1]>=x[2]])[2]);

######################################################################
##
##  Semantic mappings for symbols from integer.cd
## 
BindGlobal("OMgapQuotient", 
	x-> OMgapId([OMgap2ARGS(x), EuclideanQuotient(x[1],x[2])])[2]);
BindGlobal("OMgapRem", 
	x-> OMgapId([OMgap2ARGS(x), EuclideanRemainder(x[1],x[2])])[2]);
BindGlobal("OMgapGcd", Gcd);

######################################################################
##
##  Semantic mappings for symbols from logic1.cd
## 
BindGlobal("OMgapNot", x-> OMgapId([OMgap1ARGS(x), not x[1]])[2]);
BindGlobal("OMgapOr", x-> OMgapId([OMgap2ARGS(x), x[1] or x[2]])[2]);
BindGlobal("OMgapXor", 
	x-> OMgapId([OMgap2ARGS(x), (x[1] or x[2]) and not (x[1] and x[2])])[2]);
BindGlobal("OMgapAnd", x-> OMgapId([OMgap2ARGS(x), x[1] and x[2]])[2]);

######################################################################
##
##  Semantic mappings for symbols from list1.cd
## 
BindGlobal("OMgapList", List);

######################################################################
##
##  Semantic mappings for symbols from set1.cd
## 
BindGlobal("OMgapSet", Set);
BindGlobal("OMgapIn", x-> OMgapId([OMgap2ARGS(x), x[1] in x[2]])[2]);
BindGlobal("OMgapUnion", x-> OMgapId([OMgap2ARGS(x), Union(x[1],x[2])])[2]);
BindGlobal("OMgapIntersect", 
	x-> OMgapId([OMgap2ARGS(x), Intersection(x[1], x[2])])[2]);
BindGlobal("OMgapSetDiff", 
	x-> OMgapId([OMgap2ARGS(x), Difference(x[1], x[2])])[2]);

######################################################################
##
##  Semantic mappings for symbols from linalg1.cd
## 
BindGlobal("OMgapMatrixRow", OMgapId);
BindGlobal("OMgapMatrix", OMgapId);

######################################################################
##
##  Semantic mappings for symbols from permut1.cd
## 
BindGlobal("OMgapPermutation", PermList);

######################################################################
##
##  Semantic mappings for symbols from group1.cd
## 
BindGlobal("OMgapCharacterTableOfGroup",
	x->OMgapId([OMgap1ARGS(x), CharacterTable(x[1])])[2]);
BindGlobal("OMgapConjugacyClass",
	x->OMgapId([OMgap2ARGS(x), ConjugacyClass(x[1], x[2])])[2]);
BindGlobal("OMgapDerivedSubgroup",
	x->OMgapId([OMgap1ARGS(x), DerivedSubgroup(x[1])])[2]);
BindGlobal("OMgapElementSet",
	x->OMgapId([OMgap1ARGS(x), Elements(x[1])])[2]);
BindGlobal("OMgapGroup", Group);
BindGlobal("OMgapIsAbelian", 
	x->OMgapId([OMgap1ARGS(x), IsAbelian(x[1])])[2]);
BindGlobal("OMgapIsNormal", 
	x->OMgapId([OMgap2ARGS(x), IsNormal(x[1], x[2])])[2]);
BindGlobal("OMgapIsSubgroup",
	x->OMgapId([OMgap2ARGS(x), IsSubgroup(x[1], x[2])])[2]);
BindGlobal("OMgapNormalClosure",
	x->OMgapId([OMgap2ARGS(x), NormalClosure(x[1], x[2])])[2]);
BindGlobal("OMgapQuotientGroup",  
	x->OMgapId([OMgap2ARGS(x), x[1]/ x[2]])[2]);
BindGlobal("OMgapSylowSubgroup", 
	x->OMgapId([OMgap2ARGS(x), SylowSubgroup(x[1], x[2])])[2]);

######################################################################
##
##  Semantic mappings for symbols from permgrp.cd
## 
BindGlobal("OMgapIsPrimitive",
	x->OMgapId([OMgap1ARGS(x), IsPrimitive(x[1])])[2]);
BindGlobal("OMgapOrbit", x->OMgapId([OMgap2ARGS(x), Orbit(x[1], x[2])])[2]);
BindGlobal("OMgapStabilizer", 
	x->OMgapId([OMgap2ARGS(x), Stabilizer(x[1], x[2])])[2]);
BindGlobal("OMgapIsTransitive", 
	x->OMgapId([OMgap1ARGS(x), IsTransitive(x[1])])[2]);



######################################################################
##
##  Semantic mappings for symbols from cas.cd
## 

## quit
BindGlobal("OMgapQuitFunc",
function()
	return fail;
end);

BindGlobal("OMgapQuit",
	x->OMgapQuitFunc());


## assign
BindGlobal("OMgapAssignFunc",
function(varname, obj)
	if IsBoundGlobal(varname) then
		UnbindGlobal(varname);
	fi;

	BindGlobal(varname, obj);
	MakeReadWriteGlobal(varname);
	return "";
end);

BindGlobal("OMgapAssign",
	x->OMgapId([OMgap2ARGS(x), OMgapAssignFunc(x[1],x[2])])[2]);

## retrieve
BindGlobal("OMgapRetrieveFunc",
function(varname)
	if ValueGlobal(varname) = fail then
		return false;
	else
		return ValueGlobal(varname);
	fi;
end);

BindGlobal("OMgapRetrieve",
	x->OMgapId([OMgap1ARGS(x), OMgapRetrieveFunc(x[1])])[2]);

## native_statement and error
OM_GAP_OUTPUT_STR := "";
OM_GAP_ERROR_STR := "";
BindGlobal("OMgapNativeStatementFunc",
function(statement)
	local i, result;

	OM_GAP_ERROR_STR := "";

	# if statement has READ, Read, WRITE or Write then it's illegal
	if (PositionSublist(statement, "READ") <> fail) or
		(PositionSublist(statement, "Read") <> fail) or
		(PositionSublist(statement, "WRITE") <> fail) or
		(PositionSublist(statement, "Write") <> fail) then

		OM_GAP_ERROR_STR := "Illegal Statement";
		return false;
	fi;

	i := InputTextString(statement);
	# want to catch standard out.
	result := READ_COMMAND(i,false);
	CloseStream(i);
	
	OM_GAP_OUTPUT_STR :=  ViewString(result);
	# this is the way of indicating an error condition...
	if (result = fail) then
		OM_GAP_ERROR_STR := "Unknown Error";
		return false;
	fi;

 	return true; 
end);

BindGlobal("OMgapNativeStatement",
	x->OMgapId([OMgap1ARGS(x), OMgapNativeStatementFunc(x[1])])[2]);

BindGlobal("OMgapNativeErrorFunc",
function()
	return OM_GAP_ERROR_STR; # near as possible to the empty object
end);

BindGlobal("OMgapNativeError",
	x->OMgapId(OMgapNativeErrorFunc()));

BindGlobal("OMgapNativeOutputFunc",
function()
	return OM_GAP_OUTPUT_STR; # near as possible to the empty object
end);

BindGlobal("OMgapNativeOutput",
	x->OMgapId(OMgapNativeOutputFunc()));

######################################################################
##
##  The Symbol Table proper
##
##  Maps a pair ["cd", "name"] to the corresponding OMgap... function
##  defined above.
##

BindGlobal("OMsymTable", [
["arith1",
	[[ "plus", OMgapPlus],
	[ "times", OMgapTimes],
	[ "divide", OMgapDivide],
	[ "power", OMgapPower]]],
["nums",
	[[ "rational", OMgapDivide]]],
["algnums",
	[[ "NthRootOfUnity", OMgapNthRootOfUnity]]],
["relation1",
	[[ "eq", OMgapEq],
	[ "neq", OMgapNeq],
	[ "lt", OMgapLt],
	[ "leq", OMgapLe],
	[ "gt", OMgapGt],
	[ "geq", OMgapGe]]],
["integer",
	[[ "quotient", OMgapQuotient],
	[ "rem", OMgapRem],
	[ "gcd", OMgapGcd]]],
["logic1",
	[ ["not", OMgapNot],
	["or", OMgapOr],
	["xor", OMgapXor],
	["and", OMgapAnd]]],
["list1",
	[["list", OMgapList]]],
["set1",
	[["set", OMgapSet],
	["in", OMgapIn],
	["union", OMgapUnion],
	["intersect", OMgapIntersect],
	["setdiff", OMgapSetDiff]]],
["linalg1",
	[["matrixrow", OMgapMatrixRow],
	["matrix", OMgapMatrix]]],
["permut1",
	[["Permutation", OMgapPermutation]]],
["group1",
	[["CharacterTableOfGroup", OMgapCharacterTableOfGroup],
	["CharacterTable", OMgapCharacterTableOfGroup],
	["ConjugacyClass", OMgapConjugacyClass],
	["DerivedSubgroup", OMgapDerivedSubgroup],
	["ElementSet", OMgapElementSet],
	["Group", OMgapGroup],
	["IsAbelian", OMgapIsAbelian],
	["IsNormal", OMgapIsNormal],
	["IsSubgroup", OMgapIsSubgroup],
	["NormalClosure", OMgapNormalClosure],
	["QuotientGroup", OMgapQuotientGroup],
	["RightTransversal", OMgapQuotientGroup],
	["SylowSubgroup", OMgapSylowSubgroup]]],
["permgroup",
	[["IsPrimitive", OMgapIsPrimitive],
	["Orbit", OMgapOrbit],
	["Stabilizer", OMgapStabilizer],
	["IsTransitive", OMgapIsTransitive]]],
["cas",
	[["quit", OMgapQuit],
	["assign", OMgapAssign],
	["retrieve",OMgapRetrieve],
	["native_statement", OMgapNativeStatement],
	["native_error", OMgapNativeError],
	["native_output", OMgapNativeOutput]]]]);


######################################################################
##
##  OMnullarySymbolToGAP(["cd", "name"])
##
##  Maps the OM symbol to the GAP value.
##
BindGlobal("OMnullarySymbolToGAP",
function(symbol)
	local cd, name;

	cd := symbol[1];
	name := symbol[2];

	if cd = "fns" then
		if name = "lambda" then return "LAMBDA";
		fi;
        elif cd = "logic1" then
                if name = "false" then return false;
                elif name = "true" then return true;
                fi;
	elif cd = "nums1" or cd = "nums" then 
		if name = "i" then return Sqrt(-1);
		elif name = "infinity" then return infinity;
		elif name = "false" then return false;
		elif name = "true" then return true;
		fi;
        elif cd = "set1" then
                if name = "emptyset" then return [];
                fi;
        elif cd = "setname1" then
                if name = "Z" then return Integers;
                elif name = "N" then return NonnegativeIntegers;
                elif name = "Q" then return Rationals;
                fi;
	else
		Error("unknown OpenMath nullary symbol, cd=", cd, " name=", name);
	fi;
end);


######################################################################
##
##  OMsymLookup(["cd", "name"])
##
##  Maps a pair ["cd", "name"] to the corresponding OMgap... function
##  defined above by looking up the symbol table.
##
BindGlobal("OMsymLookup", 
function(symbol)
	local cd, sym;

	for cd in OMsymTable do
		if cd[1] = symbol[1] then	# the cd names are the same
			for sym in cd[2] do
				if sym[1] = symbol[2] then
					return sym[2]; # return the function
				fi;
			od;
			# if we got here, we found the cd but not the symbol
			Error("unknown OpenMath symbol, cd=", symbol[1], " name=", symbol[2]);
		fi;
	od;
	# we didn't even find the cd
	Error("unknown OpenMath cd, cd=", symbol[1], " name=", symbol[2]);
end);


######################################################################
#E

