1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 2009-2025, VU University, Amsterdam 7 CWI, Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(persistency, 38 [ (persistent)/1, % +Declarations 39 current_persistent_predicate/1, % :PI 40 41 db_attach/2, % :File, +Options 42 db_detach/0, 43 db_attached/1, % :File 44 45 db_sync/1, % :What 46 db_sync_all/1, % +What 47 48 op(1150, fx, (persistent)) 49 ]). 50:- autoload(library(aggregate),[aggregate_all/3]). 51:- use_module(library(debug),[debug/3]). 52:- autoload(library(error), 53 [ instantiation_error/1, 54 must_be/2, 55 permission_error/3, 56 existence_error/2 57 ]). 58:- autoload(library(option),[option/3]). 59 60 61:- predicate_options(db_attach/2, 2, 62 [ sync(oneof([close,flush,none])) 63 ]).

Provide persistent dynamic predicates

This module provides simple persistent storage for one or more dynamic predicates. A database is always associated with a module. A module that wishes to maintain a database must declare the terms that can be placed in the database using the directive persistent/1.

The persistent/1 expands each declaration into five predicates:

name(Arg, ...)
assert_name(Arg, ...)
asserta_name(Arg, ...)
retract_name(Arg, ...)
retractall_name(Arg, ...)

As mentioned, a database can only be accessed from within a single module. This limitation is on purpose, forcing the user to provide a proper API for accessing the shared persistent data.

This module requires the same thread-synchronization as the normal Prolog database. This implies that if each individual assert or retract takes the database from one consistent state to the next, no additional locking is required. If more than one elementary database operation is required to get from one consistent state to the next, both updating and querying the database must be locked using with_mutex/2.

Below is a simple example, where adding a user does not need locking as it is a single assert, while modifying a user requires both a retract and assert and thus needs to be locked.

:- module(user_db,
          [ attach_user_db/1,           % +File
            current_user_role/2,        % ?User, ?Role
            add_user/2,                 % +User, +Role
            set_user_role/2             % +User, +Role
          ]).
:- use_module(library(persistency)).

:- persistent
        user_role(name:atom, role:oneof([user,administrator])).

attach_user_db(File) :-
        db_attach(File, []).

%%      current_user_role(+Name, -Role) is semidet.

current_user_role(Name, Role) :-
        with_mutex(user_db, user_role(Name, Role)).

add_user(Name, Role) :-
        assert_user_role(Name, Role).

set_user_role(Name, Role) :-
        user_role(Name, Role), !.
set_user_role(Name, Role) :-
        with_mutex(user_db,
                   (  retractall_user_role(Name, _),
                      assert_user_role(Name, Role))).

To be done: - Provide type safety while loading; - Thread safety must now be provided at the user-level. Can we provide generic thread safety? Basically, this means that we must wrap all exported predicates. That might better be done outside this library.; - Transaction management?; - Should assert_<name> only assert if the database does not contain a variant?; - Since we have prolog_listen/2, we could use direct assert/1 and retract/1 and use the system hooks to deal with the updates.

138:- meta_predicate 139 db_attach(:, +), 140 db_attached(:), 141 db_sync(:), 142 current_persistent_predicate(:). 143:- module_transparent 144 db_detach/0. 145 146 147 /******************************* 148 * DB * 149 *******************************/ 150 151:- dynamic 152 db_file/5, % Module, File, Created, Modified, EndPos 153 db_stream/2, % Module, Stream 154 db_dirty/2, % Module, Deleted 155 db_option/2. % Module, Name(Value) 156 157:- volatile 158 db_stream/2. 159 160:- multifile 161 (persistent)/3, % Module, Generic, Term 162 prolog:generated_predicate/1. 163 164 165 /******************************* 166 * DECLARATIONS * 167 *******************************/

