update bprolog emulation stuff.
This commit is contained in:
Vítor Santos Costa
parent
5ce8d637ef
commit
1d2de81e86
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -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! *
|
||||
*******************************/
|
||||
|
|
|
|||
|
|
@ -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]).
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,10 @@
|
|||
|
||||
#ifndef BPROLOG_H
|
||||
|
||||
#define BPROLOG_H 1
|
||||
|
||||
#include <YapInterface.h>
|
||||
#include <math.h>
|
||||
|
||||
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 */
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Reference in New Issue