1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2025, SWI-Prolog Solutions b.v.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(prolog_qlfmake,
   36          [ qlf_make/0,
   37            qlf_make/1                  % +Spec
   38          ]).   39:- use_module(library(debug)).   40:- use_module(library(lists)).   41:- use_module(library(ansi_term)).   42:- use_module(library(apply)).   43:- if(exists_source(library(pldoc))).   44:- use_module(library(pldoc)).   45:- use_module(library(prolog_source)).   46:- use_module(library(dcg/high_order)).   47
   48:- endif.

   61% :- debug(qlf_make).

 qlf_make is det

Compile all files from the system libraries to .QLF format. This is normally called as part of building SWI-Prolog. The compilation consists of these phases:

1. Prepare the compilation environment (expansion, optimization)
2. Build the aggregate .QLF files specified in aggregate_qlf/1.
3. Find all .pl files that need to a .QLF version.
4. Find the subset that need rebuilding
5. Compile these files
6. Report on the sizes

   76qlf_make :-
   77    set_prolog_flag(optimise, true),
   78    set_prolog_flag(optimise_debug, true),
   79    preload(library(apply_macros), []),
   80    preload_pldoc,
   81    qmake_aggregates,
   82    system_lib_files(Files),
   83    include(qlf_needs_rebuild, Files, Rebuild),
   84    report_work(Files, Rebuild),
   85    qcompile_files(Rebuild),
   86    size_stats(Files).

 qlf_make(+Spec) is det

Ensure a .QLF version of Spec. If the .QLF file for Spec does not exist, is incompatible or one of its source files has changed, run qcompile/1 to compile the file.

   94qlf_make(Spec) :-
   95    absolute_file_name(Spec, PlFile,
   96                       [ file_type(prolog),
   97                         access(read)
   98                       ]),
   99    (   qlf_needs_rebuild(PlFile)
  100    ->  qcompile_(PlFile)
  101    ;   true
  102    ).
  103
  104qcompile_files([]) => true.
  105qcompile_files([+H|T]) =>
  106    qcompile_(H),
  107    qcompile_files(T).
  108qcompile_files([H|T]) =>
  109    file_dependencies(H, Deps),
  110    intersection(Deps, T, Deps1),
  111    (   Deps1 == []
  112    ->  qcompile_(H),
  113        qcompile_files(T)
  114    ;   subtract(T, Deps1, T1),
  115        append([Deps1, [+H], T1], Agenda),
  116        qcompile_files(Agenda)
  117    ).
  118
  119qcompile_(PlFile) :-
  120    progress(PlFile),
  121    qcompile(PlFile, [imports([])]).

 preload_pldoc is det

Preload the documentation system and disable it. We need to do this to avoid embedding the system documentation into the .qlf files.

  128preload_pldoc :-
  129    exists_source(library(pldoc)),
  130    !,
  131    preload(library(pldoc), [doc_collect/1]),
  132    doc_collect(false).
  133preload_pldoc.

 preload(+Spec, +Imports) is det

Ensure the .QLF file for Spec, load the file and import predicates from Imports. This is used to preload files that affect the compilation such as library(apply_macros) and PlDoc.

  141preload(Spec, Imports) :-
  142    absolute_file_name(Spec, File,
  143                       [ extensions([pl]),
  144                         access(read),
  145                         file_errors(fail)
  146                       ]),
  147    !,
  148    qlf_make(File),
  149    use_module(File, Imports).
  150preload(_, _).

 qlf_needs_rebuild(+PlFile:atom) is semidet

True when PlFile needs to be recompiled.

  156qlf_needs_rebuild(PlFile) :-
  157    pl_qlf_file(PlFile, QlfFile),
  158    (   \+ exists_file(QlfFile)
  159    ->  true
  160    ;   '$qlf_versions'(QlfFile, CurrentVersion, _MinLOadVersion, FileVersion,
  161                        CurrentSignature, FileSignature),
  162        (   FileVersion \== CurrentVersion
  163        ;   FileSignature \== CurrentSignature
  164        )
  165    ->  true
  166    ;   time_file(QlfFile, QlfTime),
  167        '$qlf_sources'(QlfFile, Sources),
  168        forall(member(S, Sources),
  169               (   time_file(S, STime),
  170                   STime > QlfTime+1
  171               ))
  172    ).
  173
  174pl_qlf_file(PlFile, QlfFile) :-
  175    file_name_extension(Base, pl, PlFile),
  176    file_name_extension(Base, qlf, QlfFile).

 size_stats(+Files) is det