188persistent(Spec) :- 189 throw(error(context_error(nodirective, persistent(Spec)), _)). 190 191compile_persistent(Var, _, _) --> 192 { var(Var), 193 !, 194 instantiation_error(Var) 195 }. 196compile_persistent(M:Spec, _, LoadModule) --> 197 !, 198 compile_persistent(Spec, M, LoadModule). 199compile_persistent((A,B), Module, LoadModule) --> 200 !, 201 compile_persistent(A, Module, LoadModule), 202 compile_persistent(B, Module, LoadModule). 203compile_persistent(Term, Module, LoadModule) --> 204 { functor(Term, Name, Arity), % Validates Term as callable 205 functor(Generic, Name, Arity), 206 qualify(Module, LoadModule, Name/Arity, Dynamic) 207 }, 208 [ :- dynamic(Dynamic), 209 210 persistency:persistent(Module, Generic, Term) 211 ], 212 assert_clause(asserta, Term, Module, LoadModule), 213 assert_clause(assert, Term, Module, LoadModule), 214 retract_clause(Term, Module, LoadModule), 215 retractall_clause(Term, Module, LoadModule). 216 217assert_clause(Where, Term, Module, LoadModule) --> 218 { functor(Term, Name, Arity), 219 atomic_list_concat([Where,'_', Name], PredName), 220 length(Args, Arity), 221 Head =.. [PredName|Args], 222 Assert =.. [Name|Args], 223 type_checkers(Args, 1, Term, Check), 224 atom_concat(db_, Where, DBActionName), 225 DBAction =.. [DBActionName, Module:Assert], 226 qualify(Module, LoadModule, Head, QHead), 227 Clause = (QHead :- Check, persistency:DBAction) 228 }, 229 [ Clause ]. 230 231type_checkers([], _, _, true). 232type_checkers([A0|AL], I, Spec, Check) :- 233 arg(I, Spec, ArgSpec), 234 ( ArgSpec = _Name:Type, 235 nonvar(Type), 236 Type \== any 237 -> Check = (must_be(Type, A0),More) 238 ; More = Check 239 ), 240 I2 is I + 1, 241 type_checkers(AL, I2, Spec, More). 242 243retract_clause(Term, Module, LoadModule) --> 244 { functor(Term, Name, Arity), 245 atom_concat(retract_, Name, PredName), 246 length(Args, Arity), 247 Head =.. [PredName|Args], 248 Retract =.. [Name|Args], 249 qualify(Module, LoadModule, Head, QHead), 250 Clause = (QHead :- persistency:db_retract(Module:Retract)) 251 }, 252 [ Clause ]. 253 254retractall_clause(Term, Module, LoadModule) --> 255 { functor(Term, Name, Arity), 256 atom_concat(retractall_, Name, PredName), 257 length(Args, Arity), 258 Head =.. [PredName|Args], 259 Retract =.. [Name|Args], 260 qualify(Module, LoadModule, Head, QHead), 261 Clause = (QHead :- persistency:db_retractall(Module:Retract)) 262 }, 263 [ Clause ]. 264 265qualify(Module, Module, Head, Head) :- !. 266qualify(Module, _LoadModule, Head, Module:Head). 267 268 269:- multifile 270 system:term_expansion/2. 271 272system:term_expansion((:- persistent(Spec)), Clauses) :- 273 prolog_load_context(module, Module), 274 phrase(compile_persistent(Spec, Module, Module), Clauses).

282current_persistent_predicate(M:PName/Arity) :- 283 persistency:persistent(M, Generic, _), 284 functor(Generic, Name, Arity), 285 ( Name = PName 286 ; atom_concat(assert_, Name, PName) 287 ; atom_concat(retract_, Name, PName) 288 ; atom_concat(retractall_, Name, PName) 289 ). 290 291prolog:generated_predicate(PI) :- 292 current_persistent_predicate(PI). 293 294 295 /******************************* 296 * ATTACH * 297 *******************************/

