This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/dbload.yap

203 lines
4.2 KiB
Plaintext
Raw Normal View History

2011-04-30 01:16:40 +01:00
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: dbload.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: Compact Loading of Facts in YAP *
* *
*************************************************************************/
:- module('$db_load',
[]).
2014-04-09 12:39:29 +01:00
:- use_system_module( '$_boot', ['$$compile'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( attributes, [get_module_atts/2,
put_module_atts/2]).
2011-04-30 01:16:40 +01:00
:- dynamic dbloading/6, dbprocess/2.
2013-01-15 11:18:09 +00:00
dbload_from_stream(R, M0, Type) :-
2013-04-30 21:23:01 +01:00
repeat,
2013-01-15 11:18:09 +00:00
read(R,T),
2013-04-30 21:23:01 +01:00
( T == end_of_file -> !, close_dbload(R, Type);
2013-01-15 11:18:09 +00:00
dbload_count(T, M0),
fail
).
close_dbload(R, exo) :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
exo_db_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
close_dbload(R, exo) :-
seek(R, 0, bof, _),
exodb_add_facts(R, M),
fail.
close_dbload(R, mega) :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
dbload_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
close_dbload(R, mega) :-
seek(R, 0, bof, _),
dbload_add_facts(R, M),
fail.
close_dbload(_, _) :-
retractall(dbloading(_Na,_Arity,_M,_T,_NaAr,_Handle)),
fail.
close_dbload(_, _).
2011-04-30 01:16:40 +01:00
prolog:load_db(Fs) :-
'$current_module'(M0),
prolog_flag(agc_margin,Old,0),
dbload(Fs,M0,load_db(Fs)),
load_facts,
prolog_flag(agc_margin,_,Old),
clean_up.
dbload(Fs, _, G) :-
var(Fs),
'$do_error'(instantiation_error,G).
2013-01-07 09:47:14 +00:00
dbload([], _, _) :- !.
dbload([F|Fs], M0, G) :- !,
2011-04-30 01:16:40 +01:00
dbload(F, M0, G),
dbload(Fs, M0, G).
2013-01-07 09:47:14 +00:00
dbload(M:F, _M0, G) :- !,
2011-04-30 01:16:40 +01:00
dbload(F, M, G).
dbload(F, M0, G) :-
atom(F), !,
do_dbload(F, M0, G).
dbload(F, _, G) :-
'$do_error'(type_error(atom,F),G).
do_dbload(F0, M0, G) :-
'$full_filename'(F0,F,G),
2011-04-30 01:16:40 +01:00
assert(dbprocess(F, M0)),
open(F, read, R),
check_dbload_stream(R, M0),
close(R).
2013-01-15 11:18:09 +00:00
2011-04-30 01:16:40 +01:00
check_dbload_stream(R, M0) :-
repeat,
2013-01-09 09:21:07 +00:00
catch(read(R,T), _, fail),
2011-04-30 01:16:40 +01:00
( T = end_of_file -> !;
dbload_count(T, M0),
fail
).
dbload_count(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
% dbload_check_term(T),
(
dbloading(Na,Arity,M,_,NaAr,_) ->
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I)
;
atomic_concat([Na,'__',Arity,'__',M],NaAr),
assert(dbloading(Na,Arity,M,T,NaAr,0)),
nb_setval(NaAr,1)
).
get_module(M1:T0,_,T,M) :- !,
get_module(T0, M1, T , M).
get_module(T,M,T,M).
2013-01-07 09:47:14 +00:00
2011-04-30 01:16:40 +01:00
2013-01-07 09:47:14 +00:00
load_facts :-
2013-01-09 09:21:07 +00:00
!, % yap_flag(exo_compilation, on), !.
2013-01-07 09:47:14 +00:00
load_exofacts.
2011-04-30 01:16:40 +01:00
load_facts :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
dbload_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
load_facts :-
dbprocess(F, M),
open(F, read, R),
dbload_add_facts(R, M),
close(R),
fail.
load_facts.
dbload_add_facts(R, M) :-
repeat,
2013-01-09 09:21:07 +00:00
catch(read(R,T), _, fail),
2011-04-30 01:16:40 +01:00
( T = end_of_file -> !;
dbload_add_fact(T, M),
fail
).
dbload_add_fact(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
dbloading(Na,Arity,M,_,NaAr,Handle),
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I),
dbassert(T,Handle,I0).
2013-01-07 09:47:14 +00:00
load_exofacts :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
exo_db_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
2013-01-09 09:21:07 +00:00
load_exofacts :-
2013-01-07 09:47:14 +00:00
dbprocess(F, M),
open(F, read, R),
exodb_add_facts(R, M),
close(R),
fail.
2013-01-09 09:21:07 +00:00
load_exofacts.
2013-01-07 09:47:14 +00:00
exodb_add_facts(R, M) :-
repeat,
2013-04-30 21:23:01 +01:00
catch(protected_exodb_add_fact(R, M), _, fail),
!.
protected_exodb_add_fact(R, M) :-
repeat,
read(R,T),
( T == end_of_file -> !;
2013-01-07 09:47:14 +00:00
exodb_add_fact(T, M),
fail
).
exodb_add_fact(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
dbloading(Na,Arity,M,_,NaAr,Handle),
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I),
exoassert(T,Handle,I0).
2011-04-30 01:16:40 +01:00
clean_up :-
retractall(dbloading(_,_,_,_,_,_)),
retractall(dbprocess(_,_)),
fail.
clean_up.