1:- module( lib, [
    2                    op( 200, fy, & ),
    3                    lib/1, lib/2   % +Repo[, +Opts]
    4        ] ).    5                     % lib_suggests/1,  % fixme: feature()
    6                     % lib_promise/2,
    7                     % lib_expects/1+2,
    8                     % lib_init/1
    9
   10:- ensure_loaded(library(apply)).        % exclude/3, ...
   11:- ensure_loaded(library(lists)).        % append/3, ...
   12:- ensure_loaded(library(debug)).        % debug/1+3, ? 
   13:- ensure_loaded(library(filesex)).      % directory_file_path/3,...
   14:- ensure_loaded(library(prolog_pack)).  % query_pack_server/3
   15
   16:- ensure_loaded('../src/lib_init').   17:- ensure_loaded('../src/lib_load').   18:- ensure_loaded('../src/lib_type').   19:- ensure_loaded('../src/lib_auxil').   20:- ensure_loaded('../src/lib_attach').   21:- ensure_loaded('../src/lib_homonyms').   22:- ensure_loaded('../src/lib_suggests').   23:- ensure_loaded('../src/lib_expects').   24:- ensure_loaded('../src/lib_promise').   25:- ensure_loaded('../src/lib_message').   26:- ensure_loaded('../src/lib_pack_install').   27
   28:- dynamic(lib_tables:lib_repo/4).             % +Repo, +Type, +Root, +Load 
   29:- dynamic(lib_tables:lib_repo_index/2).       % +Repo, +IdxFile
   30:- dynamic(lib_tables:lib_repo_homonyms/2).    % +Repo, +SrcDir
   31:- dynamic(lib_tables:lib_context/2).          % +Ctx, +Root
   32:- dynamic(lib_tables:lib_index/4).            % +Pa, +Pn, +Repo, +File. records loaded indices
   33:- dynamic(lib_tables:lib_promise/2).          % +Pids, +Cxt, +Load. hot swap Pid with loading Load
   34:- dynamic(lib_tables:lib_homonym/3).          % +Stem, +Repo, +File. record loaded homonym
   35:- dynamic(lib_tables:lib_loaded_index/2).     % +Repo, +File. tracks loaded index files
   36:- dynamic(lib_tables:lib_loaded_homonyms/2).  % 
   37:- dynamic(lib_tables:lib_attached_indices/2). % +Ctx, Repo
   38:- dynamic(lib_tables:lib_attached_homonyms/2).% +Ctx, Repo
   39:- dynamic(lib_tables:lib_lazy/1).             % +Repo
   40:- dynamic(lib_tables:lib_full/2).             % +Repo
   41:- dynamic(lib_tables:lib_packs_at/2).         % +Repo, +Dir
   42:- dynamic(lib_tables:lib_skeleton_only/1).    % +Pack
   43
   44:- multifile(user:lib_code_loader/3 ).   45
   46user:lib_code_loader(bioc, lib, lib_bioc).
   47user:lib_code_loader(r, lib, lib_r).
   48
   49% values: auto, allow option to override if set to true; false: never warn; true: always warn; install: install if missing
   50:- Opts = [access(read_write),type(atom),keep(true)],
   51   create_prolog_flag(lib_suggests_warns, auto, Opts).   52
   53lib_bioc( Rlib, Opts ) :-
   54    lib_r( Rlib, [bioc(true)|Opts] ).
   55
   56lib_r( Rlib, Opts ) :-
   57     ( functor(Rlib,c,_) ->
   58          Rlib =.. [c|Rlibs]   
   59          ;
   60          ( is_list(Rlib) -> 
   61               Rlibs = Rlib
   62               ;
   63               Rlibs = [Rlib]
   64          )
   65     ),
   66     maplist( lib_r_opts(Opts), Rlibs ).
   67
   68lib_r_opts( Opts, Rlib ) :-
   69     string( Rlib ),
   70     !,
   71     atom_string( RlibAtm, Rlib ),
   72     lib_r( RlibAtm, Opts ).
   73lib_r_opts( _Opts, Rlib ) :-
   74     getenv( 'R_LIB_REAL', RlibRealPath ),
   75     atomic_list_concat( RlibDirs, ':', RlibRealPath ),
   76     member( Rdir, RlibDirs ),
   77     member( Ext, ['','r','R'] ),
   78     file_name_extension( Rlib, Ext, Rbase ),
   79     directory_file_path( Rdir, Rbase, Rfile ),
   80     exists_file( Rfile ),
   81     !,
   82     r_call( source(+Rfile), [] ).
   83lib_r_opts( Opts, Rlib ) :-
   84    memberchk( suggest(Sugg), Opts ),
   85    current_prolog_flag( lib_suggests_warns, SuggFlag ),
   86    (Sugg == true ; SuggFlag == debug; SuggFlag == install),
   87    !,
   88    ( current_predicate(real:r_call/2) ->
   89        true
   90        ;
   91        catch(use_module(library(real)),_,true)
   92    ),
   93    ( current_predicate(real:r_call/2) ->           
   94        real:r_call(rownames('installed.packages'()), [rvar(Rlibs)]),
   95        ( memberchk(Rlib,Rlibs) ->
   96            ( (debugging(lib);SuggFlag==debug) ->
   97                Mess = 'Loading installed R library: ~w',
   98                lib_message_report( Mess, [Rlib], informational )
   99                ;
  100                true
  101            ),
  102            r_lib_sys( Rlib )
  103            ;
  104            % not-installed Rlib...
  105            % fixme: clarify logic of warnings...
  106            ( memberchk(suggests_warns(false),Opts) ->
  107                true   % no warning, successed 
  108                ;
  109                ( (SuggFlag==install ; SuggFlag==debug)  -> 
  110                    ( prolog_pack:confirm( contact_r_server(Rlib), yes, [] ) ->
  111                        ( memberchk(bioc(true),Opts) ->
  112                            real:r_call( requireNamespace("BiocManager",quietly='TRUE'), [rvar(BiocX)] ),
  113                            (BiocX == true -> true; real:r_call('install.packages'("BiocManager"),[])),
  114                                real:r_call('BiocManager::install'(+ Rlib),  []),
  115                                real:r_call(library(Rlib), [])
  116                                ;
  117                                real:r_call('install.packages'(+ Rlib),  []),
  118                                real:r_call(library(Rlib), [])
  119                        )
  120                    ;
  121                    true
  122                    )
  123                )
  124                ;
  125                fail
  126            )
  127        )
  128        ;      % if it is still not installed 
  129        Mess1 = 'You need to install SWI-Prolog lib Real before you can lib/1-load R library: ~w',
  130        lib_message_report( Mess1, [Rlib], informational )
  131    ).
  132lib_r_opts( _Opts, Rlib ) :-
  133    r_lib_sys( Rlib ).
  134
  135r_lib_sys( Rlib ) :-
  136     current_prolog_flag( real_suppress_lib_messages, false ),
  137     !,
  138     r_library_codes( Rlib, '', '', Rcodes ), % fixme to atom
  139     atom_codes( R, Rcodes ),
  140     real:r_send(R).
  141r_lib_sys( Rlib ) :-
  142     Pre = 'suppressPackageStartupMessages(',
  143     r_lib_codes( Rlib, Pre, ')', Rcodes ),
  144     atom_codes( R, Rcodes ),
  145     real:r_send( R ).
  146r_lib_codes( Rlib, Pre, Post, Rcodes ) :-
  147     ( is_list(Rlib) -> Rlib=Rlibs; Rlibs = [Rlib] ),
  148     atomic_list_concat( Rlibs, ',', RlibsAtm ),
  149     atomic_list_concat( [Pre,'library(',RlibsAtm,')',Post], RlibCallAtm ),
  150     atom_codes( RlibCallAtm, Rcodes ).
  151
  152% fixme: user defined ones
  153lib_src_sub_dir(src).
  154lib_src_sub_dir('src/lib').
  155lib_src_sub_dir('src/auxil' ).

