PLUGIN long
lang: "C++"
version: "1.0"
date: "2022-01-30"
author: "Julien BRUGUIER"
maintainer: "Julien BRUGUIER <projet.svm@pappy.tf>"
title: "Towards infinite precision arithmetic"
synopsis: "This plugin gives access to numbers defined in the GMP library."
example: "Factorial"
%{
.nf
#!===SVMBIN===
LOG
PLUGIN "svmcom.so"
PLUGIN "===PLUGINLIB==="
ARGUMENT STR n
PROCESS "main"
	CODE "main" INLINE
		:memory (PTR, long.int, long.int)/p
		:long.parse @&n -> (p/1)
		:call fact p
		:com.message @(p/2)
		:shutdown
	:label fact
		:memory BLN, PTR, long.int*2 -> &P
		:long.cmp @(P/1) = 0 -> &@&P
		:goto end_fact :when @&@&P TRUE
		:long.diff @(P/1) 1 -> (@&P/2)
		:call fact (@&P/1)*3
		:long.prod @(@&P/3) @(P/1) -> (P/2)
		:return
	:label end_fact
		CONST long.int "1" -> (P/2)
		:return
	END
	MEMORY n
END
.fi
%}

link: "-lgmp"
includes:
%{
#include <gmp.h>
%}
code:
%{
static gmp_randstate_t state;
%}
initialisation:
%{
	::gmp_randinit_default(state);
%}
finalisation:
%{
	::gmp_randclear(state);
%}

DEFINE

TYPE long.int
%{
	explicit type_int(const mpz_t& i)
	:_int(i) {}
	type_int(const type_int& i)
	{
		::mpz_init_set(_int,i._int);
	}
	~type_int()
	{
		::mpz_clear(_int);
	}
	mpz_t _int;
%}
delete default: %{}
copy default: %{}
constant string:
%{
	mpz_t i;
	auto e = ::mpz_init_set_str(i,string.c_str(),10);
	if(e)
	{
		::mpz_set_si(i,0);
	}
	type_int *object = new type_int(i);
	return object;
%}
print object:
%{
	char *ss = ::mpz_get_str(nullptr,10,object->_int);
	std::string s = ss;
	::free(ss);
	return ::svm_string_new(svm,s.c_str(),s.size());
%}
help: "The infinite precision integer."

INSTRUCTION long.parse STR INT ? : base -> long.int
%{
	SVM_String integer = ARGV_VALUE(0,string);
	long long int base = 10;
	if(argc>1)
	{
		base = ::svm_value_integer_get(svm,::svm_parameter_value_get(svm,argv[1]));
		if((base<2) or (base>36))
		{
			ERROR_INTERNAL(NUMERIC,"Invalid base");
		}
	}
	mpz_t i;
	auto e = ::mpz_init_set_str(i,std::string(integer.string,integer.size).c_str(),base);
	if(e)
	{
		::mpz_clear(i);
		ERROR_INTERNAL(NUMERIC,"Invalid integer");
	}
	type_int *ii = new type_int(i);
	return NEW_PLUGIN(long,int,ii);
%}
help:
%{
Safe string parsing for long.int conversion.
An optional base can be specified from 2 to 36.
When not given as parameter, the base 10 is used.
.TP
If the base or the string are incorrect, a NUMERIC interruption is raised.
%}

INSTRUCTION long.print long.int INT ? : base -> STR
%{
	type_int *integer = ARGV_PLUGIN(0,long,int);
	long long int base = 10;
	if(argc>1)
	{
		base = ::svm_value_integer_get(svm,::svm_parameter_value_get(svm,argv[1]));
		if((base<2) or (base>36))
		{
			ERROR_INTERNAL(NUMERIC,"Invalid base");
		}
	}
	char *ss = ::mpz_get_str(nullptr,base,integer->_int);
	std::string s = ss;
	::free(ss);
	return ::svm_value_string_new__buffer(svm,s.c_str(),s.size());
%}
help:
%{
Conversion to string.
An optional base can be specified from 2 to 36.
When not given as parameter, the base 10 is used.
.TP
If the base is incorrect, a NUMERIC interruption is raised.
%}

INSTRUCTION long.long INT -> long.int
%{
	long long int integer = ARGV_VALUE(0,integer);
	::mpz_t i;
	::mpz_init_set_si(i,integer);
	type_int *ii = new type_int(i);
	return NEW_PLUGIN(long,int,ii);
%}
help:
%{
Conversion from short integer.
%}

