diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix string_concat/2

Browse Source
This commit is contained in:
Vítor Santos Costa 2014-04-09 12:39:29 +01:00
parent 8b9da05d66
commit a8c77d2609
50 changed files with 927 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
C/atomic.c
View File

@ -808,6 +808,53 @@ p_atom_concat2( USES_REGS1 )
cut_fail();
}
static Int
p_string_concat2( USES_REGS1 )
{
Term t1;
Term *tailp;
Int n;
restart_aux:
t1 = Deref(ARG1);
n = Yap_SkipList(&t1, &tailp);
if (*tailp != TermNil) {
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else {
seq_tv_t *inpv = (seq_tv_t *)malloc(n*sizeof(seq_tv_t)), out;
int i = 0;
if (!inpv) {
LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR;
free(inpv);
goto error;
}
while (t1 != TermNil) {
inpv[i].type = YAP_STRING_STRING;
inpv[i].val.t = HeadOfTerm(t1);
i++;
t1 = TailOfTerm(t1);
}
out.type = YAP_STRING_STRING;
if (!Yap_Concat_Text(n, inpv, &out PASS_REGS)) {
free(inpv);
goto error;
}
free(inpv);
if (out.val.t) return Yap_unify(ARG2, out.val.t);
}
error:
/* Error handling */
if (LOCAL_Error_TYPE) {
if (Yap_HandleError( "string_code/3" )) {
goto restart_aux;
} else {
return FALSE;
}
}
cut_fail();
}
static Int
p_atomic_concat2( USES_REGS1 )
@ -1929,6 +1976,7 @@ Yap_InitAtomPreds(void)
Yap_InitCPred("atom_number", 2, p_atom_number, 0);
Yap_InitCPred("string_number", 2, p_string_number, 0);
Yap_InitCPred("$atom_concat", 2, p_atom_concat2, 0);
Yap_InitCPred("$string_concat", 2, p_string_concat2, 0);
Yap_InitCPred("atomic_concat", 2, p_atomic_concat2, 0);
Yap_InitCPred("atomic_concat", 3, p_atomic_concat3, 0);
Yap_InitCPred("atomics_to_string", 2, p_atomics_to_string2, 0);

3
C/index.c
View File

@ -4589,7 +4589,8 @@ remove_dirty_clauses_from_index(yamop *header)
curp->opc = startopc;
if (curp->opc == endop)
return;
if (!header->u.Illss.e)
// don't try to follow the chain if there is no chain.
if (header->u.Illss.e <= 1)
return;
previouscurp = curp;
curp = curp->u.OtaLl.n;

15
C/sysbits.c
View File

@ -2086,21 +2086,28 @@ Run an external command and wait for its completion.
char *shell;
register int bourne = FALSE;
Term t1 = Deref (ARG1);
const char *cmd;
shell = (char *) getenv ("SHELL");
if (!strcmp (shell, "/bin/sh"))
bourne = TRUE;
if (shell == NIL)
bourne = TRUE;
if (IsAtomTerm(t1))
cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
else if (IsStringTerm(t1))
cmd = StringOfTerm(t1);
else
return FALSE;
/* Yap_CloseStreams(TRUE); */
if (bourne)
return system(RepAtom(AtomOfTerm(t1))->StrOfAE) == 0;
return system( cmd ) == 0;
else {
int status = -1;
int child = fork ();
if (child == 0) { /* let the children go */
if (!execl (shell, shell, "-c", RepAtom(AtomOfTerm(t1))->StrOfAE , NULL)) {
if (!execl (shell, shell, "-c", cmd , NULL)) {
exit(-1);
}
exit(TRUE);
@ -2182,13 +2189,15 @@ Run an external command and wait for its completion.
return FALSE;
#elif HAVE_SYSTEM
Term t1 = Deref (ARG1);
char *s;
const char *s;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"argument to system/1 unbound");
return FALSE;
} else if (IsAtomTerm(t1)) {
s = RepAtom(AtomOfTerm(t1))->StrOfAE;
} else if (IsStringTerm(t1)) {
s = StringOfTerm(t1);
} else {
if (!Yap_GetName (LOCAL_FileNameBuf, YAP_FILENAME_MAX, t1)) {
Yap_Error(TYPE_ERROR_ATOM,t1,"argument to system/1");

23
pl/absf.yap
View File

@ -15,13 +15,19 @@
* *
*************************************************************************/
:- module( absolute_file_name, [ absolute_file_name/2,
absolute_file_name/3,
'$full_filename'/3,
'$system_library_directories'/2,
path/1,
add_to_path/1,
remove_from_path/1] ).
:- system_module( '$_absf', [absolute_file_name/2,
absolute_file_name/3,
add_to_path/1,
add_to_path/2,
path/1,
remove_from_path/1], ['$full_filename'/3,
'$system_library_directories'/2]).
:- use_system_module( '$_boot', ['$system_catch'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_lists', [member/2]).
/**
*
@ -39,9 +45,6 @@
*/
:- use_module( library(lists) , [member/2] ).
/**
@predicate absolute_file_name(+<var>Name</var>:atom,+<var>Options</var>:list) is nondet

26
pl/arith.yap
View File

@ -15,18 +15,24 @@
* *
*************************************************************************/
/*
:- module( '$arithmetic' , [ expand_exprs/2,
compile_expressions/0,
do_not_compile_expressions/0,
'$c_built_in'/3,
succ/3,
plus/3] ).
*/
% the default mode is on
:- system_module( '$_arith', [compile_expressions/0,
expand_exprs/2,
plus/3,
succ/2], ['$c_built_in'/3]).
:- private( [do_c_built_in/3,
do_c_built_metacall/3,
expand_expr/3,
expand_expr/5,
expand_expr/6] ).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_modules', ['$clean_cuts'/2]).
expand_exprs(Old,New) :-
(get_value('$c_arith',true) ->
Old = on ;

6
pl/arrays.yap
View File

@ -15,12 +15,6 @@
* *
*************************************************************************/
:- module( '$arrays',
[array/2,
'$c_arrays'/2,
static_array_properties/3] ).
%
% These are the array built-in predicates. They will only work if
% YAP_ARRAYS is defined in Yap.h.m4.

55
pl/atoms.yap
View File

@ -8,15 +8,19 @@
* *
*************************************************************************/
:- system_module( '$_atoms', [
atom_concat/2,
string_concat/2,
atomic_list_concat/2,
atomic_list_concat/3,
current_atom/1], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
/**
* @short: Atom, and Atomic manipulation predicates in YAP
*
*/ *
:- module( '$atoms', [ atom_concat/2,
atomic_list_concat/2,
atomic_list_concat/3,
current_atom/1 ] ).
*/
atom_concat(Xs,At) :-
( var(At) ->
@ -122,3 +126,42 @@ current_atom(A) :- % generate
current_atom(A) :- % generate
'$current_wide_atom'(A).
string_concat(Xs,At) :-
( var(At) ->
'$string_concat'(Xs, At )
;
'$string_concat_constraints'(Xs, 0, At, Unbound),
'$process_string_holes'(Unbound)
).
% the constraints are of the form hole: HoleString, Begin, String, End
'$string_concat_constraints'([At], 0, At, []) :- !.
'$string_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :- !.
% just slice first string
'$string_concat_constraints'([At0|Xs], 0, At, Unbound) :-
string(At0), !,
sub_string(At, 0, Sz, L, At0 ),
sub_string(At, _, L, 0, Atr ), %remainder
'$string_concat_constraints'(Xs, 0, Atr, Unbound).
% first hole: Follow says whether we have two holes in a row, At1 will be our string
'$string_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
'$string_concat_constraints'(Xs, mid(Next,At1), At, Unbound).
% end of a run
'$string_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
string(At0), !,
sub_string(At, Next, Sz, L, At0),
sub_string(At, 0, Next, Next, At1),
sub_string(At, _, L, 0, Atr), %remainder
'$string_concat_constraints'(Xs, 0, Atr, Unbound).
'$string_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
'$string_concat_constraints'(Xs, mid(NextFollow, At1), At, Unbound).
'$process_string_holes'([]).
'$process_string_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
sub_string(At1, Next, _, 0, At0),
'$process_string_holes'(Unbound).
'$process_string_holes'([hole(At0, Next, At1, Follow)|Unbound]) :-
sub_string(At1, Next, Sz, _Left, At0),
Follow is Next+Sz,
'$process_string_holes'(Unbound).

20
pl/attributes.yap
View File

@ -19,6 +19,26 @@
delayed_goals/4
]).
:- use_system_module( '$_boot', ['$undefp'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$coroutining', [attr_unify_hook/2]).
:- use_system_module( attributes, [all_attvars/1,
attributed_module/3,
bind_attvar/1,
del_all_atts/1,
del_all_module_atts/2,
get_all_swi_atts/2,
get_module_atts/2,
modules_with_attributes/1,
put_att_term/2,
put_module_atts/2,
unbind_attvar/1,
woken_att_do/4]).
:- dynamic attributes:attributed_module/3, attributes:modules_with_attributes/1.
prolog:get_attr(Var, Mod, Att) :-

130
pl/boot.yap
View File

@ -4,7 +4,7 @@
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 *
* *
**************************************************************************
* *
@ -15,6 +15,112 @@
* *
*************************************************************************/
system_module(_init, _SysExps, _Decls) :- !.
system_module(M, SysExps, Decls) :-
'$current_module'(prolog, M),
'$compile'( ('$system_module'(M) :- true), 0, assert_static('$system_module'(M)), M ),
'$export_preds'(SysExps, prolog),
'$export_preds'(Decls, M).
'$export_preds'([], _).
'$export_preds'([N/A|Decls], M) :-
functor(S, N, A),
'$sys_export'(S, M),
'$export_preds'(Decls, M).
use_system_module(_init, _SysExps) :- !.
use_system_module(M, SysExps) :-
'$current_module'(M0, M0),
'$import_system'(SysExps, M0, M).
'$import_system'([], _, _).
'$import_system'([N/A|Decls], M0, M) :-
functor(S, N, A),
'$compile'( (G :- M0:G) ,0, assert_static((M:G :- M0:G)), M ),
'$import_system'(Decls, M0, M).
private(_).
%
% boootstrap predicates.
%
:- system_module( '$_boot', [(*->)/2,
(',')/2,
(->)/2,
(;)/2,
(\+)/1,
bootstrap/1,
call/1,
catch/3,
catch_ball/2,
expand_term/2,
import_system_module/2,
incore/1,
(not)/1,
repeat/0,
throw/1,
true/0,
('|')/2], ['$$compile'/4,
'$call'/4,
'$catch'/3,
'$check_callable'/2,
'$check_head_and_body'/4,
'$check_if_reconsulted'/2,
'$clear_reconsulting'/0,
'$command'/4,
'$cut_by'/1,
'$disable_debugging'/0,
'$do_live'/0,
'$enable_debugging'/0,
'$find_goal_definition'/4,
'$handle_throw'/3,
'$head_and_body'/3,
'$inform_as_reconsulted'/2,
'$init_system'/0,
'$init_win_graphics'/0,
'$live'/0,
'$loop'/2,
'$meta_call'/2,
'$prompt_alternatives_on'/1,
'$run_at_thread_start'/0,
'$system_catch'/4,
'$undefp'/1,
'$version'/0]).
:- use_system_module( '$_absf', ['$system_library_directories'/2]).
:- use_system_module( '$_checker', ['$check_term'/5,
'$sv_warning'/2]).
:- use_system_module( '$_consult', ['$csult'/2]).
:- use_system_module( '$_control', ['$run_atom_goal'/1]).
:- use_system_module( '$_directives', ['$all_directives'/1,
'$exec_directives'/5]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_grammar', ['$translate_rule'/2]).
:- use_system_module( '$_modules', ['$get_undefined_pred'/4,
'$meta_expansion'/6,
'$module_expansion'/5]).
:- use_system_module( '$_preddecls', ['$dynamic'/2]).
:- use_system_module( '$_preds', ['$assert_static'/5,
'$assertz_dynamic'/4,
'$init_preds'/0,
'$unknown_error'/1,
'$unknown_warning'/1]).
:- use_system_module( '$_qly', ['$init_state'/0]).
:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1,
'$iso_check_goal'/2]).
%
%
%
@ -1097,28 +1203,6 @@ bootstrap(F) :-
'$abort_loop'(Stream) :-
'$do_error'(permission_error(input,closed_stream,Stream), loop).
system_module(M, SysExps, Decls) :-
'$current_module'(prolog, M), !,
'$export_preds'(SysExps, prolog),
'$export_preds'(Decls, M).
'$export_preds'([], _).
'$export_preds'([N/A|Decls], M) :-
functor(S, N, A),
'$sys_export'(S, M),
'$export_preds'(Decls, M).
import_system_module(M, SysExps) :-
'$current_module'(M0, _M),
'$import_system'(SysExps, M0, M).
'$import_system'([], _, _).
'$import_system'([N/A|Decls], M0, M) :-
functor(S, N, A),
'$assert_static'((G :- M0:G), M, last, _, assert_static((M:G :- M0:G))),
'$import_system'(Decls, M0, M).
/* General purpose predicates */

7
pl/callcount.yap
View File

@ -15,6 +15,13 @@
* *
*************************************************************************/
:- system_module( '$_callcount', [call_count/3,
call_count_data/3,
call_count_reset/0], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
call_count_data(Calls, Retries, Both) :-
'$call_count_info'(Calls, Retries, Both).

8
pl/checker.yap
View File

@ -62,6 +62,14 @@
* *
*************************************************************************/
:- system_module( '$_checker', [no_style_check/1,
style_check/1], ['$check_term'/5,
'$init_style_check'/1,
'$sv_warning'/2,
'$syntax_check_discontiguous'/2,
'$syntax_check_multiple'/2,
'$syntax_check_single_var'/2]).
%
% A Small style checker for YAP

2
pl/chtypes.yap
View File

@ -15,6 +15,8 @@
* *
*************************************************************************/
:- system_module( '$_chtypes', [], []).
/*
In addition, there is the library library(ctype) providing compatibility to some other Prolog systems. The predicates of this library are defined in terms of code_type/2.

51
pl/consult.yap
View File

@ -14,6 +14,57 @@
* comments: Consulting Files in YAP *
* *
*************************************************************************/
:- system_module( '$_consult', [compile/1,
consult/1,
db_files/1,
ensure_loaded/1,
exists_source/1,
exo_files/1,
(initialization)/2,
load_files/2,
make/0,
make_library_index/1,
module/2,
prolog_load_context/2,
reconsult/1,
source_file/1,
source_file/2,
source_file_property/2,
use_module/3], ['$add_multifile'/3,
'$csult'/2,
'$do_startup_reconsult'/1,
'$elif'/2,
'$else'/1,
'$endif'/1,
'$if'/2,
'$include'/2,
'$initialization'/1,
'$initialization'/2,
'$lf_opt'/3,
'$load_files'/3,
'$require'/2,
'$set_encoding'/1,
'$use_module'/3]).
:- use_system_module( '$_absf', ['$full_filename'/3]).
:- use_system_module( '$_boot', ['$clear_reconsulting'/0,
'$init_system'/0,
'$init_win_graphics'/0,
'$loop'/2,
'$system_catch'/4]).
:- use_system_module( '$_checker', ['$init_style_check'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_load_foreign', ['$import_foreign'/3]).
:- use_system_module( '$_modules', ['$add_to_imports'/3,
'$convert_for_export'/7,
'$extend_exports'/3]).
:- use_system_module( '$_preds', ['$current_predicate_no_modules'/3]).
%
% SWI options

53
pl/control.yap
View File

@ -15,6 +15,59 @@
* *
*************************************************************************/
:- system_module( '$_control', [at_halt/1,
b_getval/2,
break/0,
call/2,
call/3,
call/4,
call/5,
call/6,
call/7,
call/8,
call/9,
call/10,
call/11,
call/12,
call_cleanup/2,
call_cleanup/3,
forall/2,
garbage_collect/0,
garbage_collect_atoms/0,
gc/0,
grow_heap/1,
grow_stack/1,
halt/0,
halt/1,
if/3,
ignore/1,
nb_getval/2,
nogc/0,
notrace/1,
once/1,
prolog_current_frame/1,
prolog_initialization/1,
setup_call_catcher_cleanup/4,
setup_call_cleanup/3,
version/0,
version/1], ['$run_atom_goal'/1,
'$set_toplevel_hook'/1]).
:- use_system_module( '$_boot', ['$call'/4,
'$disable_debugging'/0,
'$do_live'/0,
'$enable_debugging'/0,
'$system_catch'/4,
'$version'/0]).
:- use_system_module( '$_debug', ['$init_debugger'/0]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_utils', ['$getval_exception'/3]).
:- use_system_module( '$coroutining', [freeze_goal/2]).
once(G) :- '$execute'(G), !.
forall(Cond, Action) :- \+((Cond, \+(Action))).

7
pl/corout.yap
View File

@ -25,6 +25,13 @@
%frozen/2
]).
:- use_system_module( '$_boot', ['$$compile'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( attributes, [get_module_atts/2,
put_module_atts/2]).
attr_unify_hook(DelayList, _) :-
wake_delays(DelayList).

7
pl/dbload.yap
View File

@ -18,6 +18,13 @@
:- module('$db_load',
[]).
:- use_system_module( '$_boot', ['$$compile'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( attributes, [get_module_atts/2,
put_module_atts/2]).
:- dynamic dbloading/6, dbprocess/2.
dbload_from_stream(R, M0, Type) :-

24
pl/debug.yap
View File

@ -15,6 +15,30 @@
* *
*************************************************************************/
:- system_module( '$_debug', [debug/0,
debugging/0,
leash/1,
nodebug/0,
(nospy)/1,
nospyall/0,
notrace/0,
(spy)/1,
trace/0], ['$do_spy'/4,
'$init_debugger'/0,
'$skipeol'/1]).
:- use_system_module( '$_boot', ['$find_goal_definition'/4,
'$system_catch'/4]).
:- use_system_module( '$_errors', ['$Error'/1,
'$do_error'/2]).
:- use_system_module( '$_init', ['$system_module'/1]).
:- use_system_module( '$_modules', ['$meta_expansion'/6]).
:- use_system_module( '$_preds', ['$clause'/4]).
/*-----------------------------------------------------------------------------
Debugging / creating spy points

2
pl/depth_bound.yap
View File

@ -15,6 +15,8 @@
* *
*************************************************************************/
:- system_module( '$_depth_bound', [depth_bound_call/2], []).
%depth_bound_call(A,D) :-
%write(depth_bound_call(A,D)), nl, fail.
depth_bound_call(A,D) :-

1
pl/dialect.yap
View File

@ -4,6 +4,7 @@
source_exports/2
]).
:- use_system_module( '$_errors', ['$do_error'/2]).
prolog:'$expects_dialect'(yap) :- !,
eraseall('$dialect'),

31
pl/directives.yap
View File

@ -15,6 +15,37 @@
* *
*************************************************************************/
:- system_module( '$_directives', [user_defined_directive/2], ['$all_directives'/1,
'$exec_directives'/5]).
:- use_system_module( '$_boot', ['$command'/4,
'$system_catch'/4]).
:- use_system_module( '$_consult', ['$elif'/2,
'$else'/1,
'$endif'/1,
'$if'/2,
'$include'/2,
'$initialization'/1,
'$initialization'/2,
'$load_files'/3,
'$require'/2,
'$set_encoding'/1,
'$use_module'/3]).
:- use_system_module( '$_modules', ['$meta_predicate'/2,
'$module'/3,
'$module'/4,
'$module_transparent'/2]).
:- use_system_module( '$_preddecls', ['$discontiguous'/2,
'$dynamic'/2]).
:- use_system_module( '$_preds', ['$noprofile'/2,
'$public'/2]).
:- use_system_module( '$_threads', ['$thread_local'/2]).
'$all_directives'(_:G1) :- !,
'$all_directives'(G1).
'$all_directives'((G1,G2)) :- !,

3
pl/eam.yap
View File

@ -16,6 +16,9 @@
* *
*************************************************************************/
:- system_module( '$_eam', [eamconsult/1,
eamtrans/2], []).
eamtrans(A,A):- var(A),!.
eamtrans((A,B),(C,D)):- !, eamtrans(A,C),eamtrans(B,D).
eamtrans((X is Y) ,(skip_while_var(Vars), X is Y )):- !, '$variables_in_term'(Y,[],Vars).

9
pl/errors.yap
View File

@ -194,6 +194,15 @@
* *
*************************************************************************/
:- system_module( '$_errors', [message_to_string/2,
print_message/2], ['$Error'/1,
'$do_error'/2]).
:- use_system_module( '$messages', [file_location/2,
generate_message/3,
translate_message/3]).
'$do_error'(Type,Message) :-
'$current_stack'(local_sp(_,CP,Envs,CPs)),
throw(error(Type,[Message|local_sp(Message,CP,Envs,CPs)])).

6
pl/eval.yap
View File

@ -15,6 +15,12 @@
* *
*************************************************************************/
:- system_module( '$_eval', [], ['$full_clause_optimisation'/4]).
:- use_system_module( terms, [new_variables_in_term/3,
variables_within_term/3]).
%, portray_clause((H:-BF))
'$full_clause_optimisation'(H, M, B0, BF) :-
'$localise_vars_opt'(H, M, B0, BF), !.

23
pl/flags.yap
View File

@ -15,6 +15,29 @@
* *
*************************************************************************/
:- system_module( '$_flags', [create_prolog_flag/3,
current_prolog_flag/2,
no_source/0,
prolog_flag/2,
prolog_flag/3,
set_prolog_flag/2,
source/0,
source_mode/2,
yap_flag/2,
yap_flag/3], []).
:- use_system_module( '$_boot', ['$prompt_alternatives_on'/1]).
:- use_system_module( '$_checker', ['$syntax_check_discontiguous'/2,
'$syntax_check_multiple'/2,
'$syntax_check_single_var'/2]).
:- use_system_module( '$_control', ['$set_toplevel_hook'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_yio', ['$default_expand'/1,
'$set_default_expand'/1]).
yap_flag(V,Out) :-
'$user_defined_flag'(V,_,_,_),

22
pl/grammar.yap
View File

@ -15,6 +15,22 @@
* *
*************************************************************************/
:- system_module( '$_grammar', [!/2,
(',')/4,
(->)/4,
('.')/4,
(;)/4,
'C'/3,
[]/2,
[]/4,
(\+)/3,
phrase/2,
phrase/3,
{}/3,
('|')/4], ['$translate_rule'/2]).
:- use_system_module( '$_errors', ['$do_error'/2]).
% :- meta_predicate ^(?,0,?).
% ^(Xs, Goal, Xs) :- call(Goal).
@ -55,6 +71,9 @@
'$t_hlist'(V, _, _, _, G0) :- var(V), !,
'$do_error'(instantiation_error,G0).
'$t_hlist'([], _, _, true, _).
'$t_hlist'(String, S0, SR, SF, G0) :- string(String), !,
string_codes( String, X ),
'$t_hlist'( X, S0, SR, SF, G0).
'$t_hlist'([H], S0, SR, ('C'(SR,H,S0)), _) :- !.
'$t_hlist'([H|List], S0, SR, ('C'(SR,H,S1),G0), Goal) :- !,
'$t_hlist'(List, S0, S1, G0, Goal).
@ -75,6 +94,9 @@
'$t_body'(!, _, _, S, S, !) :- !.
'$t_body'([], to_fill, last, S, S1, S1=S) :- !.
'$t_body'([], _, _, S, S, true) :- !.
'$t_body'(X, FilledIn, Last, S, SR, OS) :- string(X), !,
string_codes( X, Codes),
'$t_body'(Codes, FilledIn, Last, S, SR, OS).
'$t_body'([X], filled_in, _, S, SR, 'C'(S,X,SR)) :- !.
'$t_body'([X|R], filled_in, Last, S, SR, ('C'(S,X,SR1),RB)) :- !,
'$t_body'(R, filled_in, Last, SR1, SR, RB).

8
pl/history.pl
View File

@ -29,6 +29,12 @@
the GNU General Public License.
*/
:- module('$history',
[ read_history/6,
'$clean_history'/0,
'$save_history'/1
]).
%% read_history(+History, +Help, +DontStore, +Prompt, -Term, -Bindings)
%
% Give a prompt using Prompt. The sequence '%w' is substituted with the
@ -43,7 +49,7 @@
% call Goal and pretend it has not seen anything. This hook is used
% by the GNU-Emacs interface to for communication between GNU-EMACS
% and SWI-Prolog.
read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
prolog:read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
repeat,
prompt_history(Prompt),
catch('$raw_read'(user_input, Raw), E,

27
pl/init.yap
View File

@ -15,6 +15,27 @@
* *
*************************************************************************/
:- system_module( '$_init', [!/0,
(:-)/1,
(?-)/1,
[]/0,
extensions_to_present_answer/1,
fail/0,
false/0,
goal_expansion/2,
goal_expansion/3,
otherwise/0,
prolog_booting/0,
term_expansion/2,
version/2,
'$do_log_upd_clause'/6,
'$do_log_upd_clause0'/6,
'$do_log_upd_clause_erase'/6,
'$do_static_clause'/5,
'$system_module'/1], []).
:- use_system_module( '$_boot', ['$cut_by'/1]).
'prolog_booting'.
% This is yap's init file
@ -145,12 +166,6 @@ version(yap,[6,3]).
:- use_module('../swi/library/menu.pl').
'$system_module'('$attributes').
'$system_module'('$coroutining').
'$system_module'('$hacks').
'$system_module'('$history').
'$system_module'('$messages').
'$system_module'('$predopts').
'$system_module'('$swi').
'$system_module'('$win_menu').

10
pl/listing.yap
View File

@ -15,6 +15,16 @@
* *
*************************************************************************/
:- system_module( '$_listing', [listing/0,
listing/1,
portray_clause/1,
portray_clause/2], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_preds', ['$clause'/4,
'$current_predicate_no_modules'/3]).
/* listing : Listing clauses in the database
*/

14
pl/lists.yap
View File

@ -1,4 +1,6 @@
:- system_module( '$_lists', [], []).
:- '$set_yap_flags'(11,1). % source.
% memberchk(+Element, +Set)
@ -26,3 +28,15 @@ lists:append([H|T], L, [H|R]) :-
:- '$set_yap_flags'(11,0). % :- no_source.
% lists:delete(List, Elem, Residue)
% is true when List is a list, in which Elem may or may not occur, and
% Residue is a copy of List with all elements identical to Elem lists:deleted.
lists:delete([], _, []).
lists:delete([Head|List], Elem, Residue) :-
Head == Elem, !,
lists:delete(List, Elem, Residue).
lists:delete([Head|List], Elem, [Head|Residue]) :-
lists:delete(List, Elem, Residue).

8
pl/load_foreign.yap
View File

@ -15,6 +15,14 @@
* *
*************************************************************************/
:- system_module( '$_load_foreign', [load_foreign_files/3,
open_shared_object/2,
open_shared_object/3], ['$import_foreign'/3]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_modules', ['$do_import'/3]).
load_foreign_files(_Objs,_Libs,_Entry) :-
prolog_load_context(file, F),
prolog_load_context(module, M),

2
pl/messages.yap
View File

@ -23,6 +23,8 @@
file_location/3,
message/3]).
:- use_system_module( user, [generate_message_hook/3]).
:- multifile message/3.
:- multifile user:generate_message_hook/3.

44
pl/modules.yap
View File

@ -14,7 +14,49 @@
* comments: module support *
* *
*************************************************************************/
% module handling
:- system_module( '$_modules', [abolish_module/1,
add_import_module/3,
current_module/1,
current_module/2,
delete_import_module/2,
expand_goal/2,
export/1,
export_list/2,
export_resource/1,
import_module/2,
ls_imports/0,
module/1,
module_property/2,
set_base_module/1,
source_module/1,
use_module/1,
use_module/2], ['$add_to_imports'/3,
'$clean_cuts'/2,
'$convert_for_export'/7,
'$do_import'/3,
'$extend_exports'/3,
'$get_undefined_pred'/4,
'$imported_pred'/4,
'$meta_expansion'/6,
'$meta_predicate'/2,
'$meta_predicate'/4,
'$module'/3,
'$module'/4,
'$module_expansion'/5,
'$module_transparent'/2,
'$module_transparent'/4]).
:- use_system_module( '$_arith', ['$c_built_in'/3]).
:- use_system_module( '$_consult', ['$lf_opt'/3,
'$load_files'/3]).
:- use_system_module( '$_debug', ['$skipeol'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_eval', ['$full_clause_optimisation'/4]).
:- '$purge_clauses'(module(_,_), prolog).
:- '$purge_clauses'('$module'(_,_), prolog).

3
pl/os.yap
View File

@ -19,6 +19,7 @@
getenv/2,
setenv/2
] ).
:- use_system_module( '$_errors', ['$do_error'/2]).
/**
* @short YAP core Operating system interface.
@ -75,11 +76,13 @@ unix(getcwd(X)) :- getcwd(X).
unix(shell(V)) :- var(V), !,
'$do_error'(instantiation_error,unix(shell(V))).
unix(shell(A)) :- atom(A), !, '$shell'(A).
unix(shell(A)) :- string(A), !, '$shell'(A).
unix(shell(V)) :-
'$do_error'(type_error(atomic,V),unix(shell(V))).
unix(system(V)) :- var(V), !,
'$do_error'(instantiation_error,unix(system(V))).
unix(system(A)) :- atom(A), !, system(A).
unix(system(A)) :- string(A), !, system(A).
unix(system(V)) :-
'$do_error'(type_error(atom,V),unix(system(V))).
unix(shell) :- sh.

10
pl/preddecls.yap
View File

@ -15,6 +15,16 @@
* *
*************************************************************************/
:- system_module( '$_preddecls', [(discontiguous)/1,
(dynamic)/1,
(multifile)/1], ['$check_multifile_pred'/3,
'$discontiguous'/2,
'$dynamic'/2]).
:- use_system_module( '$_consult', ['$add_multifile'/3]).
:- use_system_module( '$_errors', ['$do_error'/2]).
%
% can only do as goal in YAP mode.
%

62
pl/preds.yap
View File

@ -15,6 +15,68 @@
* *
*************************************************************************/
:- system_module( '$_preds', [abolish/1,
abolish/2,
assert/1,
assert/2,
assert_static/1,
asserta/1,
asserta/2,
asserta_static/1,
assertz/1,
assertz/2,
assertz_static/1,
clause/2,
clause/3,
clause_property/2,
compile_predicates/1,
current_key/2,
current_predicate/1,
current_predicate/2,
dynamic_predicate/2,
hide_predicate/1,
nth_clause/3,
predicate_erased_statistics/4,
predicate_property/2,
predicate_statistics/4,
retract/1,
retract/2,
retractall/1,
stash_predicate/1,
system_predicate/1,
system_predicate/2,
unknown/2], ['$assert_static'/5,
'$assertz_dynamic'/4,
'$clause'/4,
'$current_predicate_no_modules'/3,
'$init_preds'/0,
'$noprofile'/2,
'$public'/2,
'$unknown_error'/1,
'$unknown_warning'/1]).
:- use_system_module( '$_boot', ['$check_head_and_body'/4,
'$check_if_reconsulted'/2,
'$handle_throw'/3,
'$head_and_body'/3,
'$inform_as_reconsulted'/2]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_init', ['$do_log_upd_clause'/6,
'$do_log_upd_clause0'/6,
'$do_log_upd_clause_erase'/6,
'$do_static_clause'/5]).
:- use_system_module( '$_modules', ['$imported_pred'/4,
'$meta_predicate'/4,
'$module_expansion'/5]).
:- use_system_module( '$_preddecls', ['$check_multifile_pred'/3,
'$dynamic'/2]).
:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1]).
% The next predicates are applicable only
% to dynamic code

7
pl/profile.yap
View File

@ -15,6 +15,13 @@
* *
*************************************************************************/
:- system_module( '$_profile', [profile_data/3,
profile_reset/0,
showprofres/0,
showprofres/1], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
% hook predicate, taken from SWI-Prolog, for converting possibly explicitly-
% qualified callable terms into an atom that can be used as a label for

2
pl/protect.yap
View File

@ -15,6 +15,8 @@
* *
*************************************************************************/
:- system_module( '$_protect', [], ['$protect'/0]).
% This protects all code from further changes
% and also makes it impossible from some predicates to be seen
'$protect' :-

26
pl/qly.yap
View File

@ -15,6 +15,32 @@
* comments: fast save/restore *
* *
*************************************************************************/
:- system_module( '$_qly', [qload_module/1,
qsave_file/1,
qsave_module/1,
qsave_program/1,
qsave_program/2,
restore/1,
save_program/1,
save_program/2], ['$init_state'/0]).
:- use_system_module( '$_absf', ['$system_library_directories'/2]).
:- use_system_module( '$_boot', ['$system_catch'/4]).
:- use_system_module( '$_consult', ['$do_startup_reconsult'/1]).
:- use_system_module( '$_control', ['$run_atom_goal'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_preds', ['$init_preds'/0]).
:- use_system_module( '$_protect', ['$protect'/0]).
:- use_system_module( '$_threads', ['$reinit_thread0'/0]).
:- use_system_module( '$_yio', ['$extend_file_search_path'/1]).
save_program(File) :-
qsave_program(File).

2
pl/save.yap
View File

@ -15,6 +15,8 @@
* *
*************************************************************************/
:- system_module( '$_save', [], []).
%%% Saving and restoring a computation
/*
save(A) :- save(A,_).

11
pl/setof.yap
View File

@ -15,6 +15,17 @@
* *
*************************************************************************/
:- system_module( '$_setof', [(^)/2,
all/3,
bagof/3,
findall/3,
findall/4,
setof/3], []).
:- use_system_module( '$_boot', ['$catch'/3]).
:- use_system_module( '$_errors', ['$do_error'/2]).
% The "existential quantifier" symbol is only significant to bagof
% and setof, which it stops binding the quantified variable.
% op(200, xfy, ^) is defined during bootstrap.

12
pl/signals.yap
View File

@ -15,6 +15,18 @@
* *
*************************************************************************/
:- system_module( '$_signals', [alarm/3,
on_exception/3,
on_signal/3,
raise_exception/1,
read_sig/0], []).
:- use_system_module( '$_boot', ['$meta_call'/2]).
:- use_system_module( '$_debug', ['$do_spy'/4]).
:- use_system_module( '$_threads', ['$thread_gfetch'/1]).
:- meta_predicate on_signal(+,?,:), alarm(+,:,-).
'$creep'(G) :-

12
pl/sort.yap
View File

@ -14,6 +14,18 @@
* comments: sorting in Prolog *
* *
*************************************************************************/
:- system_module( '$_sort', [keysort/2,
length/2,
msort/2,
predmerge/4,
predmerge/7,
predsort/3,
predsort/5,
sort/2,
sort2/4], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
/* The three sorting routines are all variations of merge-sort, done by
bisecting the list, sorting the nearly equal halves, and merging the

6
pl/statistics.yap
View File

@ -14,6 +14,12 @@
* comments: statistics on Prolog status *
* *
*************************************************************************/
:- system_module( '$_statistics', [key_statistics/3,
statistics/0,
statistics/2,
time/1], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
%%% User interface for statistics

5
pl/strict_iso.yap
View File

@ -1,3 +1,8 @@
:- system_module( '$_strict_iso', [], ['$check_iso_strict_clause'/1,
'$iso_check_goal'/2]).
:- use_system_module( '$_errors', ['$do_error'/2]).
'$iso_check_goal'(V,G) :-
var(V), !,
'$do_error'(instantiation_error,call(G)).

18
pl/tabling.yap
View File

@ -1,3 +1,21 @@
:- system_module( '$_tabling', [abolish_table/1,
global_trie_statistics/0,
is_tabled/1,
show_all_local_tables/0,
show_all_tables/0,
show_global_trie/0,
show_table/1,
show_table/2,
show_tabled_predicates/0,
(table)/1,
table_statistics/1,
table_statistics/2,
tabling_mode/2,
tabling_statistics/0,
tabling_statistics/2], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %%
%% The YapTab/YapOr/OPTYap systems %%

50
pl/threads.yap
View File

@ -15,6 +15,56 @@
* *
*************************************************************************/
:- system_module( '$_threads', [current_mutex/3,
current_thread/2,
message_queue_create/1,
message_queue_create/2,
message_queue_destroy/1,
message_queue_property/2,
mutex_create/1,
mutex_create/2,
mutex_destroy/1,
mutex_lock/1,
mutex_property/2,
mutex_trylock/1,
mutex_unlock/1,
mutex_unlock_all/0,
thread_at_exit/1,
thread_cancel/1,
thread_create/1,
thread_create/2,
thread_create/3,
thread_default/1,
thread_defaults/1,
thread_detach/1,
thread_exit/1,
thread_get_message/1,
thread_get_message/2,
thread_join/2,
(thread_local)/1,
thread_peek_message/1,
thread_peek_message/2,
thread_property/1,
thread_property/2,
thread_self/1,
thread_send_message/1,
thread_send_message/2,
thread_set_default/1,
thread_set_defaults/1,
thread_signal/2,
thread_sleep/1,
threads/0,
(volatile)/1,
with_mutex/2], ['$reinit_thread0'/0,
'$thread_gfetch'/1,
'$thread_local'/2]).
:- use_system_module( '$_boot', ['$check_callable'/2,
'$run_at_thread_start'/0,
'$system_catch'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- meta_predicate
thread_initialization(0),
thread_at_exit(0),

2
pl/udi.yap
View File

@ -15,6 +15,8 @@
* *
*************************************************************************/
:- system_module( '$_udi', [udi/1], []).
:- meta_predicate udi(:).
/******************

17
pl/utils.yap
View File

@ -15,6 +15,23 @@
* *
*************************************************************************/
:- system_module( '$_utils', [callable/1,
current_op/3,
nb_current/2,
nth_instance/3,
nth_instance/4,
op/3,
prolog/0,
recordaifnot/3,
recordzifnot/3,
simple/1,
subsumes_term/2], ['$getval_exception'/3]).
:- use_system_module( '$_boot', ['$live'/0]).
:- use_system_module( '$_errors', ['$do_error'/2]).
op(P,T,V) :-
'$check_op'(P,T,V,op(P,T,V)),
'$op'(P, T, V).

16
pl/yapor.yap
View File

@ -1,3 +1,19 @@
:- system_module( '$_utils', [callable/1,
current_op/3,
nb_current/2,
nth_instance/3,
nth_instance/4,
op/3,
prolog/0,
recordaifnot/3,
recordzifnot/3,
simple/1,
subsumes_term/2], ['$getval_exception'/3]).
:- use_system_module( '$_boot', ['$live'/0]).
:- use_system_module( '$_errors', ['$do_error'/2]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %%
%% The YapTab/YapOr/OPTYap systems %%

38
pl/yio.yap
View File

@ -15,6 +15,44 @@
* *
*************************************************************************/
:- system_module( '$_yio', [at_end_of_line/0,
at_end_of_line/1,
consult_depth/1,
current_char_conversion/2,
current_line_number/1,
current_line_number/2,
current_stream/3,
display/1,
display/2,
exists/1,
fileerrors/0,
format/1,
nofileerrors/0,
open_pipe_streams/2,
prolog_file_name/2,
read/1,
read/2,
sformat/3,
socket/2,
socket/4,
socket_connect/3,
stream_position/2,
stream_position/3,
stream_position_data/3,
ttyget/1,
ttyget0/1,
ttynl/0,
ttyput/1,
ttyskip/1,
write_depth/2,
writeln/1], ['$default_expand'/1,
'$extend_file_search_path'/1,
'$set_default_expand'/1]).
:- use_system_module( '$_boot', ['$system_catch'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
/* stream predicates */
/* check whether a list of options is valid */