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        arg(1, S, File),
  172        time_file(File, STime),
  173        STime > QlfTime+1
  174    ).
  175
  176pl_qlf_file(PlFile, QlfFile) :-
  177    file_name_extension(Base, pl, PlFile),
  178    file_name_extension(Base, qlf, QlfFile).
  179
  180%!  size_stats(+Files) is det.
  181%
  182%   Print (size) statistics on the created .QLF files.
  183
  184size_stats(Files) :-
  185    maplist(size_stat, Files, PlSizes, Qlfizes),
  186    sum_list(PlSizes, PlSize),
  187    sum_list(Qlfizes, Qlfize),
  188    length(Files, Count),
  189    print_message(informational, qlf_make(size(Count, Qlfize, PlSize))).
  190
  191size_stat(PlFile, PlSize, QlfSize) :-
  192    pl_qlf_file(PlFile, QlfFile),
  193    size_file(PlFile, PlSize),
  194    size_file(QlfFile, QlfSize).
  195
  196:- dynamic qlf_part_of/2.               % Part, Whole
  197
  198                /*******************************
  199                *         DEPENDENCIES         *
  200                *******************************/
  201
  202%!  file_dependencies(+File, -Deps:ordset) is det.
  203%
  204%   True when Deps is a  list  of   absolute  file  names  that form the
  205%   dependencies of File. These dependencies are   used to determine the
  206%   order in which we compile the units.   This  does __not__ state that
  207%   the compilation process depends  on   these  dependencies.  But, qlf
  208%   compiling a module does load  these   dependencies,  either from the
  209%   source or created .qlf file. Only   if the loaded dependency exports
  210%   macros (term/goal expansion rules) or operators  we actually need to
  211%   have the depedencies compiled before us.   Still,  qlf compiling the
  212%   dependencies before speeds up the compilation of this file.
  213%
  214%   This predicate examines the file loading  directives. Note that Deps
  215%   does __not__ contain files  loaded  using   include/1  as  we do not
  216%   create .qlf files for these.
  217
  218file_dependencies(File, Deps) :-
  219    prolog_file_directives(File, Directives, []),
  220    phrase(file_deps(Directives), Deps0),
  221    convlist(absolute_path(File), Deps0, Deps1),
  222    sort(Deps1, Deps).
  223
  224file_deps([]) ==>
  225    [].
  226file_deps([H|T]) ==>
  227    file_dep(H),
  228    file_deps(T).
  229
  230file_dep((:- Dir)) ==>
  231    (   { directive_file(Dir, Files) }
  232    ->  file_or_files(Files)
  233    ;   []
  234    ).
  235file_dep(_) ==>
  236    [].
  237
  238file_or_files(Files), is_list(Files) ==>
  239    sequence(file, Files).
  240file_or_files(File) ==>
  241    file(File).
  242
  243file(File) -->
  244    [File].
  245
  246directive_file(ensure_loaded(File), File).
  247directive_file(consult(File), File).
  248directive_file(load_files(File, _), File).
  249directive_file(use_module(File), File).
  250directive_file(use_module(File, _), File).
  251directive_file(autoload(File), File).
  252directive_file(autoload(File, _), File).
  253directive_file(reexport(File), File).
  254directive_file(reexport(File, _), File).
  255
  256absolute_path(RelativeTo, _:Spec, File) =>
  257    absolute_path(RelativeTo, Spec, File).
  258absolute_path(_RelativeTo, Spec, File),
  259    compound(Spec), compound_name_arity(Spec, _, 1) =>
  260    absolute_file_name(Spec, File,
  261                       [ access(read),
  262                         file_type(source),
  263                         file_errors(fail)
  264                       ]).
  265absolute_path(RelativeTo, Spec, File) =>
  266    absolute_file_name(Spec, File,
  267                       [ relative_to(RelativeTo),
  268                         access(read),
  269                         file_type(source),
  270                         file_errors(fail)
  271                       ]).
  272
  273
  274                /*******************************
  275                *       FIND CANDIDATES        *
  276                *******************************/
  277
  278%!  system_lib_files(-LibFiles:list(atom)) is det.
  279%
  280%   True when LibFiles is a list of  all   files  for  which a .QLF file
  281%   needs to be build.  This means, all .pl files __except__:
  282%
  283%     - `INDEX.pl`, `MKINDEX.pl` and `CLASSINDEX.pl`
  284%     - Files that are part of an aggregate .QLF file
  285%     - Files that are explicitly excluded as specified by exclude/1
  286%       or exclude_dir/1.
  287%
  288%   These rules must be kept   in  sync with `cmake/InstallSource.cmake`
  289%   that creates CMake install targets for  the   .qlf  files. We need a
  290%   better solution for this using a  common   set  of rules that can be
  291%   interpreted by both Prolog and CMake.
  292
  293system_lib_files(LibFiles) :-
  294    findall(Dir, system_lib_dir(Dir), Dirs),
  295    maplist(dir_files, Dirs, FilesL),
  296    append(FilesL, Files0),
  297    sort(Files0, Files),
  298    exclude(excluded, Files, LibFiles).
  299
  300system_lib_dir(LibDir) :-
  301    working_directory(PWD, PWD),
  302    source_alias(Alias),
  303    absolute_file_name(Alias, LibDir,
  304                       [ file_type(directory),
  305                         solutions(all),
  306                         file_errors(fail),
  307                         access(read)
  308                       ]),
  309    sub_atom(LibDir, 0, _, _, PWD).
  310
  311source_alias(library(.)).
  312source_alias(app(.)).
  313source_alias(pce('prolog/demo')).
  314source_alias(pce('prolog/contrib')).
  315
  316
  317%!  dir_files(+Dir, -Files) is det.
  318%
  319%   Get all files from Dir recursively.  Skip directories that are
  320%   excluded by exclude_dir/1.
  321
  322dir_files(Dir, Files) :-
  323    dir_files_([Dir|DirT], DirT, Files).
  324
  325dir_files_([], [], []) :- !.
  326dir_files_([D|DT], DirT, Files) :-
  327    \+ excluded_directory(D),
  328    !,
  329    dir_files_dirs(D, Files, FileT, DirT, DirT2),
  330    dir_files_(DT, DirT2, FileT).
  331dir_files_([_|DT], DirT, Files) :-
  332    dir_files_(DT, DirT, Files).
  333
  334dir_files_dirs(Dir, Files, FileT, Dirs, DirT) :-
  335    directory_files(Dir, Entries),
  336    dir_files_dirs_(Entries, Dir, Files, FileT, Dirs, DirT).
  337
  338dir_files_dirs_([], _, Files, Files, Dirs, Dirs).
  339dir_files_dirs_([H|T], Dir, Files, FileT, Dirs, DirT) :-
  340    hidden_entry(H),
  341    !,
  342    dir_files_dirs_(T, Dir, Files, FileT, Dirs, DirT).
  343dir_files_dirs_([H|T], Dir, Files, FileT, Dirs, DirT) :-
  344    atomic_list_concat([Dir, /, H], Path),
  345    (   exists_file(Path)
  346    ->  Files = [Path|Files1],
  347        dir_files_dirs_(T, Dir, Files1, FileT, Dirs, DirT)
  348    ;   exists_directory(Path)
  349    ->  Dirs = [Path|Dirs1],
  350        dir_files_dirs_(T, Dir, Files, FileT, Dirs1, DirT)
  351    ;   dir_files_dirs_(T, Dir, Files, FileT, Dirs, DirT)
  352    ).
  353
  354hidden_entry('.').
  355hidden_entry('..').
  356
  357excluded(File) :-
  358    \+ file_name_extension(_, pl, File),
  359    !.
  360excluded(File) :-
  361    file_base_name(File, 'INDEX.pl'),
  362    !.
  363excluded(File) :-
  364    file_base_name(File, 'MKINDEX.pl'),
  365    !.
  366excluded(File) :-
  367    file_base_name(File, 'CLASSINDEX.pl'),
  368    !.
  369excluded(File) :-
  370    qlf_part_of(File, Main),
  371    !,
  372    report_excluded(excluded(part(Main), File)).
  373excluded(File) :-
  374    exclude(Spec),
  375    same_base(Spec, pl, File),
  376    absolute_file_name(Spec, File1,
  377                       [ extensions([pl]),
  378                         access(read),
  379                         solutions(all)
  380                       ]),
  381    File == File1,
  382    !,
  383    report_excluded(excluded(rule(Spec), File)).
  384
  385same_base(Spec, Ext, Path) :-
  386    spec_base(Spec, Base),
  387    file_base_name(Path, File),
  388    file_name_extension(Base, Ext, File).
  389
  390spec_base(Spec, Base) :-
  391    compound(Spec),
  392    Spec =.. [_,Sub],
  393    last_segment(Sub, Base).
  394
  395last_segment(_/B, L) =>
  396    last_segment(B, L).
  397last_segment(A, L), atomic(A) =>
  398    L = A.
  399
  400exclude(library(prolog_qlfmake)).
  401exclude(library(sty_pldoc)).
  402exclude(library(sty_xpce)).
  403exclude(library(tabling)).
  404exclude(library(theme/dark)).
  405exclude(library(http/dcg_basics)).
  406exclude(library(chr/chr_translate_bootstrap1)).
  407exclude(library(chr/chr_translate_bootstrap2)).
  408exclude(library(trace/pprint)).
  409exclude(library(xref/quintus)).
  410exclude(library(xref/sicstus)).
  411exclude(library(pldoc/hooks)).
  412
  413excluded_directory(Dir) :-
  414    exclude_dir(Spec),
  415    spec_base(Spec, Base),
  416    atom_concat(/, Base, SBase),
  417    once(sub_atom(Dir, _, _, _, SBase)),
  418    absolute_file_name(Spec, Dir1,
  419                       [ file_type(directory),
  420                         access(read),
  421                         solutions(all)
  422                       ]),
  423    sub_atom(Dir, 0, _, _, Dir1),
  424    !,
  425    report_excluded(excluded(rule(Spec), Dir)).
  426
  427exclude_dir(swi(xpce/prolog/lib/compatibility)).
  428
  429
  430                /*******************************
  431                *          AGGREGATES          *
  432                *******************************/
  433
  434%!  qmake_aggregates is det.
  435%
  436%   QLF compile the _aggregates_.  This   also  populates  qlf_part_of/2
  437%   which is used to avoid compiling these parts.
  438
  439qmake_aggregates :-
  440    retractall(qlf_part_of(_,_)),
  441    forall(aggregate_qlf(Spec),
  442           qmake_aggregate(Spec)).
  443
  444qmake_aggregate(Spec) :-
  445    exists_source(Spec),
  446    !,
  447    qlf_make(Spec),
  448    absolute_file_name(Spec, PlFile,
  449                       [ file_type(prolog),
  450                         access(read)
  451                       ]),
  452    pl_qlf_file(PlFile, QlfFile),
  453    '$qlf_sources'(QlfFile, Sources),
  454    forall(member(source(S), Sources),
  455           assertz(qlf_part_of(S, PlFile))).
  456qmake_aggregate(_).
  457
  458aggregate_qlf(library(pce)).
  459aggregate_qlf(library(trace/trace)).
  460aggregate_qlf(library(emacs/emacs)).
  461
  462
  463                /*******************************
  464                *       FILE SEARCH PATH       *
  465                *******************************/
  466
  467:- multifile
  468    user:file_search_path/2.  469
  470user:file_search_path(chr,   library(chr)).
  471user:file_search_path(pldoc, library(pldoc)).
  472user:file_search_path(doc,   swi(xpce/prolog/lib/doc)).
  473
  474
  475                /*******************************
  476                *           FEEDBACK           *
  477                *******************************/
  478
  479report_work(Files, Rebuild) :-
  480    length(Files, AllFiles),
  481    length(Rebuild, NeedsRebuild),
  482    print_message(informational, qlf_make(planning(AllFiles, NeedsRebuild))).
  483
  484progress(_PlFile) :-
  485    current_prolog_flag(verbose, silent),
  486    !.
  487progress(PlFile) :-
  488    stream_property(user_output, tty(true)),
  489    current_prolog_flag(color_term, true),
  490    \+ debugging(qlf_make),
  491    !,
  492    ansi_format(comment, '\r~w ...', [PlFile]),
  493    format(user_output, '\e[K', []),
  494    flush_output(user_output).
  495progress(PlFile) :-
  496    format(user_output, '~N~w ...', [PlFile]),
  497    flush_output(user_output).
  498
  499report_excluded(Msg) :-
  500    debugging(qlf_make),
  501    !,
  502    print_message(informational, qlf_make(Msg)).
  503report_excluded(_).
  504
  505:- multifile prolog:message//1.  506
  507prolog:message(qlf_make(Msg)) -->
  508    message(Msg).
  509
  510message(planning(_AllFiles, 0)) ==>
  511    [].
  512message(planning(AllFiles, AllFiles)) ==>
  513    [ 'Building ~D qlf files'-[AllFiles] ].
  514message(planning(AllFiles, NeedsRebuild)) ==>
  515    [ '~D qlf files.  ~D need to be rebuild'-[AllFiles, NeedsRebuild] ].
  516message(size(Count, Qlfize, PlSize)) ==>
  517    [ '~D qlf files take ~D bytes.  Source ~D bytes'-
  518      [Count, Qlfize, PlSize]
  519    ].
  520message(excluded(Reason, File)) ==>
  521    [ 'Excluded ', url(File) ],
  522    excl_reason(Reason).
  523
  524excl_reason(part(_Main)) -->
  525    [ ' (part of aggregate QLF)' ].
  526excl_reason(rule(_Spec)) -->
  527    [ ' (explicit)' ]