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 *******************************/

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

427db_size(Module, Total) :- 428 aggregate_all(sum(Count), persistent_size(Module, Count), Total). 429 430persistent_size(Module, Count) :- 431 persistent(Module, Term, _Types), 432 predicate_property(Module:Term, number_of_clauses(Count)).

447:- public 448 db_assert/1, 449 db_asserta/1, 450 db_retractall/1, 451 db_retract/1. 452 453db_assert(Term) :- with_mutex('$persistency', db_assert_sync(Term)). 454db_asserta(Term) :- with_mutex('$persistency', db_asserta_sync(Term)). 455db_retract(Term) :- with_mutex('$persistency', db_retract_sync(Term)). 456db_retractall(Term) :- with_mutex('$persistency', db_retractall_sync(Term)). 457 458db_assert_sync(Module:Term) :- 459 assert(Module:Term), 460 persistent(Module, assert(Term)). 461 462db_asserta_sync(Module:Term) :- 463 asserta(Module:Term), 464 persistent(Module, asserta(Term)). 465 466persistent(Module, Action) :- 467 ( db_stream(Module, Stream) 468 -> true 469 ; db_file(Module, File, _Created, _Modified, _EndPos) 470 -> db_sync(Module, update), % Is this correct? 471 db_open_file(File, append, Stream), 472 assert(db_stream(Module, Stream)) 473 ; existence_error(db_file, Module) 474 ), 475 write_action(Stream, Action), 476 sync(Module, Stream). 477 478db_open_file(File, Mode, Stream) :- 479 open(File, Mode, Stream, 480 [ close_on_abort(false), 481 encoding(utf8), 482 lock(write) 483 ]), 484 ( size_file(File, 0) 485 -> get_time(Now), 486 write_action(Stream, created(Now)) 487 ; true 488 ).

514sync(Module, Stream) :- 515 db_option(Module, sync(Sync)), 516 ( Sync == close 517 -> db_sync(Module, close) 518 ; Sync == flush 519 -> flush_output(Stream) 520 ; true 521 ). 522 523read_action(Stream, Action) :- 524 read_term(Stream, Action, [module(db)]). 525 526write_action(Stream, Action) :- 527 \+ \+ ( numbervars(Action, 0, _, [singletons(true)]), 528 format(Stream, '~W.~n', 529 [ Action, 530 [ quoted(true), 531 numbervars(true), 532 module(db) 533 ] 534 ]) 535 ).

543db_retractall_sync(Module:Term) :- 544 ( var(Term) 545 -> forall(persistent(Module, Term, _Types), 546 db_retractall(Module:Term)) 547 ; State = count(0), 548 ( retract(Module:Term), 549 arg(1, State, C0), 550 C1 is C0+1, 551 nb_setarg(1, State, C1), 552 fail 553 ; arg(1, State, Count) 554 ), 555 ( Count > 0 556 -> set_dirty(Module, Count), 557 persistent(Module, retractall(Term, Count)) 558 ; true 559 ) 560 ).

567db_retract_sync(Module:Term) :- 568 ( var(Term) 569 -> instantiation_error(Term) 570 ; retract(Module:Term), 571 set_dirty(Module, 1), 572 persistent(Module, retract(Term)) 573 ). 574 575 576set_dirty(_, 0) :- !. 577set_dirty(Module, Count) :- 578 ( retract(db_dirty(Module, C0)) 579 -> true 580 ; C0 = 0 581 ), 582 C1 is C0 + Count, 583 assert(db_dirty(Module, C1)).

616db_sync(Module:What) :- 617 db_sync(Module, What). 618 619 620db_sync(Module, reload) :- 621 \+ db_stream(Module, _), % not open 622 db_file(Module, File, _Created, ModifiedWhenLoaded, _EndPos), 623 catch(time_file(File, Modified), _, fail), 624 Modified > ModifiedWhenLoaded, % Externally modified 625 !, 626 debug(db, 'Database ~w was externally modified; reloading', [File]), 627 !, 628 ( catch(db_load_incremental(Module, File), 629 E, 630 ( print_message(warning, E), fail )) 631 -> true 632 ; db_clean(Module), 633 db_load(Module, File) 634 ). 635db_sync(Module, gc) :- 636 !, 637 db_sync(Module, gc(50)). 638db_sync(Module, gc(When)) :- 639 ( When == always 640 -> true 641 ; db_dirty(Module, Dirty), 642 db_size(Module, Total), 643 ( Total > 0 644 -> Perc is (100*Dirty)/Total, 645 Perc > When 646 ; Dirty > 0 647 ) 648 ), 649 !, 650 db_sync(Module, close), 651 db_file(Module, File, _, Modified, _), 652 atom_concat(File, '.new', NewFile), 653 debug(db, 'Database ~w is dirty; cleaning', [File]), 654 get_time(Created), 655 catch(setup_call_cleanup( 656 db_open_file(NewFile, write, Out), 657 ( persistent(Module, Term, _Types), 658 call(Module:Term), 659 write_action(Out, assert(Term)), 660 fail 661 ; stream_property(Out, position(EndPos)) 662 ), 663 close(Out)), 664 Error, 665 ( catch(delete_file(NewFile),_,fail), 666 throw(Error))), 667 retractall(db_file(Module, File, _, Modified, _)), 668 rename_file(NewFile, File), 669 time_file(File, NewModified), 670 assert(db_file(Module, File, Created, NewModified, EndPos)). 671db_sync(Module, close) :- 672 retract(db_stream(Module, Stream)), 673 !, 674 db_file(Module, File, Created, _, _), 675 debug(db, 'Database ~w is open; closing', [File]), 676 stream_property(Stream, position(EndPos)), 677 close(Stream), 678 time_file(File, Modified), 679 retractall(db_file(Module, File, _, _, _)), 680 assert(db_file(Module, File, Created, Modified, EndPos)). 681db_sync(Module, Action) :- 682 Action == detach, 683 !, 684 ( retract(db_stream(Module, Stream)) 685 -> close(Stream) 686 ; true 687 ), 688 retractall(db_file(Module, _, _, _, _)), 689 retractall(db_dirty(Module, _)), 690 retractall(db_option(Module, _)). 691db_sync(_, nop) :- !. 692db_sync(_, _).

699db_sync_all(What) :- 700 must_be(oneof([reload,gc,gc(_),close]), What), 701 forall(db_file(Module, _, _, _, _), 702 db_sync(Module:What)). 703 704 705 /******************************* 706 * CLOSE * 707 *******************************/ 708 709close_dbs :- 710 forall(retract(db_stream(_Module, Stream)), 711 close(Stream)). 712 713:- at_halt(close_dbs).