Iteratively calling Prolog from C

[Daniele Peri]

Some time ago I sent this email to the list but I got no answer. I try 
again now as the issue is still there. I hope to have better luck now...

Bye


I made some tests about iteratively calling prolog from a foreign C
function. The idea is to improve either performance or memory footprint
of very deep recursion calls. This is also needed as gprolog doesn't
seem to optimize tail recursion. I didn't delve into gprolog source but
I have not find any reference to such optimization in the documentation.
Anyway, my tests have a broader scope. So far I've been using a small
quick and dirty foreign function (see attached code) taking 4
parameters: the atom corresponding to the name of the predicate to
iterate, initial value for the input argument, the atom corresponding to
the name of the predicate holding the end condition, and the result's
parameter. I understand that I'm a bit messing with the stack and the
strange effects arising sometimes do not surprise me. I would try to fix
everything, though, but I'm probably missing some part of the puzzle,
with respect to gprolog's internals. I'm using gprolog-1.1.16 compiled
with gcc-3.2.1, Linux Kernel 2.4.19+ and glibc 2.2.5.
The problems I've experienced so far are:

1) If the iterating predicate is creating a compound the dynamicly
allocated memory used can't be released unless the size of the object is
below a certain threshold (for lists the threshold is 8018 elements, in
my environment). Of course this lead to memory leakage.
2) Foreign function needs some mechanism to recover properly from user's
interruption. Is there any facility in gprolog or it takes adding a
signal handler?
3) In some cases during iteration exceptions triggers exit from the main
loop without being reported at all.

All this problems arise in the code between Pl_Query_Begin() and
Pl_Query_End(). Conversely, my attempts to generate huge lists (i.e.
1000000) with the function break_list just worked fine.

Apart from the above mentioned problems, the hack works in most simple
cases, for instance it can generate very big lists as in test_rec/1 even
if very slowly (of course the dynamic allocation and Copy_Term mechanism
takes its time).

I wonder what else could be done.

Daniele
--
Daniele Peri
Ph.D. Student
DIE - Universita' degli Studi di Palermo
v.le delle Scienze, 90128 Palermo, Italy
Phone:+39-0916566273 Fax:+39-091488452
address@hidden



#include <gprolog.h>
#include <signal.h>

int stage, debug;
PlTerm *temp_arg_out2;

void
segv_handler(int signal)
{
        printf("caught segv, stage: %d, debug: %d\n", stage, debug);
        exit(1);
}


Bool
unify_two_terms(PlTerm term1, PlTerm term2)
{
        union {
                long type_int;
                double type_flt;
                long type_atm;
        } val;
        PlTerm *term2_temp;
        Bool retval;
        int type;
        
        type=Type_Of_Term(term1);
        switch(type){
                case INT :
                        val.type_int= Rd_Integer_Check(term1);
                        printf("%ld\n", val.type_int);
                        retval= Un_Integer_Check(val.type_int, term2);
                        break;
                case FLT :
                        val.type_flt= Rd_Float_Check(term1);
                        printf("%g\n", val.type_flt);
                        retval= Un_Float_Check(val.type_flt, term2);
                        break;
                case ATM :
                        val.type_atm= Rd_Atom_Check(term1);
                        printf("%ld\n", val.type_atm);
                        retval= Un_Atom_Check(val.type_atm, term2);
                        break;
                case LST :
                        printf("LST\n");
                        term2_temp= Rd_List_Check(term1);
                        retval= Un_List_Check(term2_temp, term2);
                        break;
                default:
                        printf("default\n");
                        break;
        };
        return retval;
}

