samer@0: /*
samer@0:  * Prolog-C utilities
samer@0:  * Samer Abdallah (2009)
samer@0:  */
samer@0: 
samer@0: //#define _USE_MATH_DEFINES 1
samer@0: //#include "plutils.h"
samer@0: 
samer@0: //#include <math.h>
samer@0: //#include <float.h>
samer@0: 
samer@0: // throws a Prolog exception to signal type error
samer@0: int type_error(term_t actual, const char *expected)
samer@0: { 
samer@0: 	term_t ex = PL_new_term_ref();
samer@0: 	int rc = PL_unify_term(ex, PL_FUNCTOR_CHARS, "error", 2,
samer@0: 		      PL_FUNCTOR_CHARS, "type_error", 2,
samer@0: 		        PL_CHARS, expected,
samer@0: 		        PL_TERM, actual,
samer@0: 		      PL_VARIABLE);
samer@0: 
samer@0:   return rc && PL_raise_exception(ex);
samer@0: }
samer@0: 
samer@0: double sum_array(double *p, int n) {
samer@0: 	double tot=0;
samer@0: 	int	i;
samer@0: 	for (i=0; i<n; i++) tot+=*p++;
samer@0: 	return tot;
samer@0: }
samer@0: 
samer@0: int memory_error(size_t amount)
samer@0: { 
samer@0: 	term_t ex = PL_new_term_ref();
samer@0: 	int rc = PL_unify_term(ex, PL_FUNCTOR_CHARS, "error", 2,
samer@0: 		      PL_FUNCTOR_CHARS, "memory_error", 1,
samer@0: 		        PL_INTEGER, amount,
samer@0: 		      PL_VARIABLE);
samer@0: 
samer@0: 	return rc && PL_raise_exception(ex);
samer@0: }
samer@0: 
samer@0: // extract double from Prolog float
samer@0: int get_double(term_t term, double *p)
samer@0: { 
samer@0: 	if (PL_get_float(term, p)) return TRUE; 
samer@0: 	else return type_error(term, "float");
samer@0: }
samer@0: 
samer@0: // extract long from Prolog integer
samer@0: int get_long(term_t term, long *p)
samer@0: { 
samer@0: 	if (PL_get_long(term, p)) return TRUE; 
samer@0: 	else return type_error(term, "integer");
samer@0: }
samer@0: 
samer@0: 
samer@0: // unify Prolog list of floats with array of doubles
samer@0: int unify_list_doubles(term_t list, double *x, int n)
samer@0: {
samer@0: 	int i;
samer@0: 	list=PL_copy_term_ref(list);
samer@0: 
samer@0: 	for (i=0; i<n; i++) {
samer@0: 		term_t head=PL_new_term_ref();
samer@0: 		term_t tail=PL_new_term_ref();
samer@0: 		if (!PL_unify_list(list,head,tail)) PL_fail; 
samer@0: 		if (!PL_unify_float(head,x[i])) PL_fail;
samer@0: 		list=tail;
samer@0: 	}
samer@0: 	return PL_unify_nil(list);
samer@0: }
samer@0: 
samer@0: // read list of floats from term and write to double array
samer@0: int get_list_doubles(term_t list, double *vals, int len)
samer@0: {
samer@0: 	term_t  head=PL_new_term_ref();
samer@0: 	int 		n;
samer@0: 
samer@0: 	// copy term ref so as not to modify original
samer@0: 	list=PL_copy_term_ref(list);
samer@0: 	for (n=0; n<len && PL_get_list(list,head,list);n++) {
samer@0: 			if (!PL_get_float(head,&vals[n])) return FALSE;
samer@0: 	}
samer@0: 	if (!PL_get_nil(list)) return FALSE; 
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: int unify_args_doubles(term_t state, double *p, int n)
samer@0: {
samer@0: 	term_t arg = PL_new_term_ref();
samer@0: 	int i;
samer@0: 
samer@0: 	for (i=0; i<n; i++) {
samer@0: 		if (!PL_put_float(arg,p[i])) PL_fail;
samer@0: 		if (!PL_unify_arg(i+1,state,arg)) PL_fail;
samer@0: 	}
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: int get_args_doubles(term_t state, double *p, int n)
samer@0: {
samer@0: 	term_t arg = PL_new_term_ref();
samer@0: 	int i;
samer@0: 
samer@0: 	for (i=0; i<n; i++) {
samer@0: 		_PL_get_arg(i+1, state, arg);
samer@0: 		if (!get_double(arg, p+i)) return FALSE;
samer@0: 	}
samer@0: 	return TRUE;
samer@0: }
samer@0: 
samer@0: int alloc_array(size_t N, size_t SZ, void **PP) {
samer@0: 	*PP=calloc(N,SZ);
samer@0: 	if (*PP) return TRUE;
samer@0: 	else return memory_error(N*SZ);
samer@0: }
samer@0: