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. This currently only considers the immediate source file, not included files or imported files that define operators, goal or term expansion rules.

  158qlf_needs_rebuild(PlFile) :-
  159    pl_qlf_file(PlFile, QlfFile),
  160    (   \+ exists_file(QlfFile)
  161    ->  true
  162    ;   '$qlf_versions'(QlfFile, CurrentVersion, _MinLOadVersion, FileVersion,
  163                        CurrentSignature, FileSignature),
  164        (   FileVersion \== CurrentVersion
  165        ;   FileSignature \== CurrentSignature
  166        )
  167    ->  true
  168    ;   time_file(QlfFile, QlfTime),
  169        '$qlf_sources'(QlfFile, Sources),
  170        member(S, Sources),
  171        source_changed(S, QlfTime)
  172    ).

 source_changed(+Source, +QlfTime) is semidet

True when the file of Source differs from the copy that was compiled into the .qlf file. This asks the content and not the modification time, which cannot answer it: a tree that arrives by checkout, copy, unpack or install carries times of its own, and a file edited in the second its .qlf file was written has the same time as that file, at the one second many file systems record. Hashing every source of the system library takes about 100ms; recompiling one takes longer than that.

Files whose hash was not recorded -- 0, from a .qlf file written by a version that did not record them -- are compared by time alone, with a second of slack, which is what this test was before there were hashes.

  190source_changed(Source, _QlfTime) :-
  191    arg(1, Source, File),
  192    arg(2, Source, Hash),
  193    Hash =\= 0,
  194    !,
  195    \+ '$file_hash'(File, Hash).
  196source_changed(Source, QlfTime) :-
  197    arg(1, Source, File),
  198    time_file(File, STime),
  199    STime > QlfTime+1.
  200
  201pl_qlf_file(PlFile, QlfFile) :-
  202    file_name_extension(Base, pl, PlFile),
  203    file_name_extension(Base, qlf, QlfFile).

 size_stats(+Files) is det

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

  209size_stats(Files) :-
  210    maplist(size_stat, Files, PlSizes, Qlfizes),
  211    sum_list(PlSizes, PlSize),
  212    sum_list(Qlfizes, Qlfize),
  213    length(Files, Count),
  214    print_message(informational, qlf_make(size(Count, Qlfize, PlSize))).
  215
  216size_stat(PlFile, PlSize, QlfSize) :-
  217    pl_qlf_file(PlFile, QlfFile),
  218    size_file(PlFile, PlSize),
  219    size_file(QlfFile, QlfSize).
  220
  221:- dynamic qlf_part_of/2.               % Part, Whole
  222
  223                /*******************************
  224                *         DEPENDENCIES         *
  225                *******************************/

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

True when Deps is a list of absolute file names that form the dependencies of File. These dependencies are used to determine the order in which we compile the units. This does not state that the compilation process depends on these dependencies. But, qlf compiling a module does load these dependencies, either from the source or created .qlf file. Only if the loaded dependency exports macros (term/goal expansion rules) or operators we actually need to have the depedencies compiled before us. Still, qlf compiling the dependencies before speeds up the compilation of this file.

