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.   49
   50/** <module> Compile the library to QLF format
   51
   52Compilation mode:
   53   - Handle debug/3
   54     - Optimise, forcing loading of .pl files in debug mode?
   55   - library(apply_macros)
   56     - Load in advance
   57   - Do not include compiled documentation
   58     - doc_collect(false).
   59*/
   60
   61% :- debug(qlf_make).
   62
   63%!  qlf_make is det.
   64%
   65%   Compile all files from the system libraries  to .QLF format. This is
   66%   normally called as part  of   building  SWI-Prolog.  The compilation
   67%   consists of these phases:
   68%
   69%     1. Prepare the compilation environment (expansion, optimization)
   70%     2. Build the _aggregate_ .QLF files specified in aggregate_qlf/1.
   71%     3. Find all .pl files that need to a .QLF version.
   72%     4. Find the subset that need rebuilding
   73%     5. Compile these files
   74%     6. Report on the sizes
   75
   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).
   87
   88%!  qlf_make(+Spec) is det.
   89%
   90%   Ensure a .QLF version of Spec. If the   .QLF  file for Spec does not
   91%   exist, is incompatible or one of its   source files has changed, run
   92%   qcompile/1 to compile the file.
   93
   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([])]).
  122
  123%!  preload_pldoc is det.
  124%
  125%   Preload the documentation system and disable it.  We need to do this
  126%   to avoid embedding the system documentation into the .qlf files.
  127
  128preload_pldoc :-
  129    exists_source(library(pldoc)),
  130    !,
  131    preload(library(pldoc), [doc_collect/1]),
  132    doc_collect(false).
  133preload_pldoc.
  134
  135%!  preload(+Spec, +Imports) is det.
  136%
  137%   Ensure the .QLF file for Spec, load   the file and import predicates
  138%   from Imports. This  is  used  to   preload  files  that  affect  the
  139%   compilation such as library(apply_macros) and PlDoc.
  140
  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(_, _).
  151
  152%!  qlf_needs_rebuild(+PlFile:atom) is semidet.
  153%
  154%   True when PlFile  needs  to  be   recompiled.  This  currently  only
  155%   considers the immediate  source  file,   __not__  included  files or
  156%   imported files that define operators, goal or term expansion rules.
  157
  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    ).
  173
  174%!  source_changed(+Source, +QlfTime) is semidet.
  175%
  176%   True when the file of Source differs from the copy that was compiled
  177%   into the .qlf file.  This asks the content and not the modification
  178%   time, which cannot answer it: a tree that arrives by checkout, copy,
  179%   unpack or install carries times of its own, and a file edited in the
  180%   second its .qlf file was written has the same time as that file, at
  181%   the one second many file systems record.  Hashing every source of
  182%   the system library takes about 100ms; recompiling one takes longer
  183%   than that.
  184%
  185%   Files whose hash was not recorded -- 0, from a .qlf file written by
  186%   a version that did not record them -- are compared by time alone,
  187%   with a second of slack, which is what this test was before there
  188%   were hashes.
  189
  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).
  204
  205%!  size_stats(+Files) is det.
  206%
  207%   Print (size) statistics on the created .QLF files.
  208
  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                *******************************/
  226
  227%!  file_dependencies(+File, -Deps:ordset) is det.
  228%
  229%   True when Deps is a  list  of   absolute  file  names  that form the
  230%   dependencies of File. These dependencies are   used to determine the
  231%   order in which we compile the units.   This  does __not__ state that
  232%   the compilation process depends  on   these  dependencies.  But, qlf
  233%   compiling a module does load  these   dependencies,  either from the
  234%   source or created .qlf file. Only   if the loaded dependency exports
  235%   macros (term/goal expansion rules) or operators  we actually need to
  236%   have the depedencies compiled before us.   Still,  qlf compiling the
  237%   dependencies before speeds up the compilation of this file.
  238%
  239%   This predicate examines the file loading  directives. Note that Deps
  240%   does __not__ contain files  loaded  using   include/1  as  we do not
  241%   create .qlf files for these.
  242
  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                *******************************/
  302
  303%!  system_lib_files(-LibFiles:list(atom)) is det.
  304%
  305%   True when LibFiles is a list of  all   files  for  which a .QLF file
  306%   needs to be build.  This means, all .pl files __except__:
  307%
  308%     - `INDEX.pl`, `MKINDEX.pl` and `CLASSINDEX.pl`
  309%     - Files that are part of an aggregate .QLF file
  310%     - Files that are explicitly excluded as specified by exclude/1
  311%       or exclude_dir/1.
  312%
  313%   These rules must be kept   in  sync with `cmake/InstallSource.cmake`
  314%   that creates CMake install targets for  the   .qlf  files. We need a
  315%   better solution for this using a  common   set  of rules that can be
  316%   interpreted by both Prolog and CMake.
  317
  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')).
  340
  341
  342%!  dir_files(+Dir, -Files) is det.
  343%
  344%   Get all files from Dir recursively.  Skip directories that are
  345%   excluded by exclude_dir/1.
  346
  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                *******************************/
  467
  468%!  qmake_aggregates is det.
  469%
  470%   QLF compile the _aggregates_.  This   also  populates  qlf_part_of/2
  471%   which is used to avoid compiling these parts.
  472
  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)' ]