317db_attach(Module:File, Options) :- 318 db_set_options(Module, Options), 319 db_attach_file(Module, File). 320 321db_set_options(Module, Options) :- 322 option(sync(Sync), Options, flush), 323 must_be(oneof([close,flush,none]), Sync), 324 ( db_option(Module, sync(Sync)) 325 -> true 326 ; retractall(db_option(Module, _)), 327 assert(db_option(Module, sync(Sync))) 328 ). 329 330db_attach_file(Module, File) :- 331 db_file(Module, Old, _, _, _), % we already have a db 332 !, 333 ( Old == File 334 -> ( db_stream(Module, Stream) 335 -> sync(Module, Stream) 336 ; true 337 ) 338 ; permission_error(attach, db, File) 339 ). 340db_attach_file(Module, File) :- 341 db_load(Module, File), 342 !. 343db_attach_file(Module, File) :- 344 assert(db_file(Module, File, 0, 0, 0)). 345 346db_load(Module, File) :- 347 retractall(db_file(Module, _, _, _, _)), 348 debug(db, 'Loading database ~w', [File]), 349 catch(setup_call_cleanup( 350 open(File, read, In, [encoding(utf8), newline(posix)]), 351 load_db_end(In, Module, File, Created, EndPos), 352 close(In)), 353 error(existence_error(source_sink, File), _), fail), 354 debug(db, 'Loaded ~w', [File]), 355 time_file(File, Modified), 356 assert(db_file(Module, File, Created, Modified, EndPos)). 357 358db_load_incremental(Module, File) :- 359 db_file(Module, File, Created, _, EndPos0), 360 setup_call_cleanup( 361 ( open(File, read, In, [encoding(utf8), newline(posix)]), 362 read_action(In, created(Created0)), 363 set_stream_position(In, EndPos0) 364 ), 365 ( Created0 == Created, 366 debug(db, 'Incremental load from ~p', [EndPos0]), 367 load_db_end(In, Module, File, _Created, EndPos) 368 ), 369 close(In)), 370 debug(db, 'Updated ~w', [File]), 371 time_file(File, Modified), 372 retractall(db_file(Module, File, Created, _, _)), 373 assert(db_file(Module, File, Created, Modified, EndPos)). 374 375load_db_end(In, Module, File, Created, End) :- 376 read_db_action(In, File, T0, End0), 377 ( T0 = created(Created) 378 -> read_db_action(In, File, T1, End1) 379 ; T1 = T0, 380 End1 = End0, 381 Created = 0 382 ), 383 load_db(T1, In, Module, File, End1, End). 384 385load_db(end_of_file, _, _, _, End, End) :- !. 386load_db(assert(Term), In, Module, File, _End0, End) :- 387 persistent(Module, Term, _Types), 388 !, 389 assert(Module:Term), 390 read_db_action(In, File, T1, End1), 391 load_db(T1, In, Module, File, End1, End). 392load_db(asserta(Term), In, Module, File, _End0, End) :- 393 persistent(Module, Term, _Types), 394 !, 395 asserta(Module:Term), 396 read_db_action(In, File, T1, End1), 397 load_db(T1, In, Module, File, End1, End). 398load_db(retractall(Term, Count), In, Module, File, _End0, End) :- 399 persistent(Module, Term, _Types), 400 !, 401 retractall(Module:Term), 402 set_dirty(Module, Count), 403 read_db_action(In, File, T1, End1), 404 load_db(T1, In, Module, File, End1, End). 405load_db(retract(Term), In, Module, File, _End0, End) :- 406 persistent(Module, Term, _Types), 407 !, 408 ( retract(Module:Term) 409 -> set_dirty(Module, 1) 410 ; true 411 ), 412 read_db_action(In, File, T1, End1), 413 load_db(T1, In, Module, File, End1, End). 414load_db(Term, In, Module, File, _End0, End) :- 415 print_message(error, persistency(illegal_term(File, Term))), 416 read_db_action(In, File, T1, End1), 417 load_db(T1, In, Module, File, End1, End).

425read_db_action(In, File, Action, End) :- 426 stream_property(In, position(Start)), 427 catch(( read_action(In, Action), 428 stream_property(In, position(End)) 429 ), 430 Error, 431 recover_db(Error, In, File, Start, Action, End)).

446recover_db(error(syntax_error(Culprit), _), In, File, Pos, Action, End) :- 447 at_end_of_stream(In), 448 stream_position_data(byte_count, Pos, Byte), 449 Byte > 0, 450 !, 451 print_message(warning, persistency(truncated_db(File, Pos, Culprit))), 452 truncate_db_file(File, Byte), 453 Action = end_of_file, 454 End = Pos. 455recover_db(Error, _In, _File, _Pos, _Action, _End) :- 456 throw(Error).