Print (size) statistics on the created .QLF files.

  182size_stats(Files) :-
  183    maplist(size_stat, Files, PlSizes, Qlfizes),
  184    sum_list(PlSizes, PlSize),
  185    sum_list(Qlfizes, Qlfize),
  186    length(Files, Count),
  187    print_message(informational, qlf_make(size(Count, Qlfize, PlSize))).
  188
  189size_stat(PlFile, PlSize, QlfSize) :-
  190    pl_qlf_file(PlFile, QlfFile),
  191    size_file(PlFile, PlSize),
  192    size_file(QlfFile, QlfSize).
  193
  194:- dynamic qlf_part_of/2.               % Part, Whole
  195
  196                /*******************************
  197                *         DEPENDENCIES         *
  198                *******************************/

 file_dependencies(+File, -Deps:ordset) is det

True when Deps is a list of absolute file names that form the dependencies of File. This examines the file loading directives.

  205file_dependencies(File, Deps) :-
  206    prolog_file_directives(File, Directives, []),
  207    phrase(file_deps(Directives), Deps0),
  208    convlist(absolute_path(File), Deps0, Deps1),
  209    sort(Deps1, Deps).
  210
  211file_deps([]) ==>
  212    [].
  213file_deps([H|T]) ==>
  214    file_dep(H),
  215    file_deps(T).
  216
  217file_dep((:- Dir)) ==>
  218    (   { directive_file(Dir, Files) }
  219    ->  file_or_files(Files)
  220    ;   []
  221    ).
  222file_dep(_) ==>
  223    [].
  224
  225file_or_files(Files), is_list(Files) ==>
  226    sequence(file, Files).
  227file_or_files(File) ==>
  228    file(File).
  229
  230file(File) -->
  231    [File].
  232
  233directive_file(ensure_loaded(File), File).
  234directive_file(consult(File), File).
  235directive_file(load_files(File, _), File).
  236directive_file(use_module(File), File).
  237directive_file(use_module(File, _), File).
  238directive_file(autoload(File), File).
  239directive_file(autoload(File, _), File).
  240directive_file(reexport(File), File).
  241directive_file(reexport(File, _), File).
  242
  243absolute_path(RelativeTo, _:Spec, File) =>
  244    absolute_path(RelativeTo, Spec, File).
  245absolute_path(_RelativeTo, Spec, File),
  246    compound(Spec), compound_name_arity(Spec, _, 1) =>
  247    absolute_file_name(Spec, File,
  248                       [ access(read),
  249                         file_type(source),
  250                         file_errors(fail)
  251                       ]).
  252absolute_path(RelativeTo, Spec, File) =>
  253    absolute_file_name(Spec, File,
  254                       [ relative_to(RelativeTo),
  255                         access(read),
  256                         file_type(source),
  257                         file_errors(fail)
  258                       ]).
  259
  260
  261                /*******************************
  262                *       FIND CANDIDATES        *
  263                *******************************/

 system_lib_files(-LibFiles:list(atom)) is det

True when LibFiles is a list of all files for which a .QLF file needs to be build. This means, all .pl files except:

• INDEX.pl, MKINDEX.pl and CLASSINDEX.pl
• Files that are part of an aggregate .QLF file
• Files that are explicitly excluded as specified by exclude/1 or exclude_dir/1.

These rules must be kept in sync with cmake/InstallSource.cmake that creates CMake install targets for the .qlf files. We need a better solution for this using a common set of rules that can be interpreted by both Prolog and CMake.

  280system_lib_files(LibFiles) :-
  281    findall(Dir, system_lib_dir(Dir), Dirs),
  282    maplist(dir_files, Dirs, FilesL),
  283    append(FilesL, Files0),
  284    sort(Files0, Files),
  285    exclude(excluded, Files, LibFiles).
  286
  287system_lib_dir(LibDir) :-
  288    working_directory(PWD, PWD),
  289    source_alias(Alias),
  290    absolute_file_name(Alias, LibDir,
  291                       [ file_type(directory),
  292                         solutions(all),
  293                         file_errors(fail),
  294                         access(read)
  295                       ]),
  296    sub_atom(LibDir, 0, _, _, PWD).
  297
  298source_alias(library(.)).
  299source_alias(app(.)).
  300source_alias(pce('prolog/demo')).
  301source_alias(pce('prolog/contrib')).

 dir_files(+Dir, -Files) is det