Predicate based code development.

This pack implements methods for loading code into SWI Prolog programs.

Main innovations

Lazy loading

One of the major innovations the library introduces, is that of progressive, lazy loading of packs. That is, if only a specific predicate is (lazily) required from a pack(lib)-aware pack, only that and its dependent code will be loaded.

That is, your code can load things like

?- lib( stoics_lib:kv_compose/3 ).
?- lib( stoics_lib:kv_decompose/3 ).

and only the relevant parts of the pack(stoics_lib) will be loaded.

If later on your code decides to do a

?- lib(stoics_lib).

The remainder of the library loads up quietly and politely.

Please note that this is, at top level at least, orthogonal to any other loading.

You can still do

?- use_module( library(stoics_lib) ).

and get the whole thing into memory.

A good example of how to create a lazy pack is pack(stoics_lib), http://stoics.org.uk/~nicos/sware/stoics_lib v0.3. An example of how to lazy load things from stoics_lib is the latest pack(debug_call) http://stoics.org.uk/~nicos/sware/debug_call v0.4.

Cells

As of version 2.0 the pack supports hierarchical module de-composition.

A cell compose pack, is build by a skeleton module that all cells depend on and then a number of independent cells that can be loaded independently as well as in combination.

There are at least 2 reasons why one would like decomposable modules: (a) resources, and (b) clarity of interface. Only loading parts of a module can result in smaller memory consumption as irrelevant bits are not loaded. Also, if modules have long lists of defined predicates, like bio_db v2.0, then loading only conceptually clear sub-set of a module allows programmer to focus on the predicates that are relevant to a specific task.

pack(bio_db) was the driving force for developing cell based packs and it provides natural cell units. At the top level there are two cells, hs for human biological data and mouse for mouse data. Each cell is further broken to a number of cells each corresponding to the source database where data is converted from. For instance hs contains sub-cells: ense, gont, hgnc, ncbi, pros, strg and unip.

See pack(bio_db/cell/hs.pl) and pack(bio_db/cell/mouse.pl).

Cell based pack can still be viewed and loaded as normal module files. For instance,

?- use_module(library(bio_db)).

Loads the whole interface (all cells), without the user needing to be aware of anything. The only difference is that the user will not be able to see all the module predicates at the first line of file pack(bio_db/prolog/bio_db.pl)).

?- lib(bio_db).

Also loads everything.

?- lib(& bio_db).

Loads the skeleton of the module (cells usually load the module dependencies like this). That is, file pack(prolog/bio_db.pl), but not the cell files in pack(cell/ * ).

?- lib(& bio_db(hs)).

Loads hs cell, which in this case comprises of number of sub-cells.

?- lib(& bio_db(hs)).

Loads hs cell (and skeleton). hs comprises of a number of sub-cells.

?- lib(& bio_db(hs(hgnc))).

Loads the hs/hgnc primary cell (and the skeleton).

?- use_module( pack('bio_db/cell/hs/hgnc') ).
?- lib(@ bio_db)

Loads all sub-cells of a library.

?- load_files( library(bio_db) ).

Will load everything even if cell based loading ahs taken place. (use_module(library(bio_db)) would work.)

Suggested code

The library supports suggested loading and code execution. These operations are meant for fringe features that are not, by default reported if missing. Reporting in form of warnings can be turned on by either setting flag lib_suggests_warns to true (globally controlled), or passing option (local, controlled by developer).

Prolog lag lib_suggests_warns can take values:

