35
36:- module(persistency,
37 [ (persistent)/1, 38 current_persistent_predicate/1, 39
40 db_attach/2, 41 db_detach/0,
42 db_attached/1, 43
44 db_sync/1, 45 db_sync_all/1, 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 ]). 63
135
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 148
149:- dynamic
150 db_file/5, 151 db_stream/2, 152 db_dirty/2, 153 db_option/2. 154
155:- volatile
156 db_stream/2. 157
158:- multifile
159 (persistent)/3, 160 prolog:generated_predicate/1. 161
162
163 166
185
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), 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).
273
274
279
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 296
310
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, _, _, _), 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 ).
420
424
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)).
431
435
436db_attached(Module:File) :-
437 db_file(Module, File, _Created, _Modified, _EndPos).
438
444
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), 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 ).
487
488
496
497db_detach :-
498 context_module(Module),
499 db_sync(Module:detach),
500 db_clean(Module).
501
502
511
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 ).
534
540
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 ).
559
560
564
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)).
582
613
614db_sync(Module:What) :-
615 db_sync(Module, What).
616
617
618db_sync(Module, reload) :-
619 \+ db_stream(Module, _), 620 db_file(Module, File, _Created, ModifiedWhenLoaded, _EndPos),
621 catch(time_file(File, Modified), _, fail),
622 Modified > ModifiedWhenLoaded, 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(_, _).
691
692
696
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 706
707close_dbs :-
708 forall(retract(db_stream(_Module, Stream)),
709 close(Stream)).
710
711:- at_halt(close_dbs).