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).
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).
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([])]).
128preload_pldoc :- 129 exists_source(library(pldoc)), 130 !, 131 preload(library(pldoc), [doc_collect/1]), 132 doc_collect(false). 133preload_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(_, _).
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).
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 *******************************/
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.
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 *******************************/
INDEX.pl
, MKINDEX.pl
and CLASSINDEX.pl
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.
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')).
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 '.') (. 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(win_menu)). 402exclude(library(threadutil)). 403exclude(library(check_installation)). 404exclude(library(sty_pldoc)). 405exclude(library(sty_xpce)). 406exclude(library(tabling)). 407exclude(library(theme/dark)). 408exclude(library(http/dcg_basics)). 409exclude(library(chr/chr_translate_bootstrap1)). 410exclude(library(chr/chr_translate_bootstrap2)). 411exclude(library(trace/pprint)). 412exclude(library(xref/quintus)). 413exclude(library(xref/sicstus)). 414exclude(library(pldoc/hooks)). 415 416excluded_directory(Dir) :- 417 exclude_dir(Spec), 418 spec_base(Spec, Base), 419 atom_concat(/, Base, SBase), 420 once(sub_atom(Dir, _, _, _, SBase)), 421 absolute_file_name(Spec, Dir1, 422 [ file_type(directory), 423 access(read), 424 solutions(all) 425 ]), 426 sub_atom(Dir, 0, _, _, Dir1), 427 !, 428 report_excluded(excluded(rule(Spec), Dir)). 429 430exclude_dir(swi(xpce/prolog/lib/compatibility)). 431 432 433 /******************************* 434 * AGGREGATES * 435 *******************************/
442qmake_aggregates :- 443 retractall(qlf_part_of(_,_)), 444 forall(aggregate_qlf(Spec), 445 qmake_aggregate(Spec)). 446 447qmake_aggregate(Spec) :- 448 exists_source(Spec), 449 !, 450 qlf_make(Spec), 451 absolute_file_name(Spec, PlFile, 452 [ file_type(prolog), 453 access(read) 454 ]), 455 pl_qlf_file(PlFile, QlfFile), 456 '$qlf_sources'(QlfFile, Sources), 457 forall(member(source(S), Sources), 458 assertz(qlf_part_of(S, PlFile))). 459qmake_aggregate(_). 460 461aggregate_qlf(library(pce)). 462aggregate_qlf(library(trace/trace)). 463aggregate_qlf(library(emacs/emacs)). 464 465 466 /******************************* 467 * FILE SEARCH PATH * 468 *******************************/ 469 470:- multifile 471 user:file_search_path/2. 472 473user:file_search_path(chr, library(chr)). 474user:file_search_path(pldoc, library(pldoc)). 475user:file_search_path(doc, swi(xpce/prolog/lib/doc)). 476 477 478 /******************************* 479 * FEEDBACK * 480 *******************************/ 481 482report_work(Files, Rebuild) :- 483 length(Files, AllFiles), 484 length(Rebuild, NeedsRebuild), 485 print_message(informational, qlf_make(planning(AllFiles, NeedsRebuild))). 486 487progress(_PlFile) :- 488 current_prolog_flag(verbose, silent), 489 !. 490progress(PlFile) :- 491 stream_property(user_output, tty(true)), 492 current_prolog_flag(color_term, true), 493 \+ debugging(qlf_make), 494 !, 495 ansi_format(comment, '\r~w ...', [PlFile]), 496 format(user_output, '\e[K', []), 497 flush_output(user_output). 498progress(PlFile) :- 499 format(user_output, '~N~w ...', [PlFile]), 500 flush_output(user_output). 501 502report_excluded(Msg) :- 503 debugging(qlf_make), 504 !, 505 print_message(informational, qlf_make(Msg)). 506report_excluded(_). 507 508:- multifile prolog:message//1. 509 510prologmessage(qlf_make(Msg)) --> 511 message(Msg). 512 513message(planning(_AllFiles, 0)) ==> 514 []. 515message(planning(AllFiles, AllFiles)) ==> 516 [ 'Building ~D qlf files'-[AllFiles] ]. 517message(planning(AllFiles, NeedsRebuild)) ==> 518 [ '~D qlf files. ~D need to be rebuild'-[AllFiles, NeedsRebuild] ]. 519message(size(Count, Qlfize, PlSize)) ==> 520 [ '~D qlf files take ~D bytes. Source ~D bytes'- 521 [Count, Qlfize, PlSize] 522 ]. 523message(excluded(Reason, File)) ==> 524 [ 'Excluded ', url(File) ], 525 excl_reason(Reason). 526 527excl_reason(part(_Main)) --> 528 [ ' (part of aggregate QLF)' ]. 529excl_reason(rule(_Spec)) --> 530 [ ' (explicit)' ]
Compile the library to QLF format
Compilation mode:
doc_collect(false)
.*/