Get all files from Dir recursively. Skip directories that are excluded by exclude_dir/1.

  309dir_files(Dir, Files) :-
  310    dir_files_([Dir|DirT], DirT, Files).
  311
  312dir_files_([], [], []) :- !.
  313dir_files_([D|DT], DirT, Files) :-
  314    \+ excluded_directory(D),
  315    !,
  316    dir_files_dirs(D, Files, FileT, DirT, DirT2),
  317    dir_files_(DT, DirT2, FileT).
  318dir_files_([_|DT], DirT, Files) :-
  319    dir_files_(DT, DirT, Files).
  320
  321dir_files_dirs(Dir, Files, FileT, Dirs, DirT) :-
  322    directory_files(Dir, Entries),
  323    dir_files_dirs_(Entries, Dir, Files, FileT, Dirs, DirT).
  324
  325dir_files_dirs_([], _, Files, Files, Dirs, Dirs).
  326dir_files_dirs_([H|T], Dir, Files, FileT, Dirs, DirT) :-
  327    hidden_entry(H),
  328    !,
  329    dir_files_dirs_(T, Dir, Files, FileT, Dirs, DirT).
  330dir_files_dirs_([H|T], Dir, Files, FileT, Dirs, DirT) :-
  331    atomic_list_concat([Dir, /, H], Path),
  332    (   exists_file(Path)
  333    ->  Files = [Path|Files1],
  334        dir_files_dirs_(T, Dir, Files1, FileT, Dirs, DirT)
  335    ;   exists_directory(Path)
  336    ->  Dirs = [Path|Dirs1],
  337        dir_files_dirs_(T, Dir, Files, FileT, Dirs1, DirT)
  338    ;   dir_files_dirs_(T, Dir, Files, FileT, Dirs, DirT)
  339    ).
  340
  341hidden_entry('.').
  342hidden_entry('..').
  343
  344excluded(File) :-
  345    \+ file_name_extension(_, pl, File),
  346    !.
  347excluded(File) :-
  348    file_base_name(File, 'INDEX.pl'),
  349    !.
  350excluded(File) :-
  351    file_base_name(File, 'MKINDEX.pl'),
  352    !.
  353excluded(File) :-
  354    file_base_name(File, 'CLASSINDEX.pl'),
  355    !.
  356excluded(File) :-
  357    qlf_part_of(File, Main),
  358    !,
  359    report_excluded(excluded(part(Main), File)).
  360excluded(File) :-
  361    exclude(Spec),
  362    same_base(Spec, pl, File),
  363    absolute_file_name(Spec, File1,
  364                       [ extensions([pl]),
  365                         access(read),
  366                         solutions(all)
  367                       ]),
  368    File == File1,
  369    !,
  370    report_excluded(excluded(rule(Spec), File)).
  371
  372same_base(Spec, Ext, Path) :-
  373    spec_base(Spec, Base),
  374    file_base_name(Path, File),
  375    file_name_extension(Base, Ext, File).
  376
  377spec_base(Spec, Base) :-
  378    compound(Spec),
  379    Spec =.. [_,Sub],
  380    last_segment(Sub, Base).
  381
  382last_segment(_/B, L) =>
  383    last_segment(B, L).
  384last_segment(A, L), atomic(A) =>
  385    L = A.
  386
  387exclude(library(prolog_qlfmake)).
  388exclude(library(sty_pldoc)).
  389exclude(library(sty_xpce)).
  390exclude(library(tabling)).
  391exclude(library(theme/dark)).
  392exclude(library(http/dcg_basics)).
  393exclude(library(chr/chr_translate_bootstrap1)).
  394exclude(library(chr/chr_translate_bootstrap2)).
  395exclude(library(trace/pprint)).
  396exclude(library(xref/quintus)).
  397exclude(library(xref/sicstus)).
  398exclude(library(pldoc/hooks)).
  399
  400excluded_directory(Dir) :-
  401    exclude_dir(Spec),
  402    spec_base(Spec, Base),
  403    atom_concat(/, Base, SBase),
  404    once(sub_atom(Dir, _, _, _, SBase)),
  405    absolute_file_name(Spec, Dir1,
  406                       [ file_type(directory),
  407                         access(read),
  408                         solutions(all)
  409                       ]),
  410    sub_atom(Dir, 0, _, _, Dir1),
  411    !,
  412    report_excluded(excluded(rule(Spec), Dir)).
  413
  414exclude_dir(swi(xpce/prolog/lib/compatibility)).
  415
  416
  417                /*******************************
  418                *          AGGREGATES          *
  419                *******************************/

 qmake_aggregates is det

