From 1d2de81e86e03ee96857f6757380044adce048ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 3 Nov 2011 07:54:51 +0900 Subject: [PATCH] update bprolog emulation stuff. --- library/dialect/bprolog.yap | 222 +++++++++++++++++++++++++ library/dialect/bprolog/actionrules.pl | 26 ++- library/dialect/bprolog/arrays.yap | 2 +- library/dialect/bprolog/fli/bprolog.h | 59 +++++-- library/dialect/bprolog/hashtable.yap | 15 +- 5 files changed, 302 insertions(+), 22 deletions(-) diff --git a/library/dialect/bprolog.yap b/library/dialect/bprolog.yap index cec080621..c2cdcc067 100644 --- a/library/dialect/bprolog.yap +++ b/library/dialect/bprolog.yap @@ -1,7 +1,229 @@ +:- set_prolog_flag(dollar_as_lower_case,on). + +:- use_module(library(lists)). +:- use_module(library(hacks),[ + current_choicepoint/1, + cut_by/1]). +:- use_module(library(terms)). +:- use_module(library(system)). + :- ensure_loaded(bprolog/arrays). :- ensure_loaded(bprolog/hashtable). %:- ensure_loaded(bprolog/actionrules). :- ensure_loaded(bprolog/foreach). %:- ensure_loaded(bprolog/compile_foreach). + +:- op(700, xfx, [?=]). +:- op(200, fx, (@)). + +X ?= Y :- unifiable(X,Y,_). + +global_set(F,N,Value) :- + atomic_concat([F,'/',N],Key), + nb_setval(Key, Value). + +global_set(F,Value) :- + atom_concat([F,'/0'],Key), + nb_setval(Key, Value). + +global_get(F,Arity,Value) :- + atomic_concat([F,'/',Arity],Key), + nb_getval(Key, Value). + +global_get(F,Value) :- + atom_concat([F,'/0'],Key), + nb_getval(Key, Value). + +global_del(F,Arity) :- + atomic_concat([F,'/',Arity],Key), + catch(nb_delete(Key),_,true). + +global_del(F) :- + atom_concat([F,'/0'],Key), + catch(nb_delete(Key),_,true). + +getclauses1(File, Prog, _Opts) :- + findall(Clause, '$bpe_get_clause_from_file'(File, Clause), Prog0), + '$bpe_get_preds'(Prog0, Prog). + +'$bpe_open_file'(File, Dir, S) :- + absolute_file_name(File, Abs, [expand(true),access(read)]), + file_directory_name(Abs, Dir), + open(Abs, read, S). + +'$bpe_get_clause_from_file'(File, Clause) :- + '$bpe_open_file'(File, Dir, S), + working_directory(Old, Dir), + repeat, + read(S, Clause0), + ( Clause0 = end_of_file -> + !, + working_directory(Dir, Old), + fail + ; + %ugh, but we have to process include directives on the spot... + Clause0 = (:- include(Include)) + -> + '$bpe_get_clause_from_file'(Include, Clause) + ; + Clause = Clause0 + ). + +'$bpe_get_preds'(Decl.Prog0, pred(F,N,Modes,Delay,Tabled,Cls).NProg) :- + '$get_pred'(Decl, F, N, Modes,Delay, Tabled, Cls, Cls0), !, + '$bpe_process_pred'(Prog0, F,N,Modes,Delay,Tabled, Cls0, ProgF, []), + '$bpe_get_preds'(ProgF, NProg). +'$bpe_get_preds'(_Decl.Prog0, NProg) :- + '$bpe_get_preds'(Prog0, NProg). +'$bpe_get_preds'([], []). + +'$bpe_process_pred'([], _F, N, Mode, _Delay, _Tabled, []) --> + { '$init_mode'(N, Mode) }. +'$bpe_process_pred'(Call.Prog0, F,N,Modes,Delay,Tabled, Cls0) --> + { '$get_pred'(Call, F, N, Modes, Delay, Tabled, Cls0, ClsI) }, !, + '$bpe_process_pred'(Prog0, F,N,Modes,Delay,Tabled, ClsI). +'$bpe_process_pred'(Call.Prog0, F,N,Modes,Delay,Tabled, Cls0) --> + [ Call ], + '$bpe_process_pred'(Prog0, F,N,Modes,Delay,Tabled, Cls0). + +'$init_mode'(_N, Mode) :- nonvar(Mode), !. +'$init_mode'(0, []) :- !. +'$init_mode'(I, [d|Mode]) :- !, + I0 is I-1, + '$init_mode'(I0, Mode). + +'$get_pred'((P :- Q), F, N, _Modes, _Delay, _Tabled) --> + { functor(P, F, N), ! }, + [(P:-Q)]. +'$get_pred'((:- mode Q), F, N, _Modes, _Delay, _Tabled) --> + { functor(Q, F, N), !, Q =.. [_|Modes0], + '$bpe_cvt_modes'(Modes0,Modes,[]) + }, + []. +%'$get_pred'((:- table _), F, N, Modes, Delay, Tabled) --> +% { functor(Q, F, N), !, Q =.. [_|Modes] }, +% []. +'$get_pred'((:- _), _F, _N, _Modes, _Delay, _Tabled) --> !, { fail }. +'$get_pred'((P), F, N, _Modes, _Delay, _Tabled) --> + { functor(P, F, N), ! }, + [(P)]. + + +'$bpe_cvt_modes'(Mode.Modes0) --> [NewMode], + { '$bpe_cvt_mode'(Mode, NewMode) }, + '$bpe_cvt_modes'(Modes0). +'$bpe_cvt_modes'([]) --> []. + +'$bpe_cvt_mode'(Mode, Mode). + +list_to_and([], true). +list_to_and([G], G). +list_to_and([G1,G2|Gs], (G1, NGs)) :- + list_to_and([G2|Gs], NGs). + +preprocess_cl(Cl, Cl, _, _, _, _). + +phase_1_process(Prog, Prog). + +compileProgToFile(_,_File,[]). +compileProgToFile(_,File,pred(F,N,_,_,Tabled,Clauses).Prog2) :- + (nonvar(Tabled) -> table(F/N) ; true), + functor(S,F,N), + assert(b_IS_CONSULTED_c(S)), + '$assert_clauses'(Clauses), + compileProgToFile(_,File,Prog2). + +'$assert_clauses'([]). +'$assert_clauses'(Cl.Clauses) :- + assert_static(Cl), + '$assert_clauses'(Clauses). + +'$myload'(_F). + +initialize_table :- abolish_all_tables. + +:- dynamic b_IS_DEBUG_MODE/0. + +'_$savecp'(B) :- current_choicepoint(B). +'_$cutto'(B) :- cut_by(B). + +X <= Y :- subsumes_chk(Y,X). + +cputime(X) :- statistics(cputime,[X,_]). + +vars_set(Term, Vars) :- + term_variables(Term, Vars). + +sort(=<, L, R) :- + length(L, N), + $bp_sort(@=<, N, L, _, R1), !, + R = R1. +sort(>=, L, R) :- + length(L, N), + $bp_sort(@>=, N, L, _, R1), !, + R = R1. +sort(<, L, R) :- + length(L, N), + $bp_sort2(@<, N, L, _, R1), !, + R = R1. +sort(>, L, R) :- + length(L, N), + $bp_sort2(@>, N, L, _, R1), !, + R = R1. + +$bp_sort(P, 2, [X1, X2|L], L, R) :- !, + ( + call(P, X1, X2) -> + R = [X1,X2] + ; + R = [X2,X1] + ). +$bp_sort(_, 1, [X|L], L, [X]) :- !. +$bp_sort(_, 0, L, L, []) :- !. +$bp_sort(P, N, L1, L3, R) :- + N1 is N // 2, + plus(N1, N2, N), + $bp_sort(P, N1, L1, L2, R1), + $bp_sort(P, N2, L2, L3, R2), + $bp_predmerge(P, R1, R2, R). + +$bp_predmerge(_, [], R, R) :- !. +$bp_predmerge(_, R, [], R) :- !. +$bp_predmerge(P, [H1|T1], [H2|T2], [H1|Result]) :- + call(P, H1, H2), !, + $bp_predmerge(P, T1, [H2|T2], Result). +$bp_predmerge(P, [H1|T1], [H2|T2], [H2|Result]) :- + $bp_predmerge(P, [H1|T1], T2, Result). + +$bp_sort2(P, 2, [X1, X2|L], L, R) :- !, + ( + call(P, X1, X2) -> + R = [X1,X2] + ; + X1 == X2 + -> + R = [X1] + ; + R = [X2,X1] + ). +$bp_sort2(_, 1, [X|L], L, [X]) :- !. +$bp_sort2(_, 0, L, L, []) :- !. +$bp_sort2(P, N, L1, L3, R) :- + N1 is N // 2, + plus(N1, N2, N), + $bp_sort(P, N1, L1, L2, R1), + $bp_sort(P, N2, L2, L3, R2), + $bp_predmerge(P, R1, R2, R). + +$bp_predmerge2(_, [], R, R) :- !. +$bp_predmerge2(_, R, [], R) :- !. +$bp_predmerge2(P, [H1|T1], [H2|T2], [H1|Result]) :- + call(P, H1, H2), !, + $bp_predmerge(P, T1, [H2|T2], Result). +$bp_predmerge2(P, [H1|T1], [H2|T2], [H1|Result]) :- + H1 == H2, !, + $bp_predmerge(P, T1, T2, Result). +$bp_predmerge2(P, [H1|T1], [H2|T2], [H2|Result]) :- + $bp_predmerge(P, [H1|T1], T2, Result). diff --git a/library/dialect/bprolog/actionrules.pl b/library/dialect/bprolog/actionrules.pl index cf8c95c13..a8589cb59 100644 --- a/library/dialect/bprolog/actionrules.pl +++ b/library/dialect/bprolog/actionrules.pl @@ -33,6 +33,7 @@ :- module(actionrules,[op(1200,xfx,=>), op(1200,xfx,?=>), op(1000,xfy,:::), + op(900,xfy,<=), post/1, post_event/2, post_event_df/2, @@ -42,6 +43,8 @@ :- use_module(library(lists)). +:- dynamic ar_term/2, extra_ar_term/2. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % the built-ins and the preds needed in the transformation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -332,7 +335,8 @@ ar_translate([AR|ARs],Module,Program,Errors) :- get_head(AR,ARHead), collect_ars_same_head(ARs,ARHead,ActionPredRest,RestARs), ars2p([AR|ActionPredRest],det,ARHead,Program,Errors,TailProgram,TailErrors), - ar_translate(RestARs,Module,TailProgram,TailErrors). + extra_ars(AR, TailProgram, NTailProgram), + ar_translate(RestARs,Module,NTailProgram,TailErrors). nondet_ar_translate([],_,Program,Program,[]). nondet_ar_translate([AR|ARs],Module,Program,EndProgram,Errors) :- @@ -375,6 +379,20 @@ ar_expand(Term, []) :- prolog_load_context(file,File), get_arinfo(Term,ARInfo,_), assert(nondet_ar_term(File,ARInfo)). +ar_expand(Term, []) :- + Term = (Head :- Body ), + prolog_load_context(file,File), + functor(Head, Na, Ar), + functor(Empty, Na, Ar), + ar_term(File,ar(Empty,_,_,_)), !, + assert(extra_ar_term(File,ar(Head, Body))). +ar_expand(Head, []) :- + prolog_load_context(file,File), + functor(Head, Na, Ar), + functor(Empty, Na, Ar), + ar_term(File,ar(Empty,_,_,_)), !, + assert(extra_ar_term(File,ar(Head, true))). + ar_expand(end_of_file, FinalProgram) :- prolog_load_context(file,File), compile_ar(File, DetProgram), @@ -405,6 +423,12 @@ compile_nondet_ar(File, FinalProgram, StartProgram) :- report_errors(Errors) :- throw(action_rule_error(Errors)). % for now +extra_ars(ar(Head,_,_,_), LF, L0) :- + functor(Head, N, A), + functor(Empty, N, A), + findall((Empty :- B), extra_ar_term(_,ar(Empty, B)), LF, L0). + + /******************************* * MUST BE LAST! * *******************************/ diff --git a/library/dialect/bprolog/arrays.yap b/library/dialect/bprolog/arrays.yap index 43a319ff4..88dd2ee33 100644 --- a/library/dialect/bprolog/arrays.yap +++ b/library/dialect/bprolog/arrays.yap @@ -1,5 +1,5 @@ -:- module(bparrays, [new_array/2, a2_new/3, a3_new/4. is_array/1, '$aget'/3]). +:- module(bparrays, [new_array/2, a2_new/3, a3_new/4, is_array/1, '$aget'/3]). :- use_module(library(lists), [flatten/2]). diff --git a/library/dialect/bprolog/fli/bprolog.h b/library/dialect/bprolog/fli/bprolog.h index 4ee3b7676..f25d6e8db 100644 --- a/library/dialect/bprolog/fli/bprolog.h +++ b/library/dialect/bprolog/fli/bprolog.h @@ -1,5 +1,10 @@ +#ifndef BPROLOG_H + +#define BPROLOG_H 1 + #include +#include typedef YAP_Term TERM; typedef YAP_Int BPLONG; @@ -31,10 +36,10 @@ typedef BPLONG *BPLONG_PTR; #define bp_is_structure(t) YAP_IsApplTerm(t) //extern int bp_is_compound(TERM t) -#define bp_is_compound(t) ( YAP_IsApplTerm(t) || YAP_IsPairTerm(t) ) +#define bp_is_compound(t) YAP_IsCompoundTerm(t) //extern int bp_is_unifiable(TERM t1, Term t2) -#define bp_is_unifiable(t1, t2) YAP_unifiable_NOT_IMPLEMENTED(t1, t2) +#define bp_is_unifiable(t1, t2) YAP_unifiable(t1, t2) //extern int bp_is_identical(TERM t1, Term t2) #define bp_is_identical(t1, t2) YAP_ExactlyEqual(t1, t2) @@ -81,10 +86,10 @@ bp_get_arity(TERM t) #define bp_get_arg(i, t) YAP_ArgOfTerm(i, t) //TERM bp_get_car(Term t) -#define bp_get_car(t) YAP_HeadOfTerm(i, t) +#define bp_get_car(t) YAP_HeadOfTerm(t) //TERM bp_get_cdr(Term t) -#define bp_get_cdr(t) YAP_TailOfTerm(i, t) +#define bp_get_cdr(t) YAP_TailOfTerm(t) // void bp_write(TERM t) #define bp_write(t) YAP_WriteTerm(t, NULL, 0) @@ -99,7 +104,7 @@ bp_get_arity(TERM t) #define bp_build_float(f) YAP_MkFloatTerm(f) // TERM bp_build_atom(char *name) -#define bp_build_atom(name) YAP_MkAtomTerm(YAP_LookupAtom(name)) +#define bp_build_atom(name) YAP_MkAtomTerm(YAP_LookupAtom((name))) // TERM bp_build_nil() #define bp_build_nil() YAP_TermNil() @@ -114,29 +119,51 @@ bp_get_arity(TERM t) #define bp_insert_pred(name, arity, func) YAP_UserCPredicate(name, func, arity) // int bp_call_string(char *goal) -#define bp_call_string(goal) YAP_RunGoal(YAP_ReadBuffer(goal, NULL)) +extern inline int +bp_call_string(const char *goal) { + return YAP_RunGoal(YAP_ReadBuffer(goal, NULL)); +} // int bp_call_term(TERM goal) -#define bp_call_term(goal) YAP_RunGoal(goal) +extern inline int +bp_call_term(TERM t) { + return YAP_RunGoal(t); +} -// void bp_mount_query_string(char *goal) -#define bp_mount_query_string(goal) bp_t = YAP_ReadBuffer(goal, NULL); +#define TOAM_NOTSET 0L -// void bp_mount_query_term(TERM goal) -// #define bp_mount_query_term(goal) bp_t = t; +#define curr_out stdout -TERM bp_t; +#define BP_ERROR (-1) + +#define INTERRUPT 0x2L + +#define exception YAP_BPROLOG_exception +#define curr_toam_status YAP_BPROLOG_curr_toam_status + +extern YAP_Term YAP_BPROLOG_curr_toam_status; +extern YAP_Int YAP_BPROLOG_exception; // TERM bp_next_solution() -static int bp_next_solution(void) +extern inline int bp_next_solution(void) { - if (bp_t) { - TERM goal = bp_t; - bp_t = 0L; + if (curr_toam_status) { + TERM goal = curr_toam_status; + curr_toam_status = TOAM_NOTSET; return YAP_RunGoal(goal); } return YAP_RestartGoal(); } +// void bp_mount_query_string(char *goal) +#define bp_mount_query_string(goal) (curr_toam_status = YAP_ReadBuffer(goal, NULL)) +// void bp_mount_query_term(TERM goal) +extern inline int +bp_mount_query_term(TERM goal) +{ + curr_toam_status = goal; + return TRUE; +} +#endif /* BPROLOG_H */ diff --git a/library/dialect/bprolog/hashtable.yap b/library/dialect/bprolog/hashtable.yap index 983b5a69b..8cacf7cca 100644 --- a/library/dialect/bprolog/hashtable.yap +++ b/library/dialect/bprolog/hashtable.yap @@ -1,3 +1,5 @@ +%% -*- Prolog -*- + :- module(bphash, [new_hashtable/1, new_hashtable/2, is_hashtable/1, @@ -12,7 +14,7 @@ :- use_module(library(bhash), [b_hash_new/2, is_b_hash/1, b_hash_lookup/3, - b_hash_insert/3, + b_hash_insert/4, b_hash_size/2, b_hash_to_list/2, b_hash_values_to_list/2, @@ -31,19 +33,20 @@ hashtable_get(Hash, Key, Value) :- b_hash_lookup(Key, Value, Hash). hashtable_put(Hash, Key, Value) :- - b_hash_insert(Key, Value, Hash). + b_hash_insert(Hash, Key, Value, Hash). hashtable_register(Hash, Key, Value) :- b_hash_lookup(Key, Value0, Hash), !, Value0 = Value. hashtable_register(Hash, Key, Value) :- - b_hash_insert(Hash, Key, Value). + b_hash_insert(Hash, Key, Value, Hash). hashtable_size(Hash, Size) :- b_hash_size(Hash, Size). hashtable_to_list(Hash, List) :- - b_hash_to_list(Hash, List). + b_hash_to_list(Hash, List0), + keylist_to_bp(List0, List). hashtable_keys_to_list(Hash, List) :- b_hash_keys_to_list(Hash, List). @@ -51,6 +54,10 @@ hashtable_keys_to_list(Hash, List) :- hashtable_values_to_list(Hash, List) :- b_hash_values_to_list(Hash, List). +keylist_to_bp([], []). +keylist_to_bp((X-Y).List0, (X=Y).List) :- + keylist_to_bp(List0, List). +