When not compiling from a file, the non-consecutive clauses have to be declared using the directive scattered/1. This declaration has to precede any clauses of the predicate.
:- lib(scattered).
:- scattered p/3, q/1.
Note that this applies to predicates whose clauses are
non-consecutive, but in a single file. Predicates that are spread
over multiple files still have to be declared as dynamic.
")).
:- export op(1000, fy, scattered).
:- export (scattered)/1.
:- export (discontiguous)/1.
:- tool((scattered)/1).
:- tool((discontiguous)/1).
:- import
abolish_body/2,
assert_/2,
clause_body/3,
compile_term_/2,
dynamic_body/2,
export_body/2,
get_flag_body/4,
global_body/2,
local_body/2,
mode_/2,
read_/3,
set_flag_body/4
from sepia_kernel.
:- local_record(scattered_pred).
%
% the scattered/1 declaration
%
:- tool((scattered)/1, scattered_body/2).
:- tool((discontiguous)/1, scattered_body/2).
scattered_body((Pred, Preds), M) :-
!,
scattered_body(Pred, M),
scattered_body(Preds, M).
scattered_body(Pred, M) :-
get_flag_body(Pred, defined, on, M),
get_flag_body(Pred, stability, dynamic, M),
!,
printf(warning_output,
'warning: declaration ignored for dynamic predicate: %w\n%b',
scattered(Pred)).
scattered_body(Pred, M) :-
(get_flag_body(Pred, defined, on, M) ->
findall(Flag-Val, get_flag_body(Pred, Flag, Val, M), OldFlags),
abolish_body(Pred, M),
dynamic_body(Pred, M),
set_old_flags(Pred, OldFlags, M)
;
dynamic_body(Pred, M)
),
recorda(scattered_pred, .(Pred, M)).
%
% handlers for compilation events
%
start_compile_file(E, G, M) :-
recorda(scattered_pred, '.'),
error(default(E), G, M).
end_compile_file(E, G, M) :-
( atom(G) -> % eco file
true
; arg(1, G, term) ->
true
; is_record(scattered_pred) -> % may have been set on the fly
recompile_scattered_preds
;
true
),
error(default(E), G, M).
recompile_scattered_preds :-
(erase(scattered_pred, R),
R = .(Pred, M) ->
recompile(Pred, M),
recompile_scattered_preds
;
true
).
% Handler for the non-consecutive event.
non_consecutive_handler(_, Pred, M) :-
get_flag_body(Pred, source_file, File, M),
get_file_info(File, mode) /\ 8'400 =:= 8'400,
get_flag_body(Pred, source_offset, Offset, M),
!,
findall(Flag-Val, get_flag_body(Pred, Flag, Val, M), OldFlags),
abolish_body(Pred, M),
dynamic_body(Pred, M),
set_old_flags(Pred, OldFlags, M),
open(File, read, Stream),
seek(Stream, Offset),
input_clauses(Stream, Pred, M),
recorda(scattered_pred, .(Pred, M)).
non_consecutive_handler(N, Pred, M) :-
% The source file is not available, make the default error
error(default(N), Pred, M).
input_clauses(Stream, Proc, Module) :-
read_(Stream, Clause, Module),
(clause_proc(Clause, Proc) ->
assert_(Clause, Module),
input_clauses(Stream, Proc, Module)
;
close(Stream)
).
clause_proc((Head :- _), F/A) :-
!,
functor(Head, F, A).
clause_proc(Fact, F/A) :-
functor(Fact, F, A).
% recompile(Pred, Module)
% Collect all clauses and flags of the predicate,
% then abolish it, recompile it statically (using compile_term)
% and restore the old visibility and other flags
recompile(Pred, M) :-
Pred = N/A,
functor(Head, N, A),
findall(Clause, my_clause(Head, Clause, M), Clauses),
findall(Flag, get_pre_flag(Pred, Flag, M), PreFlags),
findall(Flag, get_post_flag(Pred, Flag, M), PostFlags),
abolish_body(Pred, M),
(Clauses == [] ->
printf(warning_output,
'warning: no clauses for scattered predicate %w\n%b', Pred)
;
set_old_flags(Pred, PreFlags, M),
compile_term_(Clauses, M),
set_old_flags(Pred, PostFlags, M)
).
my_clause(Head, Clause, M) :-
clause_body(Head, Body, M),
(Body == true -> Clause = Head ; Clause = (Head :- Body)).
set_old_flags(_Pred, [], _M).
set_old_flags(Pred, [Flag-Val|Flags], M) :-
set_old_flag(Pred, Flag, Val, M),
set_old_flags(Pred, Flags, M).
set_old_flag(_Pred, visibility, local, _M) :- !.
set_old_flag(Pred, visibility, global, M) :- !,
global_body(Pred, M).
set_old_flag(Pred, visibility, exported, M) :- !,
export_body(Pred, M).
set_old_flag(Pred, leash, X, M) :- !,
set_flag_body(Pred, leash, X, M).
set_old_flag(Pred, skip, X, M) :- !,
set_flag_body(Pred, skip, X, M).
set_old_flag(Pred, spy, X, M) :- !,
set_flag_body(Pred, spy, X, M).
set_old_flag(Pred, statistics, on, M) :- !,
set_flag_body(Pred, statistics, on, M).
set_old_flag(_Pred, mode, Mode, M) :- !,
mode_(Mode, M).
set_old_flag(_, _, _, _).
get_pre_flag(Pred, Flag-Val, M) :-
Flag = mode,
get_flag_body(Pred, Flag, Val, M).
get_post_flag(Pred, Flag-Val, M) :-
get_flag_body(Pred, Flag, Val, M),
Flag \= mode.
%
% set up the handlers for compilation events
%
:- set_error_handler(146, start_compile_file/3).
:- set_error_handler(139, end_compile_file/3).
:- set_error_handler(147, end_compile_file/3).
:- set_error_handler(134, non_consecutive_handler/3).
:- error(146, _). % call it once for this file