QLF compile the aggregates. This also populates qlf_part_of/2 which is used to avoid compiling these parts.

  426qmake_aggregates :-
  427    retractall(qlf_part_of(_,_)),
  428    forall(aggregate_qlf(Spec),
  429           qmake_aggregate(Spec)).
  430
  431qmake_aggregate(Spec) :-
  432    exists_source(Spec),
  433    !,
  434    qlf_make(Spec),
  435    absolute_file_name(Spec, PlFile,
  436                       [ file_type(prolog),
  437                         access(read)
  438                       ]),
  439    pl_qlf_file(PlFile, QlfFile),
  440    '$qlf_sources'(QlfFile, Sources),
  441    forall(member(S, Sources),
  442           assertz(qlf_part_of(S, PlFile))).
  443qmake_aggregate(_).
  444
  445aggregate_qlf(library(pce)).
  446aggregate_qlf(library(trace/trace)).
  447aggregate_qlf(library(emacs/emacs)).
  448
  449
  450                /*******************************
  451                *       FILE SEARCH PATH       *
  452                *******************************/
  453
  454:- multifile
  455    user:file_search_path/2.  456
  457user:file_search_path(chr,   library(chr)).
  458user:file_search_path(pldoc, library(pldoc)).
  459user:file_search_path(doc,   swi(xpce/prolog/lib/doc)).
  460
  461
  462                /*******************************
  463                *           FEEDBACK           *
  464                *******************************/
  465
  466report_work(Files, Rebuild) :-
  467    length(Files, AllFiles),
  468    length(Rebuild, NeedsRebuild),
  469    print_message(informational, qlf_make(planning(AllFiles, NeedsRebuild))).
  470
  471progress(_PlFile) :-
  472    current_prolog_flag(verbose, silent),
  473    !.
  474progress(PlFile) :-
  475    stream_property(user_output, tty(true)),
  476    current_prolog_flag(color_term, true),
  477    \+ debugging(qlf_make),
  478    !,
  479    ansi_format(comment, '\r~w ...', [PlFile]),
  480    format(user_output, '\e[K', []),
  481    flush_output(user_output).
  482progress(PlFile) :-
  483    format(user_output, '~N~w ...', [PlFile]),
  484    flush_output(user_output).
  485
  486report_excluded(Msg) :-
  487    debugging(qlf_make),
  488    !,
  489    print_message(informational, qlf_make(Msg)).
  490report_excluded(_).
  491
  492:- multifile prolog:message//1.  493
  494prolog:message(qlf_make(Msg)) -->
  495    message(Msg).
  496
  497message(planning(_AllFiles, 0)) ==>
  498    [].
  499message(planning(AllFiles, AllFiles)) ==>
  500    [ 'Building ~D qlf files'-[AllFiles] ].
  501message(planning(AllFiles, NeedsRebuild)) ==>
  502    [ '~D qlf files.  ~D need to be rebuild'-[AllFiles, NeedsRebuild] ].
  503message(size(Count, Qlfize, PlSize)) ==>
  504    [ '~D qlf files take ~D bytes.  Source ~D bytes'-
  505      [Count, Qlfize, PlSize]
  506    ].
  507message(excluded(Reason, File)) ==>
  508    [ 'Excluded ', url(File) ],
  509    excl_reason(Reason).
  510
  511excl_reason(part(_Main)) -->
  512    [ ' (part of aggregate QLF)' ].
  513excl_reason(rule(_Spec)) -->
  514    [ ' (explicit)' ]