Bool
tail_recursion(PlTerm pred, PlTerm arg_in, PlTerm end_cond_pred, PlTerm arg_out)
{
        PlTerm args[3], *temp_arg_out;
        int end_cond_pred_functor, pred_functor, arity, out_val;
        int result;
        int i, size_old, size;
        long val;

        signal(SIGSEGV, segv_handler);
        stage=0;
        args[0]= arg_in;
        size_old=0;
        temp_arg_out= NULL;
        temp_arg_out2= NULL;
        arity=2;
        pred_functor= Rd_Atom_Check(pred);
        end_cond_pred_functor= Rd_Atom_Check(end_cond_pred);

        printf("##################\ntail_recursion: #0\n");
                        
        while(1){
                printf("##################\ntail_recursion: #0b stage: %d\n", 
stage);
                stage++;
                debug=0;

                Pl_Query_Begin(TRUE);
                debug++;
                args[1]= Mk_Variable();
                
                debug++;
                result = Pl_Query_Call(end_cond_pred_functor, arity, args);
                debug++;
                if (result == PL_SUCCESS) {
                        printf("##################\ntail_recursion: #0c\n");
                        debug=100;      
                        debug++;
                        size= Term_Size(args[1]);
                        debug++;
                        temp_arg_out2= calloc(size, sizeof(PlTerm));
                        debug++;
                        if(!temp_arg_out2) {
                                debug=200;
                                goto no_mem_error_end;
                        }
                        debug++;
                        Copy_Term(temp_arg_out2, &args[1]);
#if 0           
                        if(Pl_Query_Next_Solution()) {
                                Pl_Query_End(PL_RECOVER);
                                Set_C_Bip_Name("tail_recursion", 4);
                                Pl_Err_System(Create_Atom("end_cond_pred must 
not be retractable"));
                                result= FALSE;
                                goto error_end;
                        }
#endif
                        Pl_Query_End(PL_RECOVER);

                        printf("##################\ntail_recursion: #1\n");
                        result= unify_two_terms(*temp_arg_out2, arg_out);
                        printf("##################\ntail_recursion: memory 
leak\n");
                        /*if(temp_arg_out2) free(temp_arg_out2);*/
                        /**/
                        debug++;
                        goto end;
                }
                printf("##################\ntail_recursion: #3\n");
                        
                debug++;
                Pl_Query_End(PL_RECOVER);
                debug++;

                printf("##################\ntail_recursion: #4\n");

                debug=300;
                if (result == PL_EXCEPTION) {
                        PlTerm except = Pl_Get_Exception();
                        Pl_Exec_Continuation(Find_Atom("throw"), 1, &except);
                        goto end;
                }

                printf("##################\ntail_recursion: #5\n");

                Pl_Query_Begin(TRUE);
                args[1]= Mk_Variable();
                result = Pl_Query_Call(pred_functor, arity, args);

                printf("##################\ntail_recursion: #6\n");

                if (result == PL_FAILURE) {
                        Pl_Query_End(PL_RECOVER);
                        Set_C_Bip_Name("tail_recursion", 4);
                        Pl_Err_Evaluation(pred_functor);
                        goto error_end;
                }
                printf("##################\ntail_recursion: #7\n");

                if (result == PL_EXCEPTION) {
                        printf("##################\ntail_recursion: #7c\n");
                        PlTerm except = Pl_Get_Exception();
                        printf("##################\ntail_recursion: #7d\n");
                        /*Pl_Exec_Continuation(Find_Atom("throw"), 1, 
&except);*/
                        printf("##################\ntail_recursion: #7e\n");
                        goto end;
                }
                printf("##################\ntail_recursion: #8\n");

                size=Term_Size(args[1]);
                if(size>size_old){
                        size+=1000;
                        if(temp_arg_out) free(temp_arg_out);
                        temp_arg_out= calloc(size, sizeof(PlTerm));
                        if(!temp_arg_out) {
                                goto no_mem_error_end;
                        }
                        size_old= size;
                }
                printf("##################\ntail_recursion: #9\n");

                Copy_Term(temp_arg_out, &args[1]);
                if(Pl_Query_Next_Solution()) {
                        Pl_Query_End(PL_RECOVER);
                        Set_C_Bip_Name("tail_recursion", 4);
                        Pl_Err_System(Create_Atom("pred must not be 
retractable"));
                        result= FALSE;
                        goto error_end;
                }
                Pl_Query_End(PL_RECOVER);
                args[0]=*temp_arg_out;
        };

no_mem_error_end:
        Pl_Err_System(Create_Atom("could not allocate memory"));
error_end:
        Pl_Query_End(PL_RECOVER);

end:
        printf("##################\nend\n");
        if(temp_arg_out) free(temp_arg_out);
        debug=501;
        debug=502;
        return result;  
}

Bool
break_list(long n, PlTerm list)
{
        PlTerm *list_array, list_temp, *list_temp2;
        int retval,i;
  
        list_array= calloc(n, sizeof(PlTerm));
        for(i=0; i<n; i++) list_array[i]=Mk_Integer(1);
        retval= FALSE;
        if(list){
                list_temp= Mk_Variable();
                retval= Un_Proper_List_Check(n, list_array, list_temp);
                list_temp2= calloc(Term_Size(list_temp), sizeof(PlTerm));
                if(list_temp2) {
                        Copy_Term(list_temp2, &list_temp);
                        printf("#2\n");
                        retval= unify_two_terms(list_temp, list);
                        free(list_temp2);
                        printf("#3\n");
                }
                free(list_array);
                printf("#4\n");
        }
        return retval;
}

Bool
free_c()
{
        if(temp_arg_out2) {
                free(temp_arg_out2);
                printf("removed\n");
        }
        return TRUE;
}

Bool
termout(PlTerm *term)
{
        PlTerm list[3];
        list[0]= Mk_Integer(32);
        list[1]= Mk_Integer(48);
        list[3]= Mk_Integer(48);
        
        *term= Mk_List(list);
        return TRUE;
}

%%%%%%%%%%%%%

:-foreign(tail_recursion(+term,+term, +term, term)).
:-foreign(break_list(+integer, term)).
:-foreign(free_c).

test_recursion(A):-
        B is A+1,
        test_recursion(B).

test_recursion_list(Max, A):-
        length(A, Len),
        Len>Max,
        format('max reached: ~q~n',[A]),
        !.
test_recursion_list(Max, A):-
        append(A, [1], B),
        test_recursion_list(Max, B).

test_pred(In,Out):-
        Out is In+1.
        %format('test_pred(~q,~q)~n', [A,B]).
test_pred_end(Out,Out):-
        Out>100000000.
test_pred3(In,Out):-
        append(In, [1], Out).
test_pred3b(In,Out):-
        append(In, [2], Out).
test_pred3_endb(In,Out):-
        % 8018 is the error threshold
        %length(In, 8018),
        length(In, 40),
        append(In, [5], Out).
test_pred3_end(In,Out):-
        % 8018 is the error threshold
        %length(In, 8018),
        length(In, 8018),
        append(In, [5], Out).
        
test_rec(Out):-
        tail_recursion(test_pred3, [7], test_pred3_end, Out).

_______________________________________________
Users-prolog mailing list
address@hidden
http://mail.gnu.org/mailman/listinfo/users-prolog