diff --git a/C/atomic.c b/C/atomic.c index 19ab6919c..1e11802d8 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -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); diff --git a/C/index.c b/C/index.c index 997187270..2d2b1ee94 100755 --- a/C/index.c +++ b/C/index.c @@ -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; diff --git a/C/sysbits.c b/C/sysbits.c index 62c9aa3cc..e096b60e6 100755 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -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"); diff --git a/pl/absf.yap b/pl/absf.yap index 82fd71ac2..5adbe049f 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -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(+Name:atom,+Options:list) is nondet diff --git a/pl/arith.yap b/pl/arith.yap index 4385ed520..ccf3f5e1d 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -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 ; diff --git a/pl/arrays.yap b/pl/arrays.yap index 08d039d1f..1fd96b1b0 100644 --- a/pl/arrays.yap +++ b/pl/arrays.yap @@ -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. diff --git a/pl/atoms.yap b/pl/atoms.yap index 071bff695..1bab7279c 100644 --- a/pl/atoms.yap +++ b/pl/atoms.yap @@ -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). + diff --git a/pl/attributes.yap b/pl/attributes.yap index 67f3794d3..8ee7d146a 100644 --- a/pl/attributes.yap +++ b/pl/attributes.yap @@ -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) :- diff --git a/pl/boot.yap b/pl/boot.yap index 6bba5984d..a3e28d8a1 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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 */ diff --git a/pl/callcount.yap b/pl/callcount.yap index 6f1c7c983..3ac87e8c2 100644 --- a/pl/callcount.yap +++ b/pl/callcount.yap @@ -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). diff --git a/pl/checker.yap b/pl/checker.yap index 5a51f18d5..de1df3232 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -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 diff --git a/pl/chtypes.yap b/pl/chtypes.yap index 0dd47d2e3..91dc076ee 100644 --- a/pl/chtypes.yap +++ b/pl/chtypes.yap @@ -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. diff --git a/pl/consult.yap b/pl/consult.yap index d580647e1..58606d838 100755 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -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 diff --git a/pl/control.yap b/pl/control.yap index 8c9b1d747..45582e2ad 100755 --- a/pl/control.yap +++ b/pl/control.yap @@ -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))). diff --git a/pl/corout.yap b/pl/corout.yap index 78a4ccb15..d0519ee13 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -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). diff --git a/pl/dbload.yap b/pl/dbload.yap index 7d528f3f8..77a601e9d 100644 --- a/pl/dbload.yap +++ b/pl/dbload.yap @@ -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) :- diff --git a/pl/debug.yap b/pl/debug.yap index 4ff13832a..efee0262f 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -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 diff --git a/pl/depth_bound.yap b/pl/depth_bound.yap index d1bdf43f2..7b4108634 100644 --- a/pl/depth_bound.yap +++ b/pl/depth_bound.yap @@ -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) :- diff --git a/pl/dialect.yap b/pl/dialect.yap index 89f9736dc..83761389d 100644 --- a/pl/dialect.yap +++ b/pl/dialect.yap @@ -4,6 +4,7 @@ source_exports/2 ]). +:- use_system_module( '$_errors', ['$do_error'/2]). prolog:'$expects_dialect'(yap) :- !, eraseall('$dialect'), diff --git a/pl/directives.yap b/pl/directives.yap index a48237783..30a20e65d 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -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)) :- !, diff --git a/pl/eam.yap b/pl/eam.yap index 77cfd7459..0099ecb68 100644 --- a/pl/eam.yap +++ b/pl/eam.yap @@ -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). diff --git a/pl/errors.yap b/pl/errors.yap index d71462d20..d149a1176 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -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)])). diff --git a/pl/eval.yap b/pl/eval.yap index a729401a5..46dbaa1c8 100644 --- a/pl/eval.yap +++ b/pl/eval.yap @@ -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), !. diff --git a/pl/flags.yap b/pl/flags.yap index 93a2c6e82..95e2cf05b 100755 --- a/pl/flags.yap +++ b/pl/flags.yap @@ -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,_,_,_), diff --git a/pl/grammar.yap b/pl/grammar.yap index debb5dc75..bdb887fd2 100644 --- a/pl/grammar.yap +++ b/pl/grammar.yap @@ -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). diff --git a/pl/history.pl b/pl/history.pl index 9c9258521..5620190d3 100644 --- a/pl/history.pl +++ b/pl/history.pl @@ -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, diff --git a/pl/init.yap b/pl/init.yap index 240ac1bfa..18aa4c8a0 100755 --- a/pl/init.yap +++ b/pl/init.yap @@ -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'). diff --git a/pl/listing.yap b/pl/listing.yap index 305d6603b..5edcc6d72 100644 --- a/pl/listing.yap +++ b/pl/listing.yap @@ -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 */ diff --git a/pl/lists.yap b/pl/lists.yap index 38a97d819..a7304520a 100644 --- a/pl/lists.yap +++ b/pl/lists.yap @@ -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). + + diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index 409fb2065..1011f375f 100755 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -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), diff --git a/pl/messages.yap b/pl/messages.yap index cc3a9d118..b5384e67e 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -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. diff --git a/pl/modules.yap b/pl/modules.yap index 281c76ba2..3b50c8daf 100755 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -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). diff --git a/pl/os.yap b/pl/os.yap index 9a45c1eeb..8bd448771 100644 --- a/pl/os.yap +++ b/pl/os.yap @@ -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. diff --git a/pl/preddecls.yap b/pl/preddecls.yap index 43634755f..e90a7abd9 100644 --- a/pl/preddecls.yap +++ b/pl/preddecls.yap @@ -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. % diff --git a/pl/preds.yap b/pl/preds.yap index fad837fe2..596f48af2 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -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 diff --git a/pl/profile.yap b/pl/profile.yap index 16811dd65..74fb104a9 100644 --- a/pl/profile.yap +++ b/pl/profile.yap @@ -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 diff --git a/pl/protect.yap b/pl/protect.yap index a94d29578..374cf9e06 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -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' :- diff --git a/pl/qly.yap b/pl/qly.yap index bc4592e5e..5588b6ef9 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -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). diff --git a/pl/save.yap b/pl/save.yap index 7617803ec..b28c3d81b 100644 --- a/pl/save.yap +++ b/pl/save.yap @@ -15,6 +15,8 @@ * * *************************************************************************/ +:- system_module( '$_save', [], []). + %%% Saving and restoring a computation /* save(A) :- save(A,_). diff --git a/pl/setof.yap b/pl/setof.yap index dcdcc3120..8a61f87b9 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -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. diff --git a/pl/signals.yap b/pl/signals.yap index c01491de4..5f9d2d66d 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -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) :- diff --git a/pl/sort.yap b/pl/sort.yap index bfb526d8d..d33ff5b30 100644 --- a/pl/sort.yap +++ b/pl/sort.yap @@ -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 diff --git a/pl/statistics.yap b/pl/statistics.yap index 953d266e6..e296162b2 100644 --- a/pl/statistics.yap +++ b/pl/statistics.yap @@ -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 diff --git a/pl/strict_iso.yap b/pl/strict_iso.yap index fa00bd15f..4652a558d 100644 --- a/pl/strict_iso.yap +++ b/pl/strict_iso.yap @@ -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)). diff --git a/pl/tabling.yap b/pl/tabling.yap index 5d572fab0..6590e83fc 100644 --- a/pl/tabling.yap +++ b/pl/tabling.yap @@ -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 %% diff --git a/pl/threads.yap b/pl/threads.yap index a0cfaabc5..028c00195 100644 --- a/pl/threads.yap +++ b/pl/threads.yap @@ -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), diff --git a/pl/udi.yap b/pl/udi.yap index 945a77110..346371f8b 100644 --- a/pl/udi.yap +++ b/pl/udi.yap @@ -15,6 +15,8 @@ * * *************************************************************************/ +:- system_module( '$_udi', [udi/1], []). + :- meta_predicate udi(:). /****************** diff --git a/pl/utils.yap b/pl/utils.yap index 8ed6ad040..5958f1b65 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -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). diff --git a/pl/yapor.yap b/pl/yapor.yap index 9162d0a18..4c0cae37a 100644 --- a/pl/yapor.yap +++ b/pl/yapor.yap @@ -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 %% diff --git a/pl/yio.yap b/pl/yio.yap index 1c84bece8..f81d22cd9 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -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 */