auto
(default flag value), silent by default unless loading code presents option suggests_warns(true)
false
never warn when suggested features are missing
true
always warn when features are missing.
:- lib(suggests(wgraph),[]).
:- lib(real).
:- lib(suggests(call(lib_r("GGally"),[]).

Other features

General points

Pack(lib) plays reasonably well with the documentation server. Bar, the normal limitations of the server. By convention and to help locating the module docs, lazy packs should define (Pack)/0 predicate in same file as the mods docs. Searching for that on doc server, should make it easy enough to get to it.

Although this library, pack(lib), contains a number of involved features it can also be used as a straight forward shorthand, replacement for use_module(library(Lib)).

 ?- lib(Atomic).

is equivelant to use_module(library(Atomic)) if Atomic is a system library or an installed Pack, while it will interogate the SWI pack server for matching packs if Atomic is atomic and not an installed pack.

In addition the library allows for loading with initializations turned off.

Repositories

Code is managed in repositories (also repo) that can be either packs or libs (ie local directories).

A pack is a unit of programs as managed by built-in SWI package manager (library(prolog_pack)). A lib (library) is a directory containing a number of program files.

pack(lib) supports a number of ways to organise your code and load it, but it comes to its own when code s organised as predicate-in-a-file fashion. In this mode of development a predicate such as kv_decompose/3 would be defined on file kv_decompose.pl which will only containing code for defining this predicate, with the possible exception of helper predicates that are too specific to be of outside interest.

kv_decompose( [], [], [] ).
kv_decompose( [K-V|T], [K|Tk], [V|Tv] ) :-
    kv_decompose( T, Tk, Tv ).

Lib code is considered as coming from the special pack user.

Code-tables

Associated with each repository are 2 types of code-tables: (code-)_indices_ and (file-)_locators_.

A code-index maps a predicate identifier along with its source repo to an absolute file name of the source that defines it. Indices are of the form:

lib_tables:lib_index( Pname, Parity, Repo, AbsFile ).

File locators store all filenames in a repository. These can be named matched predicate names that need to be loaded. pack(lib) can be directed to assume that files from a specific repository exhibit this homonyms property. Locators are of the form:

lib_tables:lib_homonym( Stem, Repo, AbsFile ).

For each index file loaded for a repository, the following is asserted:

lib_tables:lib_loaded_indices(Repo,File)

and for each locator

lib_tables:lib_loaded_homonyms(Repo,Stem,File)

When loading a repository the user can choose whether to load indices and locators independently.

Loading source code

During the process of loading code into memory, lib/1 and /2 directives are used to locate code to which the specific code depends.

There are three main categories of operations:

These operations are all specific to the loading context. This is achieved by creating meta-predicates that identify which part of the repository base each context has access to.

Attachment of repository is registered via lib_tables:lib_attached_indices(To,PackIG) and lib_tables:lib_attached_homonyms(To,PackFG).

lib_tables:lib_attached_indices(bims,options).
lib_tables:lib_attached_homonyms(bims,false).

attaches the indices but not the file locators.

Since all code from directory-libs load to a single module (user), loading code has either access to all such code, or to none.

Loading R and bioconductor libraries

Lib also knows how to install R (r()) and bioconductor (bioc()) libraries. As of version of 2:11 these can be c() terms or lists. The library names can be given as atoms or strings. Both r() and bioc() will load the libraries if they are installed (bioconductor libs are R libs, but they are installed differently). If the libraries need to be intalled the correct term should be used.

As per Prolog, the user will be asked to install these libraries if they are not found on the system.

?- lib(r(gridExtra)).
?- lib(bioc("ALL")).

?- lib(r(c('data.table',"Matrix"))).
% Loading installed R library: data.table
% Loading installed R library: Matrix
true.

?- lib(r(["reticulate",ggplot2])).
% Loading installed R library: reticulate
% Loading installed R library: ggplot2
true.

Conventions

Packs are expected to have matching top directories and main files. The main file of a pack should be within top directory prolog/. (The directory convention is set by library(prolog_pack)). For example for pack bims the following file should exist in packs directory:

bims/prolog/bims.pl

For packs the main code directory is src/. Additionally src/lib and src/auxil are treated as code directories.

Internals

Variables

Repo
repository
Pack
prolog pack (installed or locally addressed)
Lib
directory containing code
Root
absolute reference to the root directory of a Repo
Pn
predicate name
Idx
library index term
Hmn
library file homonym term
Pa
predicate arity
Cxt
context module

Predicate names

Pack info

This is a complete re-write of pack(requires) v1.1.

Listens to debug(lib).

author
- nicos angelopoulos
version
- 1.0 2017/3/6
- 1.1 2017/3/9, lazy loading
- 1.2 2017/3/11, fixed missing cut, added lib(version(V,D))
- 1.3+4 2017/8/8, fixed multi-source for user, improved contact to server, install while lazy loading
- 1.5 2017/8/15
- 1.6 2018/3/18, lib/2 suggests(), lib/2, promise() via hot-swapping, private packs
- 1.7 2018/4/5, auto-install missing was broken
- 2.2 2018/11/26, cell based module compositionality, & operator (by default load everything)
- 2.3 2019/4/18, lib_code_loader/3 hook & lib_r/2, suggests failure messages via lib_suggests_warns flag & options
- 2.4 2019/4/22, small fix release
- 2.5 2019/5/8, bioc (for bioconductor) load term
- 2.6 2020/3/8, fixed cell-loading warnings
- 2.7 2020/3/8, compatibility with pack changes in SWI-8.2, fixed layout breaking tags
- 2.8 2020/9/18, minor changes, library(lists) explicit loading + info messages
- 2.9 2021/1/23, honour developer suggests_warns(false), logic needs further work
- 2.10 2022/12/29 bring up to date for bio_db 4:0
- 2.11 2025/3/29 r() and bioc() can load lists and c() multis, fixed cell non-export lib/1 warning
See also
- http://stoics.org.uk/~nicos/sware/lib

*/

  483lib_defaults( pack, [load(true),index(true),homonym(true),type(pack),mode(self)] ).
  484lib_defaults( lib, [load(false),index(true),homonym(true),type(lib),mode(self)] ).
  485lib_defaults( [suggest(true)] ).
 lib(+Operand)
 lib(+Operand, +Opts)
Loads code or/and indices of Repo into the current context.

When Repo homonym(Repository) then only the homonims of local dir (adjusted for pack dir structure) are added to as coming from Repository.

Operand
One of
homonyms(From)
attach homonyms From pack
init(Lib)
init(Lib, Cxt)
declare initilization call (library can be loaded without this firing, if so needed, as is the case for lib_mkindex/1)
suggests(Lib)
suggests(Lib, SugOpts)
it is likely you need Lib for full functionalilty. If Lib is a known library it is loaded other wise nothing is loaded.
This is useful for fringe functionalities that depend on external libraries, where we do not want the average user to do anything if library (Lib) is not there. See lib_suggests/2 for details of how to enable warning messages.
promise(Pred, Load)
Pred is needed for functionality and it can be found by loading Load, but it will only happen at Pred's first call.
expects(Pid, Mess)
expects(Pid, Mess, Call)
complains if Pid is not defined at loading time. Mess should be a debug style message with one ~w which will be called with Pid as its printing argument. If call is present, is called after the printing of the message.
version(Vers, Date)
return version and publication date

Opts

index(Idx)
whether to load indices
homonym(Hnym)
whether to load homonym file-locators
load Load
whether to load the main entry point of Repo
mode Mode=self
makes missing message more acurate (other value: suggests)
suggest(Dn=true)
suggest the library is downloaded if it is not locally installed ?
type(Type)
enforce a particular type of repository (pack or lib)

The defaults depend on whether Repo is a pack or a lib.

opts(Opts=PackDefs)
PackDefs= [load(true),index(true),homonym(false),type(pack)]
opts(Opts=LibDefs)
LibDefs = [load(false),index(true),homonym(true),type(lib)]

When invoked with code attaching operands (SysLibrary, Pack or Lib) the predicate will first load anything that needs to be loaded in their native module and then import predicates from that module. Attaching a lib or pack means that the predicates pointed to by indices and by file name from the target pack/lib become available to the importee. Option index(Idx) controls whether LibIndex.pl based indices are attahced whereas homonym(Hmns) control the attachment of the file names from within the filesystem of the target.

For example to only import the interface predicates of pack ex1 use

?- lib(ex1, [type(pack),load(true),index(false),homonym(false)]).

Assume that ex1 is a pack that is not installed on your Prolog installation, but you have its sources unpacked on local dir /tmp/ex1/ you can load it interface predicates with:

For example to only import the interface predicates of pack ex1 use

?- lib('/tmp/ex1', [type(pack),load(true),index(false),homonym(false)]).

Assume there is a file src/lib/foo.pl in ex1 defining predicate foo/1, then you can load its code with

?- lib('/tmp/ex1', [type(pack),load(true),index(false),homonym(true)]).
?- lib(foo/1).

The above will first load foo.pl (by means of matching its filename to the predicate name) into ex1: and then assuming that this loaded foo/1 it will import it into current context (here this is =user+).

Assuming foo.pl also defines predicate bar/2 and there is a file src/LibIndex.pl within ex1 containing the line

lib_index( bar, 2, swipl(_), user, 'lib/foo.pl' ).

Then the code for foo_bar/2 can be loaded with

?- lib('/tmp/ex1', [type(pack),load(true),index(true),homonym(false)]).
?- lib(bar/2).

Pack lib can be used to create and access skeleton packs. These packs, may load very little interface code but their code base can be loaded on demand and piece-meal. That is if a specific non-interface predicate is required, it will be located and loaded along with all its dependencies.

An example of such a pack is stoics_lib. The following commands: 1. load the minimal interface,, 2, load the code for a specific non-interface predicate.

?- lib(stoics_lib).
?- lib(kv_decompose/3).

The above two directives can be shortened to:

?- lib(stoics_lib:kv_decompose/3).

Current version can be found by:

?-
    lib( version(Vers,Date) ).
Vers = 2:11:0,
Date = date(2025, 3, 29).
author
- nicos angelopoulos
version
- 2:11 2025/3/29
To be done
- when predicate is missing from stoics_lib while loading from b_real, we get clash between main and lazy, error should be clearer (the pred select_all/3 was actually not defined in file either)

*/

  611lib( Repo ) :-
  612    % fixme: add alias() command
  613    lib( Repo, [] ).
  614
  615lib( Repo, ArgS ) :-
  616    lib_loading_context( Cxt ),
  617    lib_en_list( ArgS, Args ),
  618    lib_defaults( Defs ),
  619    append( Args, Defs, Opts ),
  620    lib( Repo, Cxt, Opts ).
  621
  622lib( Lib, Cxt, Args ) :-
  623    debug( lib, 'lib directive: ~w, in context: ~w, with opts: ~w', [Lib,Cxt,Args] ),
  624    fail.
  625lib( Pn/Pa, Cxt, Args ) :-
  626    !,
  627    lib_load( Cxt, Pn, Pa, Args ).
  628lib( Repo:Pn/Pa, Cxt, Args ) :-
  629    !,
  630    lib_explicit( Repo, Pn, Pa, Cxt, Args ).
  631lib( External,  Cxt, Opts ) :-
  632    compound( External ),
  633    External =.. [Alias,Lib],
  634    user:lib_code_loader( Alias, Mod, Pname ), 
  635    !,
  636    Goal =.. [Pname,Lib,Opts],
  637    ( catch(Mod:Goal,_,fail) ->
  638        true
  639        ;
  640        memberchk( suggest(Sugg), Opts ),
  641        lib_missing( Sugg, Lib, Cxt, Opts, true )
  642    ).
  643
  644lib( homonyms(Repo), _, _Args )  :-   
  645                  % load local homonyms as coming from Repo. can be added to
  646                  % pack to indicate that LibIndex is incomplete or missing 
  647                  % by default packs do not load their homonyms
  648    !,
  649    lib_homonyms( Repo ).
  650lib( source(Src), _Cxt, Opts ) :-
  651    !,
  652    lib_source( Src, Opts ).
  653lib( end(Src), _Cxt, Opts ) :-
  654    lib_source_end( Src, Opts ).
  655
  656% lib( alias(Alias), Cxt, Opts ) :-
  657    % !,
  658    % lib_alias( Alias, Cxt, Opts ).
  659lib( version(V,D), _, _Args ) :-
  660    !,
  661    % V = 2:10:0, D = date(2022,12,29).
  662    V = 2:10:1, D = date(2024,11,19).
  663lib( suggests(Lib), _, _Args ) :- 
  664    !,
  665    lib_suggests( Lib ).
  666lib( suggests(Lib,SgOptS), _, _Args ) :-
  667    !,
  668    lib_en_list( SgOptS, SgOpts ),
  669    lib_suggests( Lib, SgOpts ).
  670lib( promise(PidS,Load), Cxt, _Args ) :-
  671    !,
  672    lib_promise( PidS, Cxt, Load ).
  673lib( expects(Lib,Mess), _, _Opts ) :-
  674    !,
  675    lib_expects( Lib, Mess ).
  676lib( expects(Lib,Mess,Goal), _, _Opts ) :-  % fixme: add note() option 
  677    !,
  678    lib_expects( Lib, Mess, Goal ).
  679lib( init(Lib), Cxt, _Opts ) :-
  680    !,
  681    lib_init( Lib, Cxt ).
  682lib( sys(SysLib), Cxt, _Opts ) :-
  683    !,
  684    % AbsOpts = [access(read),file_errors(fail),file_type(prolog)],
  685    % absolute_file_name(library(SysLib), AbsLib, AbsOpts ),
  686    absolute_file_name(library(SysLib), AbsLib ),
  687    % fixme: need map from SysLib -> Repo
  688    lib_retract_lazy( SysLib, WasLazy ),
  689    lib_sys_lazy( WasLazy, SysLib, AbsLib, ', expected,', Cxt ).
  690% testing: lib( & (bio_db(hs)) ). % which contains hgnc
  691%  map_hgnc_hgnc_symb(H,'LMTK3').
  692lib( @(Pack), Cxt, _Opts ) :-
  693    atomic( Pack ),
  694    absolute_file_name( pack(Pack), PackD, [file_type(directory),access(exist)] ),
  695    !,
  696    ( lib_tables:lib_skeleton_only(Pack) -> % fixme: shall we check it is the first one ?
  697        true
  698        ;
  699        directory_file_path( PackD, cell, CellsD ),
  700        ( exists_directory(CellsD) -> 
  701            directory_files( CellsD, AllOses ),
  702            findall( Os, (member(Os,AllOses),file_name_extension(_,pl,Os)), Oses ),
  703            debug( lib, 'Loading of all cells found pl files: ~w', [Oses] ),
  704            findall( Os, ( member(Os,Oses), directory_file_path(CellsD,Os,CellF),
  705                       %fixme: this: assumes module is same as pack ...
  706                       debug( lib, 'Loading of cells is loading: ~w', [CellF] ),
  707                       Pack:ensure_loaded(CellF),
  708                       directory_file_path(Pack,cell,RelCellP),
  709                       directory_file_path(RelCellP,Os,RelOs),
  710                       lib_export_cell(Pack,RelOs,Cxt)
  711                     ),
  712                        _OsesDash 
  713               )
  714            ; 
  715            % fixme: print warning ?
  716            debug( lib, 'Loading directory only as cells cannot be located for: ~w', Pack )
  717        )
  718    ).
  719lib( &(Pack), Cxt, _Opts ) :-
  720    atomic( Pack ),
  721    % absolute_file_name( pack(Pack), PackD, [file_type(directory),access(exist)] ),
  722    !,
  723    asserta( lib_tables:lib_skeleton_only(Pack) ),
  724    debug( lib, 'Loading of ampersand pack with: ~w', [Cxt:use_module(library(Pack))] ),
  725    Cxt:use_module( library(Pack) ),
  726    once( retract(lib_tables:lib_skeleton_only(Pack)) ).
  727
  728lib( &(CellIn), Cxt, Opts ) :-
  729    !,
  730    lib_cell( CellIn, Main, Cell, Opts ),
  731    % Cxt:use_module( library(Main) ),
  732    asserta( lib_tables:lib_skeleton_only(Main) ),
  733    debug( lib, 'Loading of ampersand cell (~w) with: ~w', [CellIn,Cxt:use_module(library(Main))] ),
  734    Cxt:use_module( library(Main) ),
  735    once( retract(lib_tables:lib_skeleton_only(Main)) ),
  736
  737    atomic_list_concat( [Main,Cell], '/', Full ),
  738    Main:ensure_loaded( pack(Full) ),
  739    lib_export_cell( Main, Full, Cxt ).
  740lib( Repo, Cxt, Opts ) :-
  741    lib_tables:lib_lazy( Repo ),
  742    !,
  743    lib_lazy_no_more( Repo, Cxt, Opts ).
  744lib( Repo, Cxt, _Args ) :-
  745    lib_tables:lib_packs_at( Cxt, PrivPacksD ),
  746    directory_file_path( PrivPacksD, Repo, PackRoot ),
  747    directory_file_path( PackRoot, prolog, PackPrologD ),
  748    directory_file_path( PackPrologD, Repo, PrologStem ),
  749    file_name_extension( PrologStem, pl, PlF ),
  750    exists_file( PlF ),
  751    !,
  752    debug( lib, 'Loading from private pack with entry point: ~p', PlF ),
  753    % ensure_loaded( PlF ).
  754    lib_defaults( pack, PackLoadDefs ),
  755    lib( Repo, PackRoot, PlF, Cxt, PackLoadDefs ).
  756lib( Repo, Cxt, Args ) :-
  757    lib_type( Repo, RepoType, RepoMod, RepoRoot, RepoLoad ),
  758    !,
  759    lib_reg_repo( RepoMod, RepoType, RepoRoot, RepoLoad, Exists ),
  760    MsId = 'Identified repo: ~w as: ~w, loading in: ~w, with root: ~w',
  761    debug( lib, MsId, [Repo,RepoType,RepoMod,RepoRoot] ),
  762    lib_defaults( RepoType, Defs ),
  763    append( Args, Defs, Opts ),
  764    lib( Exists, RepoMod, RepoRoot, RepoLoad, Cxt, Opts ).
  765lib( SysLib, Cxt, _Args ) :-
  766    AbsOpts = [access(read),file_errors(fail),file_type(prolog)],
  767    absolute_file_name(library(SysLib), AbsLib, AbsOpts ),
  768    lib_retract_lazy( SysLib, WasLazy ),
  769    lib_sys_lazy( WasLazy, SysLib, AbsLib, '', Cxt ),
  770    !.  % fixme: is this too late in the body?
  771    
  772    /*
  773    Assert = asserta( lib_tables:lib_full(SysLib,AbsLib) ),
  774    Goal = Cxt:use_module(library(SysLib)),
  775    Retract = retract(lib_tables:lib_full(SysLib,AbsLib) ),
  776    setup_call_cleanup(Assert, Goal, Retract),
  777    % catch( Cxt:use_module(library(SysLib)), _, fail ),
  778    !,
  779    debug( lib, 'System library: ~w, loaded in: ~w', [SysLib,Cxt] ).
  780    */
  781lib( Repo, Cxt, Args ) :-
  782    lib_tables:lib_repo(Repo,Type,Root,Load),
  783    !,
  784    lib_repo( Repo, Type, Root, Load, Cxt, Args ).
  785lib( Root, Cxt, Args ) :-
  786    lib_tables:lib_repo(Repo,Type,Root,Load),
  787    !,
  788    lib_repo( Repo, Type, Root, Load, Cxt, Args ).
  789lib( Pack, Cxt, Opts ) :-
  790    memberchk( suggest(Sugg), Opts ),
  791    lib_missing( Sugg, Pack, Cxt, Opts, true ),
  792    !.
  793lib( Repo, Cxt, Opts ) :-
  794    compound( Repo ),
  795    lib( &(Repo), Cxt, Opts ),
  796    !.
  797lib( Repo, Cxt, Opts ) :-
  798    memberchk( mode(Mode), Opts ),
  799    lib_not_found( Mode, Repo, Cxt ).
  800
  801lib_cell( CellIn, Main, Cell, _Opts ) :-
  802    compound( CellIn ),
  803    !,
  804    lib_term_dir( CellIn, true, Main, Cell ).
  805lib_cell( CellIn, Pack, Cell, Opts ) :-
  806    % options( pack(Pack), Opts ),
  807    memberchk( pack(Pack), Opts ),
  808    !,
  809    lib_term_dir( CellIn, false, Pack, Cell ).
  810    % lib_cell_pack( Pack, CellIn, Main, Cell, Opts ).
  811lib_cell( CellIn, _Main, _Cell, Opts ) :-
  812    throw( cannot_locate_cell_with_options(CellIn,Opts) ).
  813
  814lib_retract_lazy( SysLib, WasLazy ) :-
  815    lib_tables:lib_lazy(SysLib),
  816    !,
  817    WasLazy = true.
  818lib_retract_lazy( _SysLib, false ).
  819
  820lib_sys_lazy( _, SysLib, AbsLib, ExplicitTkn, Cxt ) :-
  821    lib_sys( SysLib, AbsLib, ExplicitTkn, Cxt ),
  822    !.   % don't need to reassert it as it is now fully loaded
  823lib_sys_lazy( true, SysLib, _AbsLib, _ExplicitTkn, _Cxt ) :-
  824    asserta( lib_tables:lib_lazy(SysLib) ),
  825    fail.
  826
  827lib_sys( SysLib, AbsLib, ExplicitTkn, Cxt  ) :-
  828    Assert = asserta( lib_tables:lib_full(SysLib,AbsLib) ),
  829    Goal = Cxt:use_module(library(SysLib)),
  830    Retract = retract(lib_tables:lib_full(SysLib,AbsLib) ),
  831    setup_call_cleanup(Assert, Goal, Retract),
  832    debug( lib, 'System~w library: ~w, loaded in: ~w', [ExplicitTkn,SysLib,Cxt] ).
  833
  834lib_not_found( self, Repo, _Cxt ) :-
  835    Mess = 'Failed to locate library:~w, (no local lib, local pack or remote pack)',
  836    lib_message_report( Mess, [Repo], informational ).
  837lib_not_found( suggests, Repo, _Cxt ) :-
  838    Mess = 'Failed to locate suggested library:~w, (no local lib, local pack or remote pack)',
  839    lib_message_report( Mess, [Repo], informational ).
  840
  841lib_explicit( Repo, Pn, Pa, Cxt, _Opts ) :-
  842    lib_tables:lib_full(Repo,_),
  843    !,   % this should be able to cope with cyclic dependencies? 
  844         % check with options
  845    Cxt:import( Repo:Pn/Pa ).
  846lib_explicit( Repo, Pn, Pa, Cxt, _Opts ) :-
  847    current_predicate( Repo:Pn/Pa ),
  848    !,
  849    lib_import_existing( Repo, Pn/Pa, Cxt ).
  850lib_explicit( Repo, Pn, Pa, Cxt, Opts ) :-
  851    lib_type( Repo, Type, Rmod, Root, Load ),
  852    lib_repo_lazy_assert( Rmod ),
  853    lib_explicit_repo( Type, Repo, Rmod, Root, Load, Pn, Pa, Cxt, Opts ),
  854    !.
  855lib_explicit( Repo, Pn, Pa, Cxt, Opts ) :-
  856    memberchk( suggest(Sugg), Opts ),
  857    lib_missing( Sugg, Repo, Cxt, Opts, false ),
  858    !,
  859    lib_explicit( Repo, Pn, Pa, Cxt, Opts ).
  860lib_explicit( Repo, Pn, Pa, Cxt, _Args ) :-
  861    % 17.03.24; the following 2 lines create a cycle
  862    % lib( Repo, Cxt, Args ),
  863    % lib( Pn/Pa, Cxt, [repo(Repo)|Args] ).
  864    Mess = 'Failed to locate: ~w within explicit repository:~w, within context: ~w',
  865    lib_message_report( Mess, [Pn/Pa,Repo,Cxt], error ).
  866
  867lib_explicit_repo( pack, Repo, Rmod, Root, Load, Pn, Pa, Cxt, Opts ) :-
  868    file_name_extension( LoadStem, pl, Load ),
  869    atomic_concat( LoadStem, '_lazy', LazyStem ),
  870    file_name_extension( LazyStem, pl, LazyF ),
  871    ( exists_file(LazyF) ->
  872        true
  873        ; 
  874        Mess = 'Lazy loading file: ~w does not exist (context: ~w)',
  875        lib_message_report( Mess, [LazyF,Cxt], informational),
  876        fail
  877    ),
  878    lib_defaults( pack, Defs ),
  879    append( Opts, Defs, All ),
  880    lib( Rmod, Root, LazyF, Cxt, All ),
  881    % ensure_loaded( Rmod:LazyF ),
  882    % lib_reg_repo( Repo, pack, Root, LazyF ),
  883    lib( Pn/Pa, Cxt, [repo(Repo)|Opts] ).
  884
  885lib_repo_lazy_assert( Repo ) :-
  886    lib_tables:lib_lazy( Repo ),
  887    !.
  888lib_repo_lazy_assert( Repo ) :-
  889    asserta( lib_tables:lib_lazy(Repo) ).
  890
  891lib_missing( false, Pack, Cxt, Opts, _Load ) :-
  892    memberchk( mode(Mode), Opts ),
  893    Mode == suggests,
  894    !,
  895    current_prolog_flag( lib_suggests_warns, WarnFlag ),
  896    lib_missing_suggested( WarnFlag, Pack, Cxt, Opts ).
  897lib_missing( false, Pack, Cxt, _Args, _Load ) :-
  898    debug( lib, 'Instructed to skip contacting server for:~w and context:~w', [Pack,Cxt] ).
  899lib_missing( true, Pack, Cxt, Args, Load ) :-
  900    prolog_pack:confirm( contact_server(Pack), yes, [] ),
  901    G = query_pack_server(search(Pack), Result, [] ),
  902    catch( prolog_pack:G, _Ball, fail ),
  903    Result \== false,
  904    lib_defaults( lib, LibDefs ),
  905    append( Args, LibDefs, Opts ),
  906    memberchk( mode(Mode), Opts ),
  907    catch( prolog_pack:pack_list(Pack), _, fail ),
  908    prolog_pack:confirm( pack_on_server(Mode,Pack), yes, [] ),
  909    !,
  910    lib_pack_install( Pack ),
  911    lib_missing_load( Load, Cxt, Pack ).
  912
  913lib_missing_suggested( WarnFlag, Pack, Cxt, Opts ) :-
  914    memberchk( WarnFlag, [auto,debug,false,install,true] ),
  915    !,
  916    lib_missing_suggested_known( WarnFlag, Pack, Cxt, Opts ).
  917lib_missing_suggested( WarnFlag, _Pack, _Cxt, _Opts ) :-
  918    throw( incorrect_value_for_flag(lib_suggests_warns(WarnFlag)) ).
  919
  920lib_missing_suggested_known( auto, Pack, Cxt, Opts ) :-
  921    memberchk( suggests_warns(WarnsOpt), Opts ),
  922    ( memberchk(WarnsOpt,[true,false]) -> true; throw(incorrent_option_value_for_option(suggest_warns(WarnsOpt))) ),
  923    lib_missing_suggested_known( WarnsOpt, Pack, Cxt, Opts ).
  924lib_missing_suggested_known( debug, Pack, Cxt, Opts ) :-
  925    lib_missing_suggested_known( true, Pack, Cxt, Opts ).
  926lib_missing_suggested_known( false, Pack, Cxt, _Opts ) :-
  927    debug( lib, 'Silently ignoring suggested, and missing library: ~w, in context: ~w', [Pack,Cxt] ).
  928lib_missing_suggested_known( true, Pack, Cxt, _Opts ) :-
  929    Mess = 'Failed to load suggested library:~w, in context: ~w',
  930    lib_message_report( Mess, [Pack,Cxt], informational ).
  931
  932lib_missing_load( true, Cxt, Pack ) :-
  933    Cxt:use_module( library(Pack) ).
  934lib_missing_load( false, _Cxt, _Pack ).
  935
  936lib_import_existing( Repo, Pn/Pa, Cxt ) :-
  937    functor( Phead, Pn, Pa ),
  938    predicate_property(Repo:Phead,exported),
  939    !,
  940    debug( lib, 'Importing from existing : ~w, into: ~w', [Repo:Pn/Pa,Cxt] ),
  941    Cxt:import( Repo:Pn/Pa ).
  942lib_import_existing( Repo, Pn/Pa, Cxt ) :-
  943    functor( Phead, Pn, Pa ),
  944    predicate_property(Repo:Phead,imported_from(Mod)),
  945    !,
  946    debug( lib, 'Importing from parent: ~w, via: ~w, pred: ~w, and context: ~w', [Mod,Repo:Pn/Pa,Cxt] ),
  947    Mod:import(Repo:Pn/Pa).
  948lib_import_existing( Repo, Pn/Pa, Cxt ) :-
  949    debug( lib, 'Exporting on: ~w and then importing:~w, into: ~w', [Repo,Pn/Pa,Cxt] ),
  950    export( Repo:Pn/Pa ),
  951    Cxt:import( Repo:Pn/Pa ).
  952
  953lib_lazy_no_more( Repo, Cxt, Opts ) :-
  954    % use_module( Repo:library(Repo) ).
  955    lib_type( Repo, Type, _RepoMod, _RepoRoot, RepoLoad ),
  956    open( RepoLoad, read, In ),
  957    read( In, ModuleDfn ), 
  958    ModuleDfn = (:- module(Repo,Exports) ),
  959    lib_defaults( Type, Defs ),
  960    append( Opts, Defs, All ),
  961    maplist( lib_explicit_exports(Repo,Cxt,All), Exports ),
  962    close( In ),
  963    !.
  964lib_lazy_no_more( Repo, Cxt, Opts ) :-
  965    throw( failed_to_unset_lazy_mode_for(Repo,Cxt,Opts) ).
  966
  967lib_explicit_exports( Repo, Cxt, Opts, Pn/Pa) :-
  968    lib_explicit( Repo, Pn, Pa, Cxt, Opts ).
  969
  970% lib_alias( Alias, Cxt, Opts ) :-
  971    % !,
  972    % absolute_file_name( Alias, Dir, [access(exist)] ),
  973    % lib( Dir, Cxt, Opts ).
  974% lib_alias( Alias, _Cxt, _Opts ) :-
  975    % throw( alias_does_not_correspont_to_lib(Alias) ).
  976
  977lib( Repo, Root, Load, Cxt, Opts ) :-
  978    lib( false, Repo, Root, Load, Cxt, Opts ).
  979
  980% testing: 18.11.22:
  981/*
  982lib( true, Repo, Root, _Load, Cxt, _Opts ) :-
  983    Mess = 'lib/4, not loading anything for lib that already existed. Cxt: ~w, repo: ~w, root:~w',
  984    debug( lib, Mess, [Cxt,Repo,Root] ),
  985    !.
  986    */
  987lib( _, Repo, Root, Load, Cxt, Opts ) :-
  988    ( catch(lib_load_repo_root_index_file(Repo,Root), _, true ) -> true; true ),
  989    Setup = asserta( lib_tables:lib_context(Repo,Root) ),
  990    Goal  = lib_load_file( Load, Repo, Opts ),
  991    Clean = ( once(retract(lib_tables:lib_context(Repo,Root))) ),
  992    debug( lib, 'lib/4: ~w', setup_call_cleanup(Setup, Goal, Clean) ),
  993    setup_call_cleanup(Setup, Goal, Clean),
  994    findall( _, 
  995                    (   predicate_property(Repo:Ph,exported),
  996                        functor(Ph,Pn,Pa),
  997                        Cxt:import(Repo:Pn/Pa)
  998                    )
  999                    ,
 1000                        _ ),
 1001    memberchk( index(IdxB), Opts ),
 1002    lib_attach_indices( IdxB, Root, Repo, Cxt ),
 1003    memberchk( homonym(LocB), Opts ),
 1004    lib_attach_filenames( LocB, Root, Repo, Cxt ).
 1005
 1006lib_repo( Repo, Type, Root, Load, Cxt, Args ) :-
 1007    Mess = 'Located in memory repo:~w of type: ~w, loading in: ~w, with root: ~w',
 1008    debug( lib, Mess, [Repo,Type,Repo,Root] ),
 1009    lib_defaults( Type, Defs ),
 1010    append( Args, Defs, Opts ),
 1011    lib( Repo, Root, Load, Cxt, Opts ),
 1012    findall( _, (predicate_property(Repo:Phead,exported),functor(Phead,Pn,Pa),Cxt:import(Repo:Pn/Pa)), _ ).
 1013
 1014lib_source( Repo, Opts ) :-
 1015    prolog_load_context( directory, Base ), 
 1016    directory_file_path( Root, prolog, Base ),
 1017    !,
 1018    % next N lines accommodate for private packs...
 1019    directory_file_path( Root, src, Srot ),
 1020    directory_file_path( Srot, packs, PrivP ),
 1021    ( exists_directory(PrivP) -> assert( lib_tables:lib_packs_at(Repo,PrivP) ); true ),
 1022    % end of N lines
 1023    asserta( lib_tables:lib_context(Repo,Root) ),
 1024    ( memberchk(index(Idx),Opts) -> true; Idx = false ),
 1025    lib_source_index( Idx, Root, Repo ),
 1026    ( memberchk(homonyms(Hmns),Opts) -> true; Hmns = false ),
 1027    lib_source_homonyms( Hmns, Repo ).
 1028lib_source( Repo, Opts ) :-
 1029    compound( Repo ),
 1030    % we are within a cell of a pack...
 1031    Repo =.. [Pack,Cell],  % fixme: allow for more complex terms
 1032    prolog_load_context( directory, Base ), 
 1033    % directory_file_path( Base, src, Srot ),
 1034    atomic_list_concat( [Pack,Cell], '_', Mod ),
 1035    asserta( lib_tables:lib_context(Mod,Base) ),
 1036    ( memberchk(index(Idx),Opts) -> true; Idx = false ),
 1037    lib_source_index( Idx, Base, Mod ),
 1038    ( memberchk(homonyms(Hmns),Opts) -> true; Hmns = false ),
 1039    lib_source_homonyms( Hmns, Repo ).
 1040    
 1041lib_source_index( true, Root, Repo ) :-
 1042    lib_src_sub_dir( Sub ),
 1043    directory_file_path( Root, Sub, AbsSrc ),
 1044    directory_file_path( AbsSrc, 'LibIndex.pl', LibIndex ),
 1045    exists_file( LibIndex ),
 1046    !,
 1047    lib_load_index_file( LibIndex, Repo ).
 1048lib_source_index( false, _Root, _Repo ).
 1049
 1050lib_source_homonyms( true, Repo ) :-
 1051    % :- dynamic( lib_tables:lib_loaded_homonyms/2 ).  % 
 1052    lib_homonyms( Repo ),
 1053    !.
 1054lib_source_homonyms( false, _Repo ).
 1055
 1056lib_source_end( Repo, _Opts ) :-
 1057    compound( Repo ),
 1058    % then we are within a cell of a pack
 1059    !,
 1060    Repo =.. [Pack,Cell],  % fixme: allow for more complex terms
 1061    atomic_list_concat( [Pack,Cell], '_', Mod ),
 1062    retractall( lib_tables:lib_context(Mod,_Root1) ),
 1063    retractall( lib_tables:lib_packs_at(Mod,_) ).
 1064lib_source_end( Repo, _Opts ) :-
 1065    retractall( lib_tables:lib_context(Repo,_Root1) ),
 1066    retractall( lib_tables:lib_packs_at(Repo,_) ).
 1067
 1068lib_term_dir( DirIn, _Top, _Main, Dir ) :-
 1069    atomic( DirIn ),
 1070    !,
 1071    DirIn = Dir.
 1072lib_term_dir( LeftIn/Leaf, Top, Main, Dir ) :-
 1073    !,
 1074    lib_term_dir( LeftIn, Top, Main, Left ),
 1075    atomic_list_concat( [Left,Leaf], '/', Dir ).
 1076lib_term_dir( DirIn, Top, Main, Dir ) :-
 1077    functor( DirIn, TNm, 1 ),
 1078    !,
 1079    arg( 1, DirIn, SubIn ),
 1080    lib_term_dir( SubIn, false, Main, Sub ),
 1081    ( Top == true -> TNm = Main,
 1082                     atomic_list_concat( [cell,Sub], '/', Dir )
 1083                   ; atomic_list_concat( [TNm,Sub], '/', Dir )
 1084    ).
 1085lib_term_dir( DirIn, Top, _Main, _Dir ) :-
 1086    throw( cannot_de_term_dir(DirIn,Top) ).
 1087
 1088% import all predicates that are defined by RelCell into module defined by pack Main.
 1089lib_export_cell( Main, RelCell, Cxt ) :-
 1090    % fixme: need to doc this predicate better
 1091    lib_pack_module( Main, Cxt, Mod ),
 1092    lib_cell_module( Mod, RelCell, Cod ),
 1093    findall( Pid, (
 1094                        ( 
 1095                        predicate_property(Mod:Pid,imported_from(Cod))
 1096                        ;
 1097                        ( predicate_property(Cod:Pid,imported_from(Common)),
 1098                          predicate_property(Mod:Pid,imported_from(Common))
 1099                        )
 1100                        ),
 1101                        \+ predicate_property(Cxt:Pid,_),
 1102                        functor( Pid, Pnm, Par ),
 1103                        % export(Mod:Pid),
 1104                        % Cxt:import(Mod:Pid)
 1105                        Cxt:export(Cxt:Pnm/Par),
 1106                        Cxt:import(Cod:Pnm/Par)
 1107                  ), Pids ),
 1108    debug( lib, 'lib imported in context: ~w, from mod: ~w, having cell, ~w, the predicates: ~w', [Cxt,Main,RelCell,Pids] ).
 1109
 1110% finds the module defined by a loaded pack file...
 1111lib_pack_module( Main, Cxt, Mod ) :-
 1112    absolute_file_name( pack(Main), PackMain ),
 1113    directory_file_path( PackMain, prolog, PrologMain ),
 1114    directory_file_path( PrologMain, Main, MainF ),
 1115    file_name_extension( MainF, pl, PlF ),
 1116    exists_file( PlF ),
 1117    lib_pack_file_module( PlF, Main, Cxt, Mod ),
 1118    !.
 1119lib_pack_module( Main, Cxt, Mod ) :-
 1120    throw( cannot_locate_loaded_module_for(Main,Cxt,Mod) ).
 1121
 1122lib_pack_file_module( PlF, Main, Cxt, Mod ) :-
 1123    predicate_property( Cxt:Pred, file(PlF) ),
 1124    predicate_property( Cxt:Pred, imported_from(Mod) ),
 1125    !,
 1126    debug( lib, 'Commiting to mod: ~w, for main pack: ~w in context: ~w', [Mod,Main,Cxt] ).
 1127% fixme: we need this for ?- lib(bio_db).  use_module(library(bio_db)) works fine because of initialization delay ?
 1128lib_pack_file_module( PlF, _Main, _Cxt, Mod ) :-
 1129    exists_file( PlF ),
 1130    open( PlF, read, In ),
 1131    read( In, Term ),
 1132    close( In ),
 1133    Term = ( :- module(Mod,_) ).
 1134
 1135lib_cell_module( Mod, Rel, Cod ) :-
 1136    absolute_file_name( pack(Rel), PlF, [file_type(prolog),access(read)] ),
 1137    predicate_property( Mod:Pid, file(PlF) ), 
 1138    predicate_property( Mod:Pid, imported_from(Cod) ), 
 1139    !,
 1140    debug( lib, 'Commiting to cell mod: ~w, for main mod: ~w and relative : ~w', [Cod,Mod,Rel] ).
 1141lib_cell_module( Mod, Rel, Cod ) :-
 1142    throw( cannot_locate_loaded_module_cell(Mod,Rel,Cod) )