INSTRUCTION long.short long.int -> INT
%{
	type_int *integer = ARGV_PLUGIN(0,long,int);
	auto i = ::mpz_get_si(integer->_int);
	return NEW_VALUE(integer,i);
%}
help:
%{
Conversion to short integer.
.TP
Result is undefined when the long integer exceeds the capacity of a short integer.
%}

INSTRUCTION long.cmp [ INT long.int ] [ < > = <> <= => ] [ INT long.int ] -> BLN
%{
	mpz_t g;
	SVM_Value vg = ::svm_parameter_value_get(svm,argv[0]);
	if(::svm_value_type_is_integer(svm,vg))
	{
		auto gi = ::svm_value_integer_get(svm,vg);
		::mpz_init_set_si(g,gi);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vg));
		::mpz_init_set(g,integer->_int);
	}
	mpz_t d;
	SVM_Value vd = ::svm_parameter_value_get(svm,argv[2]);
	if(::svm_value_type_is_integer(svm,vd))
	{
		auto di = ::svm_value_integer_get(svm,vd);
		::mpz_init_set_si(d,di);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vd));
		::mpz_init_set(d,integer->_int);
	}
	SVM_String c = ::svm_parameter_marker_get(svm,argv[1]);
	std::string cmp(c.string,c.size);
	auto r = ::mpz_cmp(g,d);
	::mpz_clear(g);
	::mpz_clear(d);
	return ::svm_value_boolean_new__raw(svm,((r<0) and ((cmp=="<") or (cmp=="<>"))) or ((r<=0) and ((cmp=="<=") or (cmp=="<>"))) or ((r==0) and (cmp=="=")) or ((r>0) and ((cmp==">") or (cmp=="<>"))) or ((r>=0) and ((cmp=="=>") or (cmp=="<>"))));
%}
help:
%{
Compares two integers, mixing short and long integers.
%}

INSTRUCTION long.sum [ INT long.int ] + -> long.int
%{
	mpz_t s;
	::mpz_init_set_si(s,0);
	for(SVM_Size i = 0 ; i<argc ; ++i)
	{
		SVM_Value v = ::svm_parameter_value_get(svm,argv[i]);
		if(::svm_value_type_is_integer(svm,v))
		{
			auto d = ::svm_value_integer_get(svm,v);
			mpz_t vv;
			::mpz_init_set_si(vv,d);
			::mpz_add(s,s,vv);
			::mpz_clear(vv);
		}
		else
		{
			type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,v));
			::mpz_add(s,s,integer->_int);
		}
	}
	type_int *ii = new type_int(s);
	return NEW_PLUGIN(long,int,ii);
%}
help: "Compute the sum of short and long integers."

INSTRUCTION long.diff [ INT long.int ] 2 -> long.int
%{
	mpz_t g;
	SVM_Value vg = ::svm_parameter_value_get(svm,argv[0]);
	if(::svm_value_type_is_integer(svm,vg))
	{
		auto gi = ::svm_value_integer_get(svm,vg);
		::mpz_init_set_si(g,gi);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vg));
		::mpz_init_set(g,integer->_int);
	}
	mpz_t d;
	SVM_Value vd = ::svm_parameter_value_get(svm,argv[1]);
	if(::svm_value_type_is_integer(svm,vd))
	{
		auto di = ::svm_value_integer_get(svm,vd);
		::mpz_init_set_si(d,di);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vd));
		::mpz_init_set(d,integer->_int);
	}
	mpz_t r;
	::mpz_init(r);
	::mpz_sub(r,g,d);
	::mpz_clear(g);
	::mpz_clear(d);
	type_int *ii = new type_int(r);
	return NEW_PLUGIN(long,int,ii);
%}
help: "Compute the difference of short and long integers."

INSTRUCTION long.prod [ INT long.int ] + -> long.int
%{
	mpz_t p;
	::mpz_init_set_si(p,1);
	for(SVM_Size i = 0 ; i<argc ; ++i)
	{
		SVM_Value v = ::svm_parameter_value_get(svm,argv[i]);
		if(::svm_value_type_is_integer(svm,v))
		{
			auto d = ::svm_value_integer_get(svm,v);
			::mpz_mul_si(p,p,d);
		}
		else
		{
			type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,v));
			::mpz_mul(p,p,integer->_int);
		}
	}
	type_int *ii = new type_int(p);
	return NEW_PLUGIN(long,int,ii);
