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

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 four predicates:

name(Arg, ...)
assert_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. */

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

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

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

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

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

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

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

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

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

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

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