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.
  155
  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).
  177
  178%!  size_stats(+Files) is det.
  179%
  180%   Print (size) statistics on the created .QLF files.
  181
  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                *******************************/
  199
  200%!  file_dependencies(+File, -Deps:ordset) is det.
  201%
  202%   True when Deps is a  list  of   absolute  file  names  that form the
  203%   dependencies of File. This examines the file loading directives.
  204
  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                *******************************/
  264
  265%!  system_lib_files(-LibFiles:list(atom)) is det.
  266%
  267%   True when LibFiles is a list of  all   files  for  which a .QLF file
  268%   needs to be build.  This means, all .pl files __except__:
  269%
  270%     - `INDEX.pl`, `MKINDEX.pl` and `CLASSINDEX.pl`
  271%     - Files that are part of an aggregate .QLF file
  272%     - Files that are explicitly excluded as specified by exclude/1
  273%       or exclude_dir/1.
  274%
  275%   These rules must be kept   in  sync with `cmake/InstallSource.cmake`
  276%   that creates CMake install targets for  the   .qlf  files. We need a
  277%   better solution for this using a  common   set  of rules that can be
  278%   interpreted by both Prolog and CMake.
  279
  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')).
  302
  303
  304%!  dir_files(+Dir, -Files) is det.
  305%
  306%   Get all files from Dir recursively.  Skip directories that are
  307%   excluded by exclude_dir/1.
  308
  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                *******************************/
  420
  421%!  qmake_aggregates is det.
  422%
  423%   QLF compile the _aggregates_.  This   also  populates  qlf_part_of/2
  424%   which is used to avoid compiling these parts.
  425
  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)' ]