%}
help: "Compute the product of short and long integers."

INSTRUCTION long.quot [ INT long.int ] 2 -> long.int
%{
	mpz_t g;
	SVM_Value vg = ::svm_parameter_value_get(svm,argv[0]);
	if(::svm_value_type_is_integer(svm,vg))
	{
		auto gi = ::svm_value_integer_get(svm,vg);
		::mpz_init_set_si(g,gi);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vg));
		::mpz_init_set(g,integer->_int);
	}
	mpz_t d;
	SVM_Value vd = ::svm_parameter_value_get(svm,argv[1]);
	if(::svm_value_type_is_integer(svm,vd))
	{
		auto di = ::svm_value_integer_get(svm,vd);
		::mpz_init_set_si(d,di);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vd));
		::mpz_init_set(d,integer->_int);
	}
	if(mpz_sgn(d)==0)
	{
		::mpz_clear(g);
		::mpz_clear(d);
		ERROR_INTERNAL(NUMERIC,"Invalid divisor");
	}
	mpz_t r;
	::mpz_init(r);
	::mpz_tdiv_q(r,g,d);
	type_int *ii = new type_int(r);
	return NEW_PLUGIN(long,int,ii);
%}
help:
%{
Compute the quotient of short and long integers.
.TP
When the divisor is zero, a NUMERIC interruption is raised.
%}

INSTRUCTION long.rem [ INT long.int ] 2 -> long.int
%{
	mpz_t g;
	SVM_Value vg = ::svm_parameter_value_get(svm,argv[0]);
	if(::svm_value_type_is_integer(svm,vg))
	{
		auto gi = ::svm_value_integer_get(svm,vg);
		::mpz_init_set_si(g,gi);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vg));
		::mpz_init_set(g,integer->_int);
	}
	mpz_t d;
	SVM_Value vd = ::svm_parameter_value_get(svm,argv[1]);
	if(::svm_value_type_is_integer(svm,vd))
	{
		auto di = ::svm_value_integer_get(svm,vd);
		::mpz_init_set_si(d,di);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vd));
		::mpz_init_set(d,integer->_int);
	}
	if(mpz_sgn(d)==0)
	{
		::mpz_clear(g);
		::mpz_clear(d);
		ERROR_INTERNAL(NUMERIC,"Invalid divisor");
	}
	mpz_t r;
	::mpz_init(r);
	::mpz_tdiv_r(r,g,d);
	::mpz_clear(g);
	::mpz_clear(d);
	type_int *ii = new type_int(r);
	return NEW_PLUGIN(long,int,ii);
%}
help:
%{
Compute the remainder of short and long integers.
.TP
When the divisor is zero, a NUMERIC interruption is raised.
%}

SYSTEM INSTRUCTION long.exp [ INT long.int ] INT -> long.int
%{
	mpz_t g;
	SVM_Value vg = ::svm_parameter_value_get(svm,argv[0]);
	if(::svm_value_type_is_integer(svm,vg))
	{
		auto gi = ::svm_value_integer_get(svm,vg);
		::mpz_init_set_si(g,gi);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vg));
		::mpz_init_set(g,integer->_int);
	}
	auto di = ARGV_VALUE(1,integer);
	mpz_t r;
	::mpz_init(r);
	::mpz_pow_ui(r,g,di);
	::mpz_clear(g);
	type_int *ii = new type_int(r);
	return NEW_PLUGIN(long,int,ii);
%}
help:
%{
Compute the exponentiation for two integers.
The exposant is always a short integer.
.TP
When the exposant is negative, the instruction is unsafe.
%}

INSTRUCTION long.rand [ INT long.int ] -> long.int
%{
	mpz_t g;
	SVM_Value vg = ::svm_parameter_value_get(svm,argv[0]);
	if(::svm_value_type_is_integer(svm,vg))
	{
		auto gi = ::svm_value_integer_get(svm,vg);
		::mpz_init_set_si(g,gi);
	}
	else
	{
		type_int *integer = reinterpret_cast<type_int*>(::svm_value_plugin_get_internal(svm,vg));
		::mpz_init_set(g,integer->_int);
	}
	mpz_t r;
	::mpz_init(r);
	::mpz_urandomm(r,state,g);
	::mpz_clear(g);
	type_int *ii = new type_int(r);
	return NEW_PLUGIN(long,int,ii);
%}
help:
%{
Compute a pseudo-random number between zero and the limit given as parameter.
%}