464truncate_db_file(File, Byte) :- 465 setup_call_cleanup( 466 open(File, update, Out, [type(binary), lock(write)]), 467 ( seek(Out, Byte, bof, _), 468 put_byte(Out, 0'\n), 469 set_end_of_stream(Out) 470 ), 471 close(Out)). 472 473db_clean(Module) :- 474 retractall(db_dirty(Module, _)), 475 ( persistent(Module, Term, _Types), 476 retractall(Module:Term), 477 fail 478 ; true 479 ).

485db_size(Module, Total) :- 486 aggregate_all(sum(Count), persistent_size(Module, Count), Total). 487 488persistent_size(Module, Count) :- 489 persistent(Module, Term, _Types), 490 predicate_property(Module:Term, number_of_clauses(Count)).

505:- public 506 db_assert/1, 507 db_asserta/1, 508 db_retractall/1, 509 db_retract/1. 510 511db_assert(Term) :- with_mutex('$persistency', db_assert_sync(Term)). 512db_asserta(Term) :- with_mutex('$persistency', db_asserta_sync(Term)). 513db_retract(Term) :- with_mutex('$persistency', db_retract_sync(Term)). 514db_retractall(Term) :- with_mutex('$persistency', db_retractall_sync(Term)). 515 516db_assert_sync(Module:Term) :- 517 assert(Module:Term), 518 persistent(Module, assert(Term)). 519 520db_asserta_sync(Module:Term) :- 521 asserta(Module:Term), 522 persistent(Module, asserta(Term)). 523 524persistent(Module, Action) :- 525 ( db_stream(Module, Stream) 526 -> true 527 ; db_file(Module, File, _Created, _Modified, _EndPos) 528 -> db_sync(Module, update), % Is this correct? 529 db_open_file(File, append, Stream), 530 assert(db_stream(Module, Stream)) 531 ; existence_error(db_file, Module) 532 ), 533 write_action(Stream, Action), 534 sync(Module, Stream).

551db_open_file(File, Mode, Stream) :- 552 ( Mode == append, 553 exists_file(File), 554 \+ db_ends_with_layout(File) 555 -> Complete = true 556 ; Complete = false 557 ), 558 open(File, Mode, Stream, 559 [ close_on_abort(false), 560 encoding(utf8), 561 newline(posix), 562 lock(write) 563 ]), 564 ( size_file(File, 0) 565 -> get_time(Now), 566 write_action(Stream, created(Now)) 567 ; Complete == true 568 -> nl(Stream) 569 ; true 570 ). 571 572db_ends_with_layout(File) :- 573 size_file(File, Size), 574 Size > 0, 575 Last is Size-1, 576 setup_call_cleanup( 577 open(File, read, In, [type(binary)]), 578 ( seek(In, Last, bof, _), 579 get_byte(In, Byte) 580 ), 581 close(In)), 582 layout_byte(Byte). 583 584layout_byte(0'\n). 585layout_byte(0'\r). 586layout_byte(0' ). 587layout_byte(0'\t).

613sync(Module, Stream) :- 614 db_option(Module, sync(Sync)), 615 ( Sync == close 616 -> db_sync(Module, close) 617 ; Sync == flush 618 -> flush_output(Stream) 619 ; true 620 ). 621 622read_action(Stream, Action) :- 623 read_term(Stream, Action, [module(db)]). 624 625write_action(Stream, Action) :- 626 \+ \+ ( numbervars(Action, 0, _, [singletons(true)]), 627 format(Stream, '~W.~n', 628 [ Action, 629 [ quoted(true), 630 numbervars(true), 631 module(db) 632 ] 633 ]) 634 ).

642db_retractall_sync(Module:Term) :- 643 ( var(Term) 644 -> forall(persistent(Module, Term, _Types), 645 db_retractall(Module:Term)) 646 ; State = count(0), 647 ( retract(Module:Term), 648 arg(1, State, C0), 649 C1 is C0+1, 650 nb_setarg(1, State, C1), 651 fail 652 ; arg(1, State, Count) 653 ), 654 ( Count > 0 655 -> set_dirty(Module, Count), 656 persistent(Module, retractall(Term, Count)) 657 ; true 658 ) 659 ).

666db_retract_sync(Module:Term) :- 667 ( var(Term) 668 -> instantiation_error(Term) 669 ; retract(Module:Term), 670 set_dirty(Module, 1), 671 persistent(Module, retract(Term)) 672 ). 673 674 675set_dirty(_, 0) :- !. 676set_dirty(Module, Count) :- 677 ( retract(db_dirty(Module, C0)) 678 -> true 679 ; C0 = 0 680 ), 681 C1 is C0 + Count, 682 assert(db_dirty(Module, C1)).

715db_sync(Module:What) :- 716 db_sync(Module, What). 717 718 719db_sync(Module, reload) :- 720 \+ db_stream(Module, _), % not open 721 db_file(Module, File, _Created, ModifiedWhenLoaded, _EndPos), 722 catch(time_file(File, Modified), _, fail), 723 Modified > ModifiedWhenLoaded, % Externally modified 724 !, 725 debug(db, 'Database ~w was externally modified; reloading', [File]), 726 !, 727 ( catch(db_load_incremental(Module, File), 728 E, 729 ( print_message(warning, E), fail )) 730 -> true 731 ; db_clean(Module), 732 db_load(Module, File) 733 ). 734db_sync(Module, gc) :- 735 !, 736 db_sync(Module, gc(50)). 737db_sync(Module, gc(When)) :- 738 ( When == always 739 -> true 740 ; db_dirty(Module, Dirty), 741 db_size(Module, Total), 742 ( Total > 0 743 -> Perc is (100*Dirty)/Total, 744 Perc > When 745 ; Dirty > 0 746 ) 747 ), 748 !, 749 db_sync(Module, close), 750 db_file(Module, File, _, Modified, _), 751 atom_concat(File, '.new', NewFile), 752 debug(db, 'Database ~w is dirty; cleaning', [File]), 753 get_time(Created), 754 catch(setup_call_cleanup( 755 db_open_file(NewFile, write, Out), 756 ( persistent(Module, Term, _Types), 757 call(Module:Term), 758 write_action(Out, assert(Term)), 759 fail 760 ; stream_property(Out, position(EndPos)) 761 ), 762 close(Out)), 763 Error, 764 ( catch(delete_file(NewFile),_,fail), 765 throw(Error))), 766 retractall(db_file(Module, File, _, Modified, _)), 767 rename_file(NewFile, File), 768 time_file(File, NewModified), 769 assert(db_file(Module, File, Created, NewModified, EndPos)). 770db_sync(Module, close) :- 771 retract(db_stream(Module, Stream)), 772 !, 773 db_file(Module, File, Created, _, _), 774 debug(db, 'Database ~w is open; closing', [File]), 775 stream_property(Stream, position(EndPos)), 776 close(Stream), 777 time_file(File, Modified), 778 retractall(db_file(Module, File, _, _, _)), 779 assert(db_file(Module, File, Created, Modified, EndPos)). 780db_sync(Module, Action) :- 781 Action == detach, 782 !, 783 ( retract(db_stream(Module, Stream)) 784 -> close(Stream) 785 ; true 786 ), 787 retractall(db_file(Module, _, _, _, _)), 788 retractall(db_dirty(Module, _)), 789 retractall(db_option(Module, _)). 790db_sync(_, nop) :- !. 791db_sync(_, _).

798db_sync_all(What) :- 799 must_be(oneof([reload,gc,gc(_),close]), What), 800 forall(db_file(Module, _, _, _, _), 801 db_sync(Module:What)). 802 803 804 /******************************* 805 * CLOSE * 806 *******************************/ 807 808close_dbs :- 809 forall(retract(db_stream(_Module, Stream)), 810 close(Stream)). 811 812:- at_halt(close_dbs). 813 814 815 /******************************* 816 * MESSAGES * 817 *******************************/ 818 819:- multifile 820 prolog:message//1. 821 822prolog:message(persistency(Message)) --> 823 message(Message). 824 825message(truncated_db(File, Pos, Culprit)) --> 826 { stream_position_data(line_count, Pos, Line) }, 827 [ 'Persistent database ~w is incomplete (~w).'-[File, Culprit], nl, 828 'Truncated the file to line ~d, the last complete term.'-[Line] 829 ]. 830message(illegal_term(File, Term)) --> 831 [ 'Persistent database ~w: ignored illegal term ~p'-[File, Term] ]