GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
###########################################################################
##
#W omputbin.gi OpenMath Package Max Nicosia
##
##
#Y Copyright (C) 1999, 2000, 2001, 2006
#Y School Math and Comp. Sci., University of St. Andrews, Scotland
#Y Copyright (C) 2004, 2005, 2006 Marco Costantini
##
## Low-level methods for output in the OpenMath binary format
##
###########################################################################
##
#M BigIntToListofInts( <integer> )
##
## Returns a list of 4 integers as to represent the number over 4 bytes
##
BindGlobal ( "BigIntToListofInts", function(int)
local hexValue, hexValueLength, finalHexString, lengthDiff, listofInts;
listofInts:=[];
finalHexString := "";
hexValue := HexStringInt(int);
hexValueLength := Length(hexValue);
if (hexValueLength < 8) then
lengthDiff := 8 - hexValueLength;
while lengthDiff > 0 do
Append(finalHexString,"0");
lengthDiff := lengthDiff - 1;
od;
fi;
Append(finalHexString, hexValue);
Add(listofInts, IntHexString(finalHexString{[1..2]}));
Add(listofInts, IntHexString(finalHexString{[3..4]}));
Add(listofInts, IntHexString(finalHexString{[5..6]}));
Add(listofInts, IntHexString(finalHexString{[7..8]}));
return listofInts;
end);
###########################################################################
#
#M IsIntFloat( <object> )
#
# Checks whethere it is a real float
BindGlobal( "IsIntFloat", function(x)
return Float(0) = x-Float(Int(x));
end);
###########################################################################
##
#M CreateListWithFalses( <integer> )
##
## Returns a list with the number of falses specified,
## if 0 then returns an empty list.
##
BindGlobal( "CreateListWithFalses", function(numFalses)
local listFalses, i;
listFalses := [];
for i in [1..numFalses] do
listFalses[i]:=false;
od;
return listFalses;
end);
###########################################################################
##
#M WriteIntasBytes( <stream>, <list> )
##
## Writes an integer as four bytes given a list representing the integer,
## in binary and the stream
##
BindGlobal( "WriteIntasBytes", function( stream, listofInts )
WriteByte(stream, listofInts[1]);
WriteByte(stream, listofInts[2]);
WriteByte(stream, listofInts[3]);
WriteByte(stream, listofInts[4]);
end);
###########################################################################
##
#M FindFirst1BinaryString( <string> )
##
## Obtains position of first 1 in the binary string
##
BindGlobal( "FindFirst1BinaryString", function( binStri )
local i, binStriLen;
binStriLen := Length(binStri);
i := 1;
while binStri[i] <> '1' and i <= binStriLen do
i := i +1;
od;
return i;
end);
###########################################################################
##
#M WriteDecasHex( <float> )
##
## Returns the decimal number in a hexadecimal representation
##
BindGlobal( "WriteDecasHex", function( decPart )
local intPart, resultHex, number, i, zeroF;
i := 0;
resultHex := "";
zeroF := Float("0.0");
while decPart <> zeroF do
if i > 10 then
break;
fi;
number := decPart * 16;
intPart := Int(number);
decPart := number - intPart;
Append(resultHex, HexStringInt(intPart));
i := i +1;
od;
return resultHex;
end);
###########################################################################
##
#M WriteHexAsBin( <hexNum>, <bool> )
##
## Returns the given hexadecimal number as a binary string.
## Leading zeroes are included if the flag is set to TRUE.
##
BindGlobal( "WriteHexAsBin", function( hexNum, withLeadingZeroes )
local hexNumLen, binStri, num, charStri, counter,
binArrayWithZeroes, binArrayNoLeadingZeroes;
hexNumLen := Length(hexNum);
binStri := "";
counter:= 1;
binArrayWithZeroes :=
["0000", "0001" ,"0010", "0011", "0100", "0101", "0110", "0111",
"1000", "1001", "1010", "1011", "1100", "1101", "1110", "1111"];
binArrayNoLeadingZeroes :=
["", "1" ,"10", "11", "100", "101", "110", "111", "1000",
"1001", "1010", "1011", "1100", "1101", "1110", "1111"];
charStri := hexNum{[counter]};
num := IntHexString(charStri);
if withLeadingZeroes then
Append(binStri, binArrayWithZeroes[num+1]);
else
Append(binStri, binArrayNoLeadingZeroes[num+1]);
fi;
counter := counter +1;
while counter <= hexNumLen do
charStri := hexNum{[counter]};
num := IntHexString(charStri);
Append(binStri, binArrayWithZeroes[num+1]);
counter := counter +1;
od;
return binStri;
end);
###########################################################################
##
#M WriteBinAsHex( <string> )
##
## Returns the binary string passed as a hexadecimal number
##
BindGlobal( "WriteBinAsHex", function( binStri )
local binStriLen, hexStri, counter, binArray,hexArray, limit, upper, lower;
binStriLen := Length(binStri);
hexStri := "";
counter:= 1;
binArray :=
["0000", "0001" ,"0010", "0011", "0100", "0101", "0110", "0111",
"1000", "1001", "1010", "1011", "1100", "1101", "1110", "1111"];
hexArray :=
["0", "1", "2", "3", "4", "5", "6", "7",
"8", "9", "A", "B", "C", "D", "E", "F"];
#limit := binStriLen /4;
upper := 4;
lower := 1;
while upper <= binStriLen do
for counter in [1..16] do
if binStri{[lower..upper]} = binArray[counter] then
Append(hexStri, hexArray[counter]);
break;
fi;
counter := counter + 1;
od;
upper := upper +4;
lower := lower + 4;
od;
return hexStri;
end);
###########################################################################
###
##M
## removes all falses at the start of the list.
#BindGlobal( "NormaliseBlist",
#function( list )
#local i, listLen, finalList;
#i:= 1;
#listLen := Length(list);
#while i <= listLen and list[i] = false do
# i := i +1;
#od;
#if i >= listLen then
# finalList := [list[listLen]];
#else
# finalList := list{[i..listLen]};
#fi;
#list := finalList;
#return i;
#end);
###########################################################################
##
#M WriteHexStriAsBytes( <string>, <stream> )
##
## Writes the hexadecimal string to the stream as bytes.
##
BindGlobal( "WriteHexStriAsBytes", function( hexStri, stream )
local hexStriLen, intValue, upper, lower;
upper := 2;
lower := 1;
intValue := 0;
hexStriLen := Length(hexStri);
while upper <= hexStriLen do
intValue := IntHexString(hexStri{[lower..upper]});
WriteByte(stream, intValue);
upper := upper +2;
lower := lower +2;
od;
end);
###########################################################################
##
#M WriteBinStringsAsBytes( <)
##
##
BindGlobal("WriteBinStringsAsBytes", function(sign,exponent,mantissa,stream)
local exponentLen, mantissaLen, firstPart, secondPart, numbZeroes, hexStri;
exponentLen := Length(exponent);
mantissaLen := Length(mantissa);
firstPart := "";
secondPart := mantissa;
if sign then
Append(firstPart, "1" );
else
Append(firstPart, "0" );
fi;
if exponentLen < 11 then
numbZeroes := 11 - exponentLen ;
while numbZeroes <> 0 do
Append(firstPart, "0");
numbZeroes := numbZeroes - 1;
od;
fi;
Append(firstPart, exponent);
if mantissaLen < 52 then
numbZeroes := 52 - mantissaLen;
while numbZeroes <> 0 do
Append(secondPart, "0");
numbZeroes := numbZeroes -1;
od;
fi;
Append(firstPart,secondPart);
hexStri := WriteBinAsHex(firstPart);
WriteHexStriAsBytes(hexStri, stream);
end);
###########################################################################
##
#O OMPutOMOBJ( <stream> )
#O OMPutEndOMOBJ( <stream> )
##
InstallMethod(OMPutOMOBJ, "to write OMOBJ in binary OpenMath", true,
[ IsOpenMathBinaryWriter ], 0,
function( writer )
WriteByte( writer![1], 24 );
end);
InstallMethod(OMPutEndOMOBJ, "to write /OMOBJ in binary OpenMath", true,
[ IsOpenMathBinaryWriter ], 0,
function( writer )
WriteByte( writer![1], 25 );
end);
###########################################################################
##
#M OMPut( <OMWriter>, <int> )
##
## Printing for integers: specified in the standard
##
InstallMethod(OMPut, "for an integer to binary OpenMath", true,
[ IsOpenMathBinaryWriter, IsInt ],0,
function( writer, int )
local intStri, intLength, intListLength;
intStri := String(AbsInt(int));
intLength := Length(intStri);
if int >= -128 and int <= 127 then
WriteByte( writer![1], 1);
if int < 0 then
int := 256 + int;
fi;
WriteByte(writer![1], int);
elif int >= -2^31 and int <= 2^31-1 then
WriteByte( writer![1], 129); #1+128
if int < 0 then
int := 2^32 + int;
fi;
intListLength := BigIntToListofInts(int);
WriteIntasBytes(writer![1], intListLength);
elif intLength >= 0 and intLength <= 255 then
WriteByte( writer![1], 2);
WriteByte(writer![1], intLength);
if int < 0 then
WriteByte(writer![1], 45); #base 10 | sign -
else
WriteByte(writer![1], 43); #base 10 | sign +
fi;
WriteAll(writer![1], intStri);
elif intLength > 255 then
WriteByte( writer![1], 130);#2+128
intListLength := BigIntToListofInts(intLength);
WriteIntasBytes(writer![1], intListLength);
if int < 0 then
WriteByte(writer![1], 45); #base 10 | sign -
else
WriteByte(writer![1], 43); #base 10 | sign +
fi;
WriteAll(writer![1], intStri);
fi;
end);
###########################################################################
##
#M OMPut( <OMWriter>, <float> )
##
##
##
InstallMethod(OMPut, "for a float to binary OpenMath", true,
[ IsOpenMathBinaryWriter, IsFloat ],0,
function(writer, f)
local intPart, decPart, sign, decHex, decBin, decBinLen, exponent,
pos, mantissa, intBin, absIntPart;
WriteByte( writer![1], 3);
if f > 0 then
sign := false;
else
sign := true;
fi;
intPart := Int(f);
if IsIntFloat(f) then
decPart := 0;
else
decPart := f - intPart;
fi;
decHex := WriteDecasHex(decPart);
decBin := WriteHexAsBin(decHex, true);
decBinLen := Length(decBin);
absIntPart := AbsInt(intPart);
if absIntPart = 0 then
pos := FindFirst1BinaryString(decBin);
exponent := 1023 - pos;
exponent := WriteHexAsBin(HexStringInt(exponent), false);
mantissa := decBin{[pos+1..decBinLen]};
else
intBin := WriteHexAsBin(HexStringInt(absIntPart),false);
pos := Length(intBin) -1;
exponent := 1023 + pos;
exponent := WriteHexAsBin(HexStringInt(exponent), false);
Append(intBin, decBin);
mantissa := intBin{[2..Length(intBin)]};
fi;
if Length(mantissa) > 52 then
mantissa := mantissa{[1..52]};
fi;
WriteBinStringsAsBytes( sign, exponent, mantissa , writer![1]);
end);
###########################################################################
##
#M OMPutVar( <OMWriter>, <variable> )
##
##
##
InstallMethod(OMPutVar, "for a variable to binary OpenMath", true,
[ IsOpenMathBinaryWriter, IsObject ],0,
function(writer, var)
local varLength, varStri, varLengthList;
varStri := String(var);
varLength := Length(varStri);
if varLength >= 256 then
WriteByte( writer![1], 133); #5+128
varLengthList := BigIntToListofInts(varLength);
WriteIntasBytes(writer![1], varLengthList);
else
WriteByte( writer![1], 5);
WriteByte(writer![1], varLength);
fi;
WriteAll(writer![1], varStri);
end);
###########################################################################
##
#M OMPut( <OMWriter>, <symbol> )
##
##
##
InstallMethod( OMPutSymbol, "for a symbol to binary OpenMath", true,
[IsOpenMathBinaryWriter, IsString, IsString ],0,
function( writer, cd, name )
local cdLength, nameLength, cdListInt, nameListInt;
nameListInt := [];
cdLength := Length(cd);
nameLength := Length(name);
if (cdLength > 255 or nameLength > 255) then
WriteByte( writer![1], 136); #128+8
cdListInt := BigIntToListofInts(cdLength);
nameListInt := BigIntToListofInts(nameLength);
#writing the cd length as 4 bytes
WriteIntasBytes(writer![1], cdListInt);
#writing the name length as 4 bytes
WriteIntasBytes(writer![1], nameListInt);
else
WriteByte(writer![1], 8);
WriteByte(writer![1], cdLength);
WriteByte(writer![1], nameLength);
fi;
WriteAll(writer![1], cd);
WriteAll(writer![1], name);
end);
###########################################################################
##
#M OMPutOMATTR
#M OMPutEndOMATTR
##
InstallMethod(OMPutOMATTR, "to write OMATTR in Binary OpenMath", true,
[IsOpenMathBinaryWriter],0,
function( writer )
WriteByte( writer![1], 18 );
end);
InstallMethod(OMPutEndOMATTR, "to write /OMATTR in Binary OpenMath", true,
[IsOpenMathBinaryWriter],0,
function( writer )
OMIndent := OMIndent - 1;
WriteByte( writer![1], 19 );
end);
###########################################################################
##
#M OMPutOMATP
#M OMPutEndOMATP
##
InstallMethod(OMPutOMATP, "to write OMATP in Binary OpenMath", true,
[IsOpenMathBinaryWriter],0,
function( writer )
WriteByte( writer![1], 20);
end);
InstallMethod(OMPutEndOMATP, "to write /OMATP in Binary OpenMath", true,
[IsOpenMathBinaryWriter],0,
function( writer )
WriteByte( writer![1], 21 );
end);
###########################################################################
##
#M OMPutOMBIND
#M OMPutEndOMBIND
##
InstallMethod(OMPutOMBIND, "to write OMBIND in Binary OpenMath", true,
[IsOpenMathBinaryWriter],0,
function( writer )
WriteByte( writer![1], 26 );
end);
InstallMethod(OMPutEndOMBIND, "to write /OMBIND in Binary OpenMath", true,
[IsOpenMathBinaryWriter],0,
function( writer )
WriteByte( writer![1], 27 );
end);
###########################################################################
##
#M OMPutOMBVAR
#M OMPutEndOMBVAR
##
InstallMethod(OMPutOMBVAR, "to write OMBVAR in Binary OpenMath", true,
[IsOpenMathBinaryWriter],0,
function( writer )
WriteByte( writer![1], 28 );
end);
InstallMethod(OMPutEndOMBVAR, "to write /OMBVAR in Binary OpenMath", true,
[IsOpenMathBinaryWriter],0,
function( writer )
WriteByte( writer![1], 29 );
end);
###########################################################################
##
#M OMPutByteArray( <OMWriter>, <bitList> )
##
##
InstallGlobalFunction( OMPutByteArray, function( writer, bitList )
# TODO: fill the 2nd branch and move this function to omput.gi
local numBytesLength, bitListLength, tempList, numFalses, hexStri,
numBytes, quoVal, modVal;
if IsOpenMathBinaryWriter(writer) then
bitListLength := Length(bitList);
quoVal := QuoInt(bitListLength,8);
modVal := bitListLength mod 8;
if quoVal = 0 then
numBytes := 1;
numFalses := 8 - bitListLength;
else
if modVal <> 0 then
numBytes := quoVal +1;
numFalses := 8 - modVal;
else
numBytes := quoVal;
numFalses := 0;
fi;
fi;
if numBytes > 255 then
numBytesLength := BigIntToListofInts(numBytes);
WriteByte(writer![1],132); #4+128
#writing the string length as 4 bytes
WriteIntasBytes(writer![1], numBytesLength);
else
WriteByte(writer![1],4);
WriteByte(writer![1], numBytes);
fi;
tempList := CreateListWithFalses(numFalses);
Append(tempList, bitList);
hexStri := HexStringBlist(tempList);
WriteHexStriAsBytes(hexStri, writer![1]);
else
Error("Bytearrays are not supported in the XML mode yet!");
fi;
end);
###########################################################################
##
#M OMPut( <OMWriter>, <string> )
##
##
InstallMethod(OMPut, "for a string to binary OpenMath", true,
[IsOpenMathBinaryWriter, IsString ],0,
function( writer, string )
local strLength, strListLength;
strLength := Length(string);
if strLength > 255 then
strListLength := BigIntToListofInts(strLength);
WriteByte(writer![1], 134); # 6+128
#writing the string length as 4 bytes
WriteIntasBytes(writer![1], strListLength);
else
WriteByte(writer![1], 6);
WriteByte(writer![1], strLength);
fi;
WriteAll(writer![1],string);
end);
###########################################################################
##
#M OMPut( <OMWriter>, <foreign> )
##
##
InstallMethod( OMPutForeign, "for a foreign object to binary OpenMath", true,
[IsOpenMathBinaryWriter, IsString, IsString ],0,
function( writer, encString, objString )
local encStrLength, encStrListLength, objStrLength, objStrListLength;
encStrLength := Length(encString);
objStrLength := Length(objString);
if encStrLength > 255 or objStrLength > 255 then
WriteByte(writer![1], 140);#12+128
encStrListLength := BigIntToListofInts(encStrLength);
objStrListLength := BigIntToListofInts(objStrLength);
WriteIntasBytes(writer![1], encStrListLength);
WriteIntasBytes(writer![1], objStrListLength);
else
WriteByte(writer![1], 12);
WriteByte(writer![1], encStrLength);
WriteByte(writer![1], objStrLength);
fi;
WriteAll(writer![1], encString);
WriteAll(writer![1], objString);
end);
###########################################################################
##
#M OMPutOMAWithId( <OMWriter>, <reference> )
##
##
InstallMethod( OMPutOMAWithId, "to put Applications with Ids", true,
[IsOpenMathBinaryWriter , IsString],0,
function(writer, reference)
local referenceList, referenceLen;
referenceLen := Length(reference);
if referenceLen > 255 then
referenceList := BigIntToListofInts(referenceLen);
WriteByte(writer![1], 208); # 16+64+128
#writing the reference length as 4 bytes
WriteIntasBytes(writer![1], referenceList);
else
WriteByte(writer![1], 80); #16+64
WriteByte(writer![1], referenceLen);
fi;
WriteAll(writer![1], reference);
end);
###########################################################################
##
#O OMPutOMA( <OMWriter> );
#O OMPutEndOMA( <OMWriter> );
##
##
InstallMethod(OMPutOMA, "to write OMA in binary OpenMath", true,
[ IsOpenMathBinaryWriter ], 0,
function( writer )
WriteByte( writer![1], 16 );
end);
InstallMethod(OMPutEndOMA, "to write /OMA in binary OpenMath", true,
[ IsOpenMathBinaryWriter ], 0,
function( writer )
WriteByte( writer![1], 17 );
end);
###########################################################################
##
#O OMPutOME( <OMWriter> );
#O OMPutEndOME( <OMWriter> );
##
##
InstallMethod(OMPutOME, "to write OME in binary OpenMath", true,
[ IsOpenMathBinaryWriter ], 0,
function( writer )
WriteByte( writer![1], 22 );
end);
InstallMethod(OMPutEndOME, "to write /OME in binary OpenMath", true,
[ IsOpenMathBinaryWriter ], 0,
function( writer )
WriteByte( writer![1], 23 );
end);
###########################################################################
##
#M OMPut( <OMWriter>, <reference> )
##
## deals with external references for now
##
InstallMethod( OMPutReference, "for a stream and an object with reference",
true, [ IsOpenMathBinaryWriter, IsObject ], 0,
function( writer, x )
local refStri, refLength, lengthList;
if HasOMReference( x ) and not SuppressOpenMathReferences then
refStri := OMReference( x );
refLength := Length(refStri);
if refLength > 255 then
WriteByte (writer![1], 159); #31+128
lengthList := BigIntToListofInts(refLength);
WriteIntasBytes(writer![1], lengthList);
else
WriteByte (writer![1], 31);
WriteByte (writer![1], refLength);
fi;
WriteAll(writer![1], refStri);
else
OMPut( writer, x );
fi;
end);
###########################################################################
#E