This predicate examines the file loading directives. Note that Deps does not contain files loaded using include/1 as we do not create .qlf files for these.

  243file_dependencies(File, Deps) :-
  244    prolog_file_directives(File, Directives, []),
  245    phrase(file_deps(Directives), Deps0),
  246    convlist(absolute_path(File), Deps0, Deps1),
  247    sort(Deps1, Deps).
  248
  249file_deps([]) ==>
  250    [].
  251file_deps([H|T]) ==>
  252    file_dep(H),
  253    file_deps(T).
  254
  255file_dep((:- Dir)) ==>
  256    (   { directive_file(Dir, Files) }
  257    ->  file_or_files(Files)
  258    ;   []
  259    ).
  260file_dep(_) ==>
  261    [].
  262
  263file_or_files(Files), is_list(Files) ==>
  264    sequence(file, Files).
  265file_or_files(File) ==>
  266    file(File).
  267
  268file(File) -->
  269    [File].
  270
  271directive_file(ensure_loaded(File), File).
  272directive_file(consult(File), File).
  273directive_file(load_files(File, _), File).
  274directive_file(use_module(File), File).
  275directive_file(use_module(File, _), File).
  276directive_file(autoload(File), File).
  277directive_file(autoload(File, _), File).
  278directive_file(reexport(File), File).
  279directive_file(reexport(File, _), File).
  280
  281absolute_path(RelativeTo, _:Spec, File) =>
  282    absolute_path(RelativeTo, Spec, File).
  283absolute_path(_RelativeTo, Spec, File),
  284    compound(Spec), compound_name_arity(Spec, _, 1) =>
  285    absolute_file_name(Spec, File,
  286                       [ access(read),
  287                         file_type(source),
  288                         file_errors(fail)
  289                       ]).
  290absolute_path(RelativeTo, Spec, File) =>
  291    absolute_file_name(Spec, File,
  292                       [ relative_to(RelativeTo),
  293                         access(read),
  294                         file_type(source),
  295                         file_errors(fail)
  296                       ]).
  297
  298
  299                /*******************************
  300                *       FIND CANDIDATES        *
  301                *******************************/

 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.

  318system_lib_files(LibFiles) :-
  319    findall(Dir, system_lib_dir(Dir), Dirs),
  320    maplist(dir_files, Dirs, FilesL),
  321    append(FilesL, Files0),
  322    sort(Files0, Files),
  323    exclude(excluded, Files, LibFiles).
  324
  325system_lib_dir(LibDir) :-
  326    working_directory(PWD, PWD),
  327    source_alias(Alias),
  328    absolute_file_name(Alias, LibDir,
  329                       [ file_type(directory),
  330                         solutions(all),
  331                         file_errors(fail),
  332                         access(read)
  333                       ]),
  334    sub_atom(LibDir, 0, _, _, PWD).
  335
  336source_alias(library(.)).
  337source_alias(app(.)).
  338source_alias(pce('prolog/demo')).
  339source_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.

  347dir_files(Dir, Files) :-
  348    dir_files_([Dir|DirT], DirT, Files).
  349
  350dir_files_([], [], []) :- !.
  351dir_files_([D|DT], DirT, Files) :-
  352    \+ excluded_directory(D),
  353    !,
  354    dir_files_dirs(D, Files, FileT, DirT, DirT2),
  355    dir_files_(DT, DirT2, FileT).
  356dir_files_([_|DT], DirT, Files) :-
  357    dir_files_(DT, DirT, Files).
  358
  359dir_files_dirs(Dir, Files, FileT, Dirs, DirT) :-
  360    directory_files(Dir, Entries),
  361    dir_files_dirs_(Entries, Dir, Files, FileT, Dirs, DirT).
  362
  363dir_files_dirs_([], _, Files, Files, Dirs, Dirs).
  364dir_files_dirs_([H|T], Dir, Files, FileT, Dirs, DirT) :-
  365    hidden_entry(H),
  366    !,
  367    dir_files_dirs_(T, Dir, Files, FileT, Dirs, DirT).
  368dir_files_dirs_([H|T], Dir, Files, FileT, Dirs, DirT) :-
  369    atomic_list_concat([Dir, /, H], Path),
  370    (   exists_file(Path)
  371    ->  Files = [Path|Files1],
  372        dir_files_dirs_(T, Dir, Files1, FileT, Dirs, DirT)
  373    ;   exists_directory(Path)
  374    ->  Dirs = [Path|Dirs1],
  375        dir_files_dirs_(T, Dir, Files, FileT, Dirs1, DirT)
  376    ;   dir_files_dirs_(T, Dir, Files, FileT, Dirs, DirT)
  377    ).
  378
  379hidden_entry('.').
  380hidden_entry('..').
  381
  382excluded(File) :-
  383    \+ file_name_extension(_, pl, File),
  384    !.
  385excluded(File) :-
  386    file_base_name(File, 'INDEX.pl'),
  387    !.
  388excluded(File) :-
  389    file_base_name(File, 'MKINDEX.pl'),
  390    !.
  391excluded(File) :-
  392    file_base_name(File, 'CLASSINDEX.pl'),
  393    !.
  394excluded(File) :-
  395    qlf_part_of(File, Main),
  396    !,
  397    report_excluded(excluded(part(Main), File)).
  398excluded(File) :-
  399    exclude(Spec),
  400    same_base(Spec, pl, File),
  401    absolute_file_name(Spec, File1,
  402                       [ extensions([pl]),
  403                         access(read),
  404                         solutions(all)
  405                       ]),
  406    File == File1,
  407    !,
  408    report_excluded(excluded(rule(Spec), File)).
  409
  410same_base(Spec, Ext, Path) :-
  411    spec_base(Spec, Base),
  412    file_base_name(Path, File),
  413    file_name_extension(Base, Ext, File).
  414
  415spec_base(Spec, Base) :-
  416    compound(Spec),
  417    Spec =.. [_,Sub],
  418    last_segment(Sub, Base).
  419
  420last_segment(_/B, L) =>
  421    last_segment(B, L).
  422last_segment(A, L), atomic(A) =>
  423    L = A.
  424
  425exclude(library(prolog_qlfmake)).
  426exclude(library(win_menu)).
  427exclude(library(threadutil)).
  428exclude(library(check_installation)).
  429exclude(library(sty_pldoc)).
  430exclude(library(sty_xpce)).
  431exclude(library(tabling)).
  432exclude(library(theme/dark)).
  433exclude(library(http/dcg_basics)).
  434exclude(library(http/json)).
  435exclude(library(http/json_convert)).
  436exclude(library(http/js_grammar)).
  437exclude(library(chr/chr_translate_bootstrap1)).
  438exclude(library(chr/chr_translate_bootstrap2)).
  439exclude(library(trace/pprint)).
  440exclude(library(xref/quintus)).
  441exclude(library(xref/sicstus)).
  442exclude(library(pldoc/hooks)).
  443exclude(library(pldoc/doc_changes)).
  444exclude(library(pldoc/git_extract_changes)).
  445exclude(library(pldoc/changelog_events)).
  446
  447excluded_directory(Dir) :-
  448    exclude_dir(Spec),
  449    spec_base(Spec, Base),
  450    atom_concat(/, Base, SBase),
  451    once(sub_atom(Dir, _, _, _, SBase)),
  452    absolute_file_name(Spec, Dir1,
  453                       [ file_type(directory),
  454                         access(read),
  455                         solutions(all)
  456                       ]),
  457    sub_atom(Dir, 0, _, _, Dir1),
  458    !,
  459    report_excluded(excluded(rule(Spec), Dir)).
  460
  461exclude_dir(swi(xpce/prolog/lib/compatibility)).
  462
  463
  464                /*******************************
  465                *          AGGREGATES          *
  466                *******************************/

 qmake_aggregates is det

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

  473qmake_aggregates :-
  474    retractall(qlf_part_of(_,_)),
  475    forall(aggregate_qlf(Spec),
  476           qmake_aggregate(Spec)).
  477
  478qmake_aggregate(Spec) :-
  479    exists_source(Spec),
  480    !,
  481    qlf_make(Spec),
  482    absolute_file_name(Spec, PlFile,
  483                       [ file_type(prolog),
  484                         access(read)
  485                       ]),
  486    pl_qlf_file(PlFile, QlfFile),
  487    '$qlf_sources'(QlfFile, Sources),
  488    forall(member(source(S, _Hash), Sources),
  489           assertz(qlf_part_of(S, PlFile))).
  490qmake_aggregate(_).
  491
  492aggregate_qlf(library(pce)).
  493aggregate_qlf(library(trace/trace)).
  494aggregate_qlf(library(emacs/emacs)).
  495
  496
  497                /*******************************
  498                *       FILE SEARCH PATH       *
  499                *******************************/
  500
  501:- multifile
  502    user:file_search_path/2.  503
  504user:file_search_path(chr,   library(chr)).
  505user:file_search_path(pldoc, library(pldoc)).
  506user:file_search_path(doc,   swi(xpce/prolog/lib/doc)).
  507
  508
  509                /*******************************
  510                *           FEEDBACK           *
  511                *******************************/
  512
  513report_work(Files, Rebuild) :-
  514    length(Files, AllFiles),
  515    length(Rebuild, NeedsRebuild),
  516    print_message(informational, qlf_make(planning(AllFiles, NeedsRebuild))).
  517
  518progress(_PlFile) :-
  519    current_prolog_flag(verbose, silent),
  520    !.
  521progress(PlFile) :-
  522    stream_property(user_output, tty(true)),
  523    current_prolog_flag(color_term, true),
  524    \+ debugging(qlf_make),
  525    !,
  526    ansi_format(comment, '\r~w ...', [PlFile]),
  527    format(user_output, '\e[K', []),
  528    flush_output(user_output).
  529progress(PlFile) :-
  530    format(user_output, '~N~w ...', [PlFile]),
  531    flush_output(user_output).
  532
  533report_excluded(Msg) :-
  534    debugging(qlf_make),
  535    !,
  536    print_message(informational, qlf_make(Msg)).
  537report_excluded(_).
  538
  539:- multifile prolog:message//1.  540
  541prolog:message(qlf_make(Msg)) -->
  542    message(Msg).
  543
  544message(planning(_AllFiles, 0)) ==>
  545    [].
  546message(planning(AllFiles, AllFiles)) ==>
  547    [ 'Building ~D qlf files'-[AllFiles] ].
  548message(planning(AllFiles, NeedsRebuild)) ==>
  549    [ '~D qlf files.  ~D need to be rebuild'-[AllFiles, NeedsRebuild] ].
  550message(size(Count, Qlfize, PlSize)) ==>
  551    [ '~D qlf files take ~D bytes.  Source ~D bytes'-
  552      [Count, Qlfize, PlSize]
  553    ].
  554message(excluded(Reason, File)) ==>
  555    [ 'Excluded ', url(File) ],
  556    excl_reason(Reason).
  557
  558excl_reason(part(_Main)) -->
  559    [ ' (part of aggregate QLF)' ].
  560excl_reason(rule(_Spec)) -->
  561    [ ' (explicit)' ]