%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Adapter file for SWI Prolog 6.6.0 and later versions
% Last updated on November 12, 2024
%
% This file is part of Logtalk
% SPDX-FileCopyrightText: 1998-2024 Paulo Moura
% SPDX-License-Identifier: Apache-2.0
%
% Licensed under the Apache License, Version 2.0 (the "License");
% you may not use this file except in compliance with the License.
% You may obtain a copy of the License at
%
% http://www.apache.org/licenses/LICENSE-2.0
%
% Unless required by applicable law or agreed to in writing, software
% distributed under the License is distributed on an "AS IS" BASIS,
% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
% See the License for the specific language governing permissions and
% limitations under the License.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% the following flag controls output of SWI-Prolog specific source location
% information when writing the intermediate Prolog files generated by the
% compilation of Logtalk source files; setting this flag to "true" is
% required for integration with some SWI-Prolog developer tools such as
% the graphical tracer; see the `settings-sample.lgt` file for details
:- create_prolog_flag(logtalk_source_location_data, false, []).
:- set_prolog_flag(generate_debug_info, false).
% the following directive is commented due to all the SWI-Prolog
% libraries that don't compile/work in "iso" mode
%:- set_prolog_flag(iso, true).
% disable SWI-Prolog discontiguous predicate clauses warning
% as the Logtalk compiler does its own detection and there's
% no point in printing the same warning twice
%
%:- multifile(message_hook/3).
%:- dynamic(message_hook/3).
%message_hook(discontiguous(_), _, _).
:- if(\+ license:license(asl2, _, _)).
:- multifile(license:license/3).
license:license(asl2, permissive, [
comment('Apache License 2.0'),
url('http://www.apache.org/licenses/LICENSE-2.0')
]).
:- endif.
:- license(asl2, 'Logtalk').
:- if(exists_source(library(prolog_evaluable))).
:- use_module(library(prolog_evaluable), [evaluable_property/2]).
:- endif.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% ISO Prolog Standard predicates that we must define because they are
% not built-in
%
% add a clause for '$lgt_iso_predicate'/1 declaring each ISO predicate that
% we must define; there must be at least one clause for this predicate
% whose call should fail if we don't define any ISO predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_iso_predicate'(?callable).
'$lgt_iso_predicate'(_) :-
fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% de facto standard Prolog predicates that might be missing
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% between(+integer, +integer, ?integer) -- built-in
% findall(?term, +callable, ?list, +list) -- built-in
% forall(+callable, +callable) -- built-in
% format(+stream_or_alias, +character_code_list_or_atom, +list) -- built-in
'$lgt_format'(Stream, Format, Arguments) :-
format(Stream, Format, Arguments).
'$lgt_format'(Format, Arguments) :-
format(Format, Arguments).
% format(+character_code_list_or_atom, +list) -- built-in
% numbervars(?term, +integer, ?integer) -- built-in
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% predicate properties
%
% this predicate must return at least static, dynamic, and built_in
% properties for an existing predicate (and ideally meta_predicate/1
% properties for built-in predicates and library predicates)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_predicate_property'(+callable, ?predicate_property)
'$lgt_predicate_property'(Pred, Prop) :-
% avoid calls to predicate_property/2 triggering library auto-loading
% (as this could introduce unwanted dependencies) by calling
% current_predicate/1 first (which never triggers auto-loading)
( Pred = Module:Callable ->
functor(Callable, Functor, Arity),
current_predicate(Module:Functor/Arity)
; functor(Pred, Functor, Arity),
current_predicate(Functor/Arity)
),
predicate_property(Pred, Prop).
% SWI-Prolog provides a sleep/1 predicate instead of the thread_sleep/1
% predicate specified in the ISO Prolog Threads standardization proposal;
% we simply defined this predicate later this file and pretend that it's
% a built-in predicate
'$lgt_predicate_property'(thread_sleep(_), built_in).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% meta-predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% setup_call_cleanup(+callable, +callable, +callable) -- built-in
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Prolog non-standard built-in meta-predicates and meta-directives
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_prolog_meta_predicate'(@callable, ?callable, ?atom)
%
% table of meta-predicate patterns for proprietary built-in predicates;
% the third argument, which must be either "predicate" or "control_construct",
% is used to guide the compilation of these meta-predicates in debug mode
'$lgt_prolog_meta_predicate'(*->(_, _), *->(0, 0), control_construct).
:- if(predicate_property(block(_, _, _), built_in)).
'$lgt_prolog_meta_predicate'(block(_, _, _), block(*, 0, *), predicate).
:- endif.
'$lgt_prolog_meta_predicate'(call_cleanup(_, _), call_cleanup(0, 0), predicate).
'$lgt_prolog_meta_predicate'(call_cleanup(_, _, _), call_cleanup(0, *, 0), predicate).
'$lgt_prolog_meta_predicate'(call_with_depth_limit(_, _, _), call_with_depth_limit(0, *, *), predicate).
'$lgt_prolog_meta_predicate'(call_with_inference_limit(_, _, _), call_with_inference_limit(0, *, *), predicate).
'$lgt_prolog_meta_predicate'(compile_predicates(_), compile_predicates([/]), predicate).
'$lgt_prolog_meta_predicate'(dynamic(_), dynamic(/), predicate).
'$lgt_prolog_meta_predicate'(findall(_, _, _, _), findall(*, 0, *, *), predicate).
'$lgt_prolog_meta_predicate'(freeze(_, _), freeze(*, 0), predicate).
'$lgt_prolog_meta_predicate'(multifile(_), multifile(/), predicate).
'$lgt_prolog_meta_predicate'(not(_), not(0), predicate).
'$lgt_prolog_meta_predicate'(notrace(_), notrace(0), predicate).
'$lgt_prolog_meta_predicate'(on_signal(_, _, _), on_signal(*, *, 0), predicate).
'$lgt_prolog_meta_predicate'(setup_call_cleanup(_, _, _), setup_call_cleanup(0, 0, 0), predicate).
'$lgt_prolog_meta_predicate'(setup_call_catcher_cleanup(_, _, _, _), setup_call_catcher_cleanup(0, 0, *, 0), predicate).
'$lgt_prolog_meta_predicate'(thread_initialization(_), thread_initialization(0), predicate).
'$lgt_prolog_meta_predicate'(thread_at_exit(_), thread_at_exit(0), predicate).
'$lgt_prolog_meta_predicate'(thread_create(_, _, _), thread_create(0, *, *), predicate).
'$lgt_prolog_meta_predicate'(thread_signal(_, _), thread_signal(*, 0), predicate).
'$lgt_prolog_meta_predicate'(trace(_), trace(0), predicate).
'$lgt_prolog_meta_predicate'(trace(_, _), trace(0, *), predicate).
:- if(predicate_property(win_insert_menu_item(_, _, _, _), built_in)).
'$lgt_prolog_meta_predicate'(win_insert_menu_item(_, _, _, _), win_insert_menu_item(*, *, *, 0), predicate).
:- endif.
'$lgt_prolog_meta_predicate'(with_mutex(_, _), with_mutex(*, 0), predicate).
'$lgt_prolog_meta_predicate'(with_output_to(_, _), with_output_to(*, 0), predicate).
% workaround problematic meta-predicate declarations:
'$lgt_prolog_meta_predicate'(consult(_), consult(*), predicate).
'$lgt_prolog_meta_predicate'(current_op(_, _, _), current_op(*, *, *), predicate).
'$lgt_prolog_meta_predicate'(ensure_loaded(_), ensure_loaded(*), predicate).
'$lgt_prolog_meta_predicate'(format(_, _), format(*, *), predicate).
'$lgt_prolog_meta_predicate'(format(_, _, _), format(*, *, *), predicate).
'$lgt_prolog_meta_predicate'(load_files(_), load_files(*), predicate).
'$lgt_prolog_meta_predicate'(load_files(_, _), load_files(*, *), predicate).
'$lgt_prolog_meta_predicate'(op(_, _, _), op(*, *, *), predicate).
:- if(predicate_property(table(_), built_in)).
'$lgt_prolog_meta_predicate'(table(_), table(/), predicate).
:- endif.
:- if(predicate_property(tnot(_), built_in)).
'$lgt_prolog_meta_predicate'(tnot(_), tnot(0), predicate).
:- endif.
:- if(predicate_property(untable(_), built_in)).
'$lgt_prolog_meta_predicate'(untable(_), untable(/), predicate).
:- endif.
'$lgt_prolog_meta_predicate'(use_module(_), use_module(*), predicate).
'$lgt_prolog_meta_predicate'(use_module(_, _), use_module(*, *), predicate).
% '$lgt_prolog_meta_directive'(@callable, -callable)
'$lgt_prolog_meta_directive'(at_halt(_), at_halt(0)).
'$lgt_prolog_meta_directive'(format_predicate(_, _), format_predicate(*, 0)).
'$lgt_prolog_meta_directive'(initialization(_, _), initialization(0, *)).
'$lgt_prolog_meta_directive'(noprofile(_), noprofile(/)).
:- if(predicate_property(table(_), built_in)).
'$lgt_prolog_meta_directive'(table(_), table(/)).
:- endif.
'$lgt_prolog_meta_directive'(thread_initialization(_), thread_initialization(0)).
'$lgt_prolog_meta_directive'(thread_local(_), thread_local(/)) :-
logtalk_load_context(entity_type, Type),
Type \== module.
'$lgt_prolog_meta_directive'(volatile(_), volatile(/)).
% '$lgt_prolog_to_logtalk_meta_argument_specifier_hook'(@nonvar, -atom)
'$lgt_prolog_to_logtalk_meta_argument_specifier_hook'((//), 2).
% '$lgt_prolog_phrase_predicate'(@callable)
%
% table of predicates that call non-terminals
% (other than the de facto standard phrase/2-3 predicates)
'$lgt_prolog_phrase_predicate'(call_dcg(_, _, _)).
'$lgt_prolog_phrase_predicate'(pio:phrase_from_file(_, _)).
'$lgt_prolog_phrase_predicate'(pio:phrase_from_file(_, _, _)).
'$lgt_prolog_phrase_predicate'(pio:phrase_from_stream(_, _)).
'$lgt_prolog_phrase_predicate'(pure_input:phrase_from_file(_, _)).
'$lgt_prolog_phrase_predicate'(pure_input:phrase_from_file(_, _, _)).
'$lgt_prolog_phrase_predicate'(pure_input:phrase_from_stream(_, _)).
% '$lgt_candidate_tautology_or_falsehood_goal_hook'(@callable)
%
% valid candidates are proprietary built-in predicates with no
% side-effects when called with ground arguments
'$lgt_candidate_tautology_or_falsehood_goal_hook'(_ =@= _).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(_ \=@= _).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(?=(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(atom_number(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(atom_string(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(cyclic_term(_)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(name(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(number_string(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(plus(_, _, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(rational(_)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(succ(_, _)).
% '$lgt_prolog_database_predicate'(@callable)
%
% table of non-standard database built-in predicates
'$lgt_prolog_database_predicate'(assert(_)).
'$lgt_prolog_database_predicate'(assert(_, _)).
'$lgt_prolog_database_predicate'(asserta(_, _)).
'$lgt_prolog_database_predicate'(assertz(_, _)).
'$lgt_prolog_database_predicate'(clause(_, _, _)).
'$lgt_prolog_database_predicate'(listing(_)).
% '$lgt_prolog_predicate_property'(?callable)
%
% table of proprietary predicate properties; used by the
% compiler when checking if a predicate property is valid
'$lgt_prolog_predicate_property'(discontiguous).
'$lgt_prolog_predicate_property'(indexed(_)).
'$lgt_prolog_predicate_property'(monotonic).
'$lgt_prolog_predicate_property'(opaque).
'$lgt_prolog_predicate_property'(tabled).
'$lgt_prolog_predicate_property'(tabled(_)).
'$lgt_prolog_predicate_property'(thread_local).
'$lgt_prolog_predicate_property'(volatile).
% '$lgt_prolog_deprecated_built_in_predicate_hook'(?callable, ?callable)
%
% table of proprietary deprecated built-in predicates
% when there's a Prolog system advised alternative
'$lgt_prolog_deprecated_built_in_predicate_hook'(_, _) :-
fail.
% '$lgt_prolog_deprecated_built_in_predicate_hook'(?callable)
%
% table of proprietary deprecated built-in predicates without
% a direct advised alternative
'$lgt_prolog_deprecated_built_in_predicate_hook'(_) :-
fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% file name extension predicates
%
% these extensions are used by Logtalk load/compile predicates
%
% you may want to change the extension for the intermediate files
% generated by the Logtalk compiler ("object" files) to match the
% extension expected by default by your Prolog compiler
%
% there should only a single extension defined for object files but
% but multiple extensions can be defined for Logtalk and Prolog source
% files and for backend specific temporary files
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_file_extension'(?atom, ?atom)
'$lgt_file_extension'(logtalk, '.lgt').
'$lgt_file_extension'(logtalk, '.logtalk').
% there must be a single object file extension
'$lgt_file_extension'(object, '.pl').
'$lgt_file_extension'(prolog, '.pl').
'$lgt_file_extension'(prolog, '.prolog').
'$lgt_file_extension'(prolog, '.pro').
'$lgt_file_extension'(tmp, '.qlf').
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% backend Prolog compiler features
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_prolog_feature'(?atom, ?atom)
%
% backend Prolog compiler supported features (that are compatible with Logtalk)
'$lgt_prolog_feature'(prolog_dialect, swi).
'$lgt_prolog_feature'(prolog_version, v(Major, Minor, Patch)) :-
current_prolog_flag(version_data, swi(Major, Minor, Patch, _)).
'$lgt_prolog_feature'(prolog_compatible_version, @>=(v(6,6,0))).
'$lgt_prolog_feature'(encoding_directive, full).
'$lgt_prolog_feature'(tabling, Tabling) :-
current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
( (Major,Minor,Patch) @>= (7,3,21) ->
Tabling = supported
; Tabling = unsupported
).
'$lgt_prolog_feature'(engines, Engines) :-
( current_prolog_flag(threads, true) ->
Engines = supported,
volatile('$lgt_current_engine_'/4)
; Engines = unsupported
).
'$lgt_prolog_feature'(threads, Threads) :-
( current_prolog_flag(threads, true) ->
Threads = supported
; Threads = unsupported
).
'$lgt_prolog_feature'(modules, supported).
'$lgt_prolog_feature'(coinduction, supported).
'$lgt_prolog_feature'(unicode, full).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% default flag values
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_default_flag'(?atom, ?atom)
%
% default values for all flags
% startup flags:
'$lgt_default_flag'(settings_file, allow).
% lint compilation flags:
'$lgt_default_flag'(linter, default).
'$lgt_default_flag'(general, warning).
'$lgt_default_flag'(encodings, warning).
'$lgt_default_flag'(unknown_entities, warning).
'$lgt_default_flag'(unknown_predicates, warning).
'$lgt_default_flag'(undefined_predicates, warning).
'$lgt_default_flag'(singleton_variables, warning).
'$lgt_default_flag'(steadfastness, silent).
'$lgt_default_flag'(naming, silent).
'$lgt_default_flag'(duplicated_clauses, silent).
'$lgt_default_flag'(left_recursion, warning).
'$lgt_default_flag'(tail_recursive, silent).
'$lgt_default_flag'(disjunctions, warning).
'$lgt_default_flag'(conditionals, warning).
'$lgt_default_flag'(catchall_catch, silent).
'$lgt_default_flag'(portability, silent).
'$lgt_default_flag'(redefined_built_ins, silent).
'$lgt_default_flag'(redefined_operators, warning).
'$lgt_default_flag'(deprecated, warning).
'$lgt_default_flag'(missing_directives, warning).
'$lgt_default_flag'(duplicated_directives, warning).
'$lgt_default_flag'(trivial_goal_fails, warning).
'$lgt_default_flag'(always_true_or_false_goals, warning).
'$lgt_default_flag'(lambda_variables, warning).
'$lgt_default_flag'(grammar_rules, warning).
'$lgt_default_flag'(arithmetic_expressions, warning).
'$lgt_default_flag'(suspicious_calls, warning).
'$lgt_default_flag'(underscore_variables, dont_care).
% optional features compilation flags:
'$lgt_default_flag'(complements, deny).
'$lgt_default_flag'(dynamic_declarations, deny).
'$lgt_default_flag'(events, deny).
'$lgt_default_flag'(context_switching_calls, allow).
% other compilation flags:
'$lgt_default_flag'(scratch_directory, ScratchDirectory) :-
( current_prolog_flag(unix, true) ->
ScratchDirectory = './.lgt_tmp/'
; ScratchDirectory = './lgt_tmp/'
).
'$lgt_default_flag'(report, Report) :-
( current_prolog_flag(verbose, silent) ->
Report = warnings
; Report = on
).
'$lgt_default_flag'(clean, on).
'$lgt_default_flag'(code_prefix, '$').
'$lgt_default_flag'(optimize, off).
'$lgt_default_flag'(source_data, on).
'$lgt_default_flag'(reload, changed).
'$lgt_default_flag'(debug, off).
% Prolog compiler and loader flags:
'$lgt_default_flag'(prolog_compiler, []).
'$lgt_default_flag'(prolog_loader, [silent(true), optimise(true)]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% operating-system access predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_prolog_os_file_name'(+atom, -atom)
% '$lgt_prolog_os_file_name'(-atom, +atom)
%
% converts between Prolog internal file paths and operating-system paths
'$lgt_prolog_os_file_name'(PrologPath, OSPath) :-
prolog_to_os_filename(PrologPath, OSPath).
% '$lgt_expand_path'(+atom, -atom)
%
% expands a file path to a full path
'$lgt_expand_path'(Path, ExpandedPath) :-
working_directory(Current, Current),
( absolute_file_name(Path, [expand(true), relative_to(Current), file_errors(fail)], ExpandedPath) ->
true
; absolute_file_name(Path, [expand(true), relative_to(Current), file_type(directory), file_errors(fail)], ExpandedPath)
).
% '$lgt_file_exists'(+atom)
%
% checks if a file exists
'$lgt_file_exists'(File) :-
exists_file(File).
% '$lgt_delete_file'(+atom)
%
% deletes a file
'$lgt_delete_file'(File) :-
delete_file(File).
% '$lgt_directory_exists'(+atom)
%
% checks if a directory exists
'$lgt_directory_exists'(Directory) :-
expand_file_name(Directory, [Path]),
exists_directory(Path).
% '$lgt_current_directory'(-atom)
%
% gets current working directory
'$lgt_current_directory'(Directory) :-
working_directory(Directory, Directory).
% '$lgt_change_directory'(+atom)
%
% changes current working directory
'$lgt_change_directory'(Directory) :-
% fix possible mix of forward and backward slashes
prolog_to_os_filename(Directory, Path),
% expand environment variables
expand_file_name(Path, [Expanded]),
% convert to SWI-Prolog notation for paths
prolog_to_os_filename(Fixed, Expanded),
working_directory(_, Fixed).
% '$lgt_make_directory'(+atom)
%
% makes a new directory; succeeds if the directory already exists
'$lgt_make_directory'(Directory) :-
% fix possible mix of forward and backward slashes
prolog_to_os_filename(Directory, Path),
% expand environment variables
expand_file_name(Path, [Expanded]),
% convert to SWI-Prolog notation for paths
prolog_to_os_filename(Fixed, Expanded),
( exists_directory(Fixed) ->
true
; make_directory(Fixed)
).
% '$lgt_directory_hashes'(+atom, -atom, -atom)
%
% returns the directory hash and dialect as an atom with the format _hash_dialect
% plus the the directory hash and PID as an atom with the format _hash_pid
'$lgt_directory_hashes'(Directory, HashDialect, HashPid) :-
term_hash(Directory, Hash),
'$lgt_prolog_feature'(prolog_dialect, Dialect),
current_prolog_flag(pid, PID),
atomic_list_concat(['_', Hash, '_', Dialect], HashDialect),
atomic_list_concat(['_', Hash, '_', PID], HashPid).
% '$lgt_compile_prolog_code'(+atom, +atom, +list)
%
% compile to disk a Prolog file, resulting from a
% Logtalk source file, given a list of flags
'$lgt_compile_prolog_code'(_, _, _).
% '$lgt_load_prolog_code'(+atom, +atom, +list)
%
% compile and load a Prolog file, resulting from a
% Logtalk source file, given a list of flags
'$lgt_load_prolog_code'(File, Source, Options) :-
% only record the "derived from" information between the Logtalk
% source file and the generated intermediate Prolog file when
% integrating with the SWI-Prolog developer tools
( current_prolog_flag(logtalk_source_location_data, true) ->
LoadOptions = [derived_from(Source)| Options]
; LoadOptions = Options
),
% remove the Prolog file name extension in order to support generating
% and loading of .qlf files when using the qcompile/1 option
file_name_extension(Path, _, File),
( style_check('?'(singleton)) ->
% turn off singleton variable checking as the built-in
% write_canonical/2 predicate can generate code that
% triggers the new singleton analysis introduced in
% SWI-Prolog 6.5.0
setup_call_cleanup(
style_check('-'(singleton)),
load_files(Path, LoadOptions),
style_check('+'(singleton))
)
; load_files(Path, LoadOptions)
).
% '$lgt_load_prolog_file'(+atom)
%
% compile and (re)load a Prolog file (used in standards compliance tests)
'$lgt_load_prolog_file'(File) :-
load_files(File).
% '$lgt_file_modification_time'(+atom, -nonvar)
%
% gets a file modification time, assumed to be an opaque term but comparable
'$lgt_file_modification_time'(File, Time) :-
time_file(File, Time).
% '$lgt_environment_variable'(?atom, ?atom)
%
% access to operating-system environment variables
'$lgt_environment_variable'(Variable, Value) :-
getenv(Variable, Value).
% '$lgt_decompose_file_name'(+atom, ?atom, ?atom, ?atom)
%
% decomposes a file path in its components; the directory must always end
% with a slash; the extension must start with a "." when defined and must
% be the empty atom when it does not exist
'$lgt_decompose_file_name'(File, Directory, Name, Extension) :-
file_directory_name(File, Directory0),
atom_concat(Directory0, '/', Directory),
file_base_name(File, Basename),
file_name_extension(Name, Extension0, Basename),
( Extension0 = '' ->
Extension = Extension0
; atom_concat('.', Extension0, Extension)
).
% '$lgt_directory_files'(+atom, -list(atom))
%
% returns a list of files in the given directory
'$lgt_directory_files'(Directory, Files) :-
directory_files(Directory, Files).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% getting stream current line number
% (needed for improved compiler error messages)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_stream_current_line_number'(@stream, -integer)
'$lgt_stream_current_line_number'(Stream, Line) :-
stream_property(Stream, position(Position)),
stream_position_data(line_count, Position, Line).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% abstraction of the standard open/4 and close/1 predicates for dealing
% with required proprietary actions when opening and closing streams
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_open'(+atom, +atom, -stream, @list)
% '$lgt_close'(@stream)
:- if(predicate_property('$push_input_context'(_), built_in)).
'$lgt_open'(File, Mode, Stream, Options) :-
open(File, Mode, Stream, Options),
'$push_input_context'(logtalk).
'$lgt_close'(Stream) :-
'$pop_input_context',
close(Stream).
:- else.
'$lgt_open'(File, Mode, Stream, Options) :-
open(File, Mode, Stream, Options).
'$lgt_close'(Stream) :-
close(Stream).
:- endif.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% customized version of the read_term/3 predicate for returning the term
% position (start and end lines; needed for improved error messages) due
% to the lack of a standard option for this purpose
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_read_term'(@stream, -term, +list, -pair(integer,integer))
'$lgt_read_term'(Stream, Term, Options, LineBegin-LineEnd) :-
read_term(Stream, Term, [term_position(PositionBegin), syntax_errors(error)| Options]),
stream_position_data(line_count, PositionBegin, LineBegin),
stream_property(Stream, position(PositionEnd)),
stream_position_data(line_count, PositionEnd, LineEnd).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Prolog dialect specific term and goal expansion
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_prolog_term_expansion'(@callable, -callable)
'$lgt_prolog_term_expansion'((:- Directive), Expanded) :-
nonvar(Directive),
% allow first-argument indexing
catch('$lgt_swi_directive_expansion'(Directive, Expanded), _, fail).
'$lgt_swi_directive_expansion'(public(_), []) :-
% used to provide information about module predicates to the cross-referencer
logtalk_load_context(entity_type, module).
'$lgt_swi_directive_expansion'(style_check(Option), []) :-
style_check(Option).
'$lgt_swi_directive_expansion'(arithmetic_function(Functor/Arity), {:- arithmetic_function(Functor/Arity)}) :-
logtalk_load_context(entity_type, _),
'$lgt_compile_predicate_indicators'(Functor/Arity, _, TFunctor/TArity),
functor(Term, Functor, TArity),
Term =.. [_| Args],
TArity2 is TArity + 1,
functor(TTerm, TFunctor, TArity2),
TTerm =.. [_| TArgs],
'$lgt_swi_unify_head_thead_args'(Args, TArgs),
'$lgt_compile_aux_clauses'([({Term} :- {TTerm})]).
'$lgt_swi_directive_expansion'(create_prolog_flag(Key, Value, Options), {:- create_prolog_flag(Key, Value, Options)}).
'$lgt_swi_directive_expansion'(expects_dialect(Dialect), {:- expects_dialect(Dialect)}) :-
expects_dialect(Dialect).
'$lgt_swi_directive_expansion'(license(License), {:- license(License)}).
'$lgt_swi_directive_expansion'(set_prolog_flag(generate_debug_info, false), {:- set_prolog_flag(generate_debug_info, false)}).
'$lgt_swi_directive_expansion'(use_foreign_library(File), {:- use_foreign_library(File)}) :-
load_foreign_library(File).
'$lgt_swi_directive_expansion'(use_foreign_library(File, Entry), {:- use_foreign_library(File, Entry)}) :-
load_foreign_library(File, Entry).
'$lgt_swi_directive_expansion'(encoding(Encoding1), (:- encoding(Encoding2))) :-
nonvar(Encoding1),
'$lgt_swi_encoding_to_logtalk_encoding'(Encoding1, Encoding2).
'$lgt_swi_directive_expansion'(ensure_loaded(File), Expanded) :-
logtalk_load_context(entity_type, module),
% ensure_loaded/1 directive used within a module
% (sloppy replacement for the use_module/1-2 directives)
'$lgt_swi_directive_expansion'(use_module(File), Expanded).
'$lgt_swi_directive_expansion'(op(Priority, Specifier, Module:Operators), {:- op(Priority, Specifier, Operators)}) :-
Module == user.
'$lgt_swi_directive_expansion'(use_module(File, Imports0), (:- use_module(Module, Imports))) :-
logtalk_load_context(entity_type, module),
% we're compiling a module as an object; assume referenced modules are also compiled as objects
!,
'$lgt_swi_list_of_exports'(File, Module, Exports),
'$lgt_swi_filter_imports'(Imports0, Exports, Imports1),
'$lgt_swi_fix_predicate_aliases'(Imports1, Imports).
'$lgt_swi_directive_expansion'(use_module(File, Imports0), [{:- use_module(File, Imports0)}, (:- use_module(Module, Imports))]) :-
logtalk_load_context(entity_type, _),
% object or category using a Prolog module
'$lgt_swi_list_of_exports'(File, Module, Exports),
'$lgt_swi_filter_imports'(Imports0, Exports, Imports1),
'$lgt_swi_fix_predicate_aliases'(Imports1, Imports),
use_module(File, Imports0).
'$lgt_swi_directive_expansion'(use_module(File), []) :-
logtalk_load_context(entity_type, module),
% we're compiling a module as an object
File == library(yall),
% library(yall) implements Logtalk's lambda expressions
!.
'$lgt_swi_directive_expansion'(use_module(File), (:- use_module(Module, Imports))) :-
File \= [_| _],
% not the Logtalk use_module/1 directive
logtalk_load_context(entity_type, module),
% we're compiling a module as an object;
% assume referenced modules are also compiled as objects
!,
'$lgt_swi_list_of_exports'(File, Module, Imports).
'$lgt_swi_directive_expansion'(use_module(File), [{:- use_module(File)}, (:- use_module(Module, Imports))]) :-
File \= [_| _],
% not the Logtalk use_module/1 directive
logtalk_load_context(entity_type, _),
% object or category using a Prolog module
'$lgt_swi_list_of_exports'(File, Module, Imports),
use_module(File).
'$lgt_swi_directive_expansion'(autoload(File, Imports), Expansion) :-
'$lgt_swi_directive_expansion'(use_module(File, Imports), Expansion).
'$lgt_swi_directive_expansion'(autoload(File), Expansion) :-
'$lgt_swi_directive_expansion'(use_module(File), Expansion).
'$lgt_swi_directive_expansion'(module(Module,Exports0), [(:- module(Module,Exports))| Clauses]) :-
'$lgt_swi_split_predicate_aliases'(Exports0, Exports, Clauses).
'$lgt_swi_directive_expansion'(reexport([]), []) :-
!.
'$lgt_swi_directive_expansion'(reexport([File| Files]), [(:- use_module(Module, Exports)), (:- export(Exports))| Terms]) :-
!,
'$lgt_swi_list_of_exports'(File, Module, Exports0),
'$lgt_swi_fix_predicate_aliases'(Exports0, Exports),
'$lgt_swi_directive_expansion'(reexport(Files), Terms).
'$lgt_swi_directive_expansion'(reexport(File), [(:- use_module(Module, Exports)), (:- export(Exports))]) :-
'$lgt_swi_list_of_exports'(File, Module, Exports0),
'$lgt_swi_fix_predicate_aliases'(Exports0, Exports).
'$lgt_swi_directive_expansion'(reexport(File, Exports0), (:- reexport(Module, Exports))) :-
'$lgt_swi_list_of_exports'(File, Module, OriginalExports),
'$lgt_swi_filter_imports'(Exports0, OriginalExports, Exports1),
'$lgt_swi_fix_predicate_aliases'(Exports1, Exports).
'$lgt_swi_directive_expansion'(thread_local(Predicates), [{:- thread_local(TPredicates)}, (:- dynamic(Predicates))]) :-
logtalk_load_context(entity_type, module),
'$lgt_compile_predicate_indicators'(Predicates, _, TPredicates).
'$lgt_swi_directive_expansion'(table(as(Predicates,Properties)), {:- table(as(TPredicates,Properties))}) :-
logtalk_load_context(entity_type, _),
'$lgt_swi_table_directive_expansion'(Predicates, TPredicates).
'$lgt_swi_directive_expansion'(table(Predicates), {:- table(TPredicates)}) :-
logtalk_load_context(entity_type, _),
'$lgt_swi_table_directive_expansion'(Predicates, TPredicates).
'$lgt_swi_directive_expansion'(dynamic(as(Predicates,Properties)), Expansion) :-
'$lgt_swi_directive_expansion'(dynamic(Predicates,Properties), Expansion).
'$lgt_swi_directive_expansion'(dynamic(Predicates,Properties), [{:- dynamic(TPredicates,Properties)}, (:- dynamic(Predicates))| Directives]) :-
logtalk_load_context(entity_type, _),
'$lgt_compile_predicate_indicators'(Predicates, _, TPredicates),
'$lgt_swi_dynamic_directive_expansion'(Properties, Predicates, TPredicates, Directives).
'$lgt_swi_directive_expansion'(begin_tests(_, _), (:- if(fail))) :-
logtalk_load_context(entity_type, module).
'$lgt_swi_directive_expansion'(begin_tests(_), (:- if(fail))) :-
logtalk_load_context(entity_type, module).
'$lgt_swi_directive_expansion'(end_tests(_), (:- endif)) :-
logtalk_load_context(entity_type, module).
'$lgt_swi_table_directive_expansion'([Predicate| Predicates], [TPredicate| TPredicates]) :-
!,
'$lgt_swi_table_directive_predicate'(Predicate, TPredicate),
'$lgt_swi_table_directive_expansion'(Predicates, TPredicates).
'$lgt_swi_table_directive_expansion'((Predicate, Predicates), (TPredicate, TPredicates)) :-
!,
'$lgt_swi_table_directive_predicate'(Predicate, TPredicate),
'$lgt_swi_table_directive_expansion'(Predicates, TPredicates).
'$lgt_swi_table_directive_expansion'(Predicate, TPredicate) :-
'$lgt_swi_table_directive_predicate'(Predicate, TPredicate).
'$lgt_swi_table_directive_predicate'(F/A, TF/TA) :-
!,
'$lgt_compile_predicate_indicators'(F/A, _, TF/TA).
'$lgt_swi_table_directive_predicate'(F//A, TF/TA) :-
!,
A2 is A + 2,
'$lgt_compile_predicate_indicators'(F/A2, _, TF/TA).
'$lgt_swi_table_directive_predicate'(Head, THead) :-
'$lgt_compile_predicate_heads'(Head, _, THead, _).
'$lgt_swi_dynamic_directive_expansion'([], _, _, []).
'$lgt_swi_dynamic_directive_expansion'([thread(Local)| Properties], Predicates, TPredicates, [{:- thread_local(TPredicates)}| Directives]) :-
Local == local,
!,
'$lgt_swi_dynamic_directive_expansion'(Properties, Predicates, TPredicates, Directives).
'$lgt_swi_dynamic_directive_expansion'([multifile(Boolean)| Properties], Predicates, TPredicates, [(:- multifile(Predicates))| Directives]) :-
Boolean == true,
!,
'$lgt_swi_dynamic_directive_expansion'(Properties, Predicates, TPredicates, Directives).
'$lgt_swi_dynamic_directive_expansion'([discontiguous(Boolean)| Properties], Predicates, TPredicates, [(:- discontiguous(Predicates))| Directives]) :-
Boolean == true,
!,
'$lgt_swi_dynamic_directive_expansion'(Properties, Predicates, TPredicates, Directives).
'$lgt_swi_dynamic_directive_expansion'([volatile(Boolean)| Properties], Predicates, TPredicates, [{:- volatile(TPredicates)}| Directives]) :-
Boolean == true,
!,
'$lgt_swi_dynamic_directive_expansion'(Properties, Predicates, TPredicates, Directives).
'$lgt_swi_dynamic_directive_expansion'([_| Properties], Predicates, TPredicates, Directives) :-
!,
'$lgt_swi_dynamic_directive_expansion'(Properties, Predicates, TPredicates, Directives).
'$lgt_swi_dynamic_directive_expansion'(Properties, Predicates, TPredicates, Directives) :-
'$lgt_swi_conjunction_to_list'(Properties, List),
'$lgt_swi_dynamic_directive_expansion'(List, Predicates, TPredicates, Directives).
'$lgt_swi_conjunction_to_list'(Term, [Term]) :-
var(Term),
!.
'$lgt_swi_conjunction_to_list'((Term, Conjunction), [Term| Terms]) :-
!,
'$lgt_swi_conjunction_to_list'(Conjunction, Terms).
'$lgt_swi_conjunction_to_list'(Term, [Term]).
'$lgt_swi_unify_head_thead_args'([], [_]).
'$lgt_swi_unify_head_thead_args'([Arg| Args], [Arg| ExtArgs]) :-
'$lgt_swi_unify_head_thead_args'(Args, ExtArgs).
'$lgt_swi_list_of_exports'(File, Module, Exports) :-
( logtalk_load_context(directory, Directory)
; logtalk_load_context(file, IncludeFile),
file_directory_name(IncludeFile, Directory)
),
absolute_file_name(File, Path, [file_type(prolog), access(read), file_errors(fail), relative_to(Directory)]),
( module_property(Module, file(Path)),
% only succeeds for loaded modules
module_property(Module, exports(Predicates)) ->
( module_property(Module, exported_operators(Operators)) ->
% this property fails instead of returning the empty list!
'$lgt_append'(Predicates, Operators, Exports)
; Exports = Predicates
)
; object_property(Module, file(Path)),
object_property(Module, module),
% module compiled as an object
object_property(Module, public(Exports))
),
!.
'$lgt_swi_list_of_exports'(File, Module, Exports) :-
( logtalk_load_context(directory, Directory)
; logtalk_load_context(file, IncludeFile),
file_directory_name(IncludeFile, Directory)
),
( absolute_file_name(File, Path, [file_type(prolog), access(read), file_errors(fail), relative_to(Directory)])
; % we may be compiling Prolog module files as Logtalk objects
absolute_file_name(File, Path, [extensions(['.lgt','.logtalk']), access(read), file_errors(fail), relative_to(Directory)])
),
open(Path, read, In),
% deal with #! script; if not present assume that the
% module declaration is the first directive on the file
( peek_char(In, #) ->
skip(In, 10)
; true
),
setup_call_cleanup(true, '$lgt_swi_read_module_directive'(In, Module, Exports), close(In)),
( var(Module) ->
file_base_name(Path, Base),
file_name_extension(Module, _, Base)
; true
),
!.
'$lgt_swi_read_module_directive'(Stream, Module, Exports) :-
% fragile hack as it ignores predicates exported via reexport/1-2 directives
read(Stream, FirstTerm),
( FirstTerm = (:- module(Module, Exports)) ->
true
; FirstTerm = (:- encoding(_)) ->
read(Stream, SecondTerm),
SecondTerm = (:- module(Module, Exports))
; fail
).
'$lgt_swi_filter_imports'([], _, []).
'$lgt_swi_filter_imports'([Import| Imports], _, [Import| Imports]).
'$lgt_swi_filter_imports'(except(Excluded), Exports, Imports) :-
findall(
Import,
( '$lgt_member'(Import, Exports),
\+ '$lgt_member'(Import, Excluded)
),
Imports
).
'$lgt_swi_split_predicate_aliases'([], [], []).
'$lgt_swi_split_predicate_aliases'([as(Functor/Arity, Alias)| Exports0], [Alias/Arity| Exports], [Clause| Clauses]) :-
!,
functor(Template, Functor, Arity),
Template =.. [Functor| Arguments],
AliasTemplate =.. [Alias| Arguments],
Clause = (AliasTemplate :- Template),
'$lgt_swi_split_predicate_aliases'(Exports0, Exports, Clauses).
'$lgt_swi_split_predicate_aliases'([Export| Exports0], [Export| Exports], Clauses) :-
'$lgt_swi_split_predicate_aliases'(Exports0, Exports, Clauses).
'$lgt_swi_fix_predicate_aliases'([], []).
'$lgt_swi_fix_predicate_aliases'([Import0| Imports0], [Import| Imports]) :-
'$lgt_swi_fix_predicate_aliases_aux'([Import0| Imports0], [Import| Imports]).
'$lgt_swi_fix_predicate_aliases'(except(Excluded), except(Excluded)).
'$lgt_swi_fix_predicate_aliases_aux'([], []).
'$lgt_swi_fix_predicate_aliases_aux'([as(Functor/Arity,Alias)| Imports0], [as(Functor/Arity,Alias/Arity)| Imports]) :-
atom(Alias),
!,
'$lgt_swi_fix_predicate_aliases_aux'(Imports0, Imports).
'$lgt_swi_fix_predicate_aliases_aux'([Import| Imports0], [Import| Imports]) :-
'$lgt_swi_fix_predicate_aliases_aux'(Imports0, Imports).
'$lgt_swi_encoding_to_logtalk_encoding'(ascii, 'US-ASCII').
'$lgt_swi_encoding_to_logtalk_encoding'(iso_latin_1, 'ISO-8859-1').
'$lgt_swi_encoding_to_logtalk_encoding'(utf8, 'UTF-8').
'$lgt_swi_encoding_to_logtalk_encoding'(unicode_be, 'UCS-2BE').
'$lgt_swi_encoding_to_logtalk_encoding'(unicode_le, 'UCS-2LE').
% '$lgt_prolog_goal_expansion'(@callable, -callable)
'$lgt_prolog_goal_expansion'(table(Predicates), {table(TPredicates)}) :-
predicate_property(table(_), built_in),
logtalk_load_context(entity_type, _),
'$lgt_swi_table_directive_expansion'(Predicates, TPredicates).
'$lgt_prolog_goal_expansion'(untable(Predicates), {untable(TPredicates)}) :-
predicate_property(untable(_), built_in),
logtalk_load_context(entity_type, _),
'$lgt_swi_table_directive_expansion'(Predicates, TPredicates).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% multi-threading predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% thread_property(+atom, ?nonvar) -- built-in
% thread_self(?atom) -- built-in
% thread_create(@callable, -thread_id, +list) -- built-in
% thread_join(+atom, -nonvar) -- built-in
% thread_detach(+atom) -- built-in
% thread_exit(@term) -- built-in
% thread_send_message(+atom, @callable) -- built-in
% thread_peek_message(+atom, ?callable) -- built-in
% thread_get_message(+atom, ?callable) -- built-in
% thread_get_message(?callable) -- built-in
% thread_sleep(+number)
thread_sleep(Time) :-
sleep(Time).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% converts between Prolog stream encoding names and XML encoding names
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_logtalk_prolog_encoding'(?atom, ?atom, +stream)
'$lgt_logtalk_prolog_encoding'('US-ASCII', ascii, _).
'$lgt_logtalk_prolog_encoding'('ISO-8859-1', iso_latin_1, _).
'$lgt_logtalk_prolog_encoding'('UTF-8', utf8, _).
'$lgt_logtalk_prolog_encoding'('UCS-2', Encoding, Stream) :- % BOM mandatory
( stream_property(Stream, encoding(unicode_be)) ->
Encoding = unicode_be
; stream_property(Stream, encoding(unicode_le)) ->
Encoding = unicode_le
; stream_property(Stream, encoding(utf16le)) ->
Encoding = utf16le
; stream_property(Stream, encoding(utf16be)) ->
Encoding = utf16be
).
'$lgt_logtalk_prolog_encoding'('UCS-2BE', unicode_be, _). % BOM forbidden
'$lgt_logtalk_prolog_encoding'('UCS-2LE', unicode_le, _).
'$lgt_logtalk_prolog_encoding'('UTF-16', Encoding, Stream) :- % BOM optional but strongly recommended
( stream_property(Stream, encoding(unicode_be)) -> % not true of course but usually we can get away with it
Encoding = unicode_be
; stream_property(Stream, encoding(unicode_le)) ->
Encoding = unicode_le
; stream_property(Stream, encoding(utf16le)) ->
Encoding = utf16le
; stream_property(Stream, encoding(utf16be)) ->
Encoding = utf16be
).
'$lgt_logtalk_prolog_encoding'('UTF-16BE', unicode_be, _). % BOM forbidden
'$lgt_logtalk_prolog_encoding'('UTF-16LE', unicode_le, _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% lambda expressions support predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_copy_term_without_constraints'(@term, ?term)
'$lgt_copy_term_without_constraints'(Term, Copy) :-
copy_term_nat(Term, Copy).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% goal_expansion/2 rules to allow calling the Prolog built-in predicates
% phrase/2-3 with a Object::GRBody as the first argument and to optimize
% ::/2 goals from within modules
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- dynamic(user:goal_expansion/2).
:- multifile(user:goal_expansion/2).
% optimize portable format/2-3 calls
user:goal_expansion('$lgt_format'(Stream, Format, Arguments), format(Stream, Format, Arguments)).
user:goal_expansion('$lgt_format'(Format, Arguments), format(Format, Arguments)).
% support calls to phrase/2 that call object non-terminals
user:goal_expansion(phrase(Rule, Input, Rest), ExpandedGoal) :-
nonvar(Rule),
functor(Rule, '::', 2),
!,
'$lgt_execution_context'(ExCtx, user, user, user, user, [], []),
'$lgt_user_module_qualification'('$lgt_phrase'(Rule, Input, Rest, ExCtx), ExpandedGoal).
% support calls to phrase/3 that call object non-terminals
user:goal_expansion(phrase(Rule, Input), ExpandedGoal) :-
nonvar(Rule),
functor(Rule, '::', 2),
!,
'$lgt_execution_context'(ExCtx, user, user, user, user, [], []),
'$lgt_user_module_qualification'('$lgt_phrase'(Rule, Input, ExCtx), ExpandedGoal).
% optimize messages sent from modules (including "user")
user:goal_expansion('::'(Object, Message), ExpandedGoal) :-
callable(Object),
callable(Message),
% check that the object is not compiled in debug mode
'$lgt_current_object_'(Object, _, _, _, _, _, _, _, _, _, Flags),
Flags /\ 512 =\= 512,
% find out in which module Logtalk was loaded (usually, "user")
'$lgt_user_module_qualification'(xx, QualifiedGoal),
QualifiedGoal = ':'(UserModule, xx),
% this module plays the role of the Logtalk pseudo-object "user"
( prolog_load_context(term_position, Position),
stream_position_data(line_count, Position, Line) ->
% loading a file
prolog_load_context(module, Module),
Module \== UserModule,
% loading a Prolog module file
'$lgt_compiler_flag'(events, Events)
; % top-level goal
Line = -1,
% use default value of the "events" flag
'$lgt_current_flag_'(events, Events)
),
'$lgt_comp_ctx'(Ctx, _, _, user, user, user, Obj, _, [], [], ExCtx, compile(aux,_,_), [], Line-Line, _),
'$lgt_execution_context'(ExCtx, user, user, user, Obj, [], []),
catch('$lgt_compile_message_to_object'(Message, Object, Goal, Events, Ctx), _, fail),
'$lgt_user_module_qualification'(Goal, ExpandedGoal).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% hooks predicates for writing and asserting compiled entity terms
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_write_compiled_term'(@stream, @callable, +atom, +atom, +integer)
%
% the third argument is the term type: runtime (internal runtime clause),
% user (compiled user-defined term), or aux (auxiliary clause resulting
% e.g. from term-expansion)
'$lgt_write_compiled_term'(Stream, Term, _, _, _) :-
current_prolog_flag(logtalk_source_location_data, false),
!,
write_canonical(Stream, Term), write(Stream, '.\n').
'$lgt_write_compiled_term'(Stream, '$lgt_current_object_'(Obj,Prefix,Dcl,Def,Super,IDcl,IDef,DDcl,DDef,Rnm,Flags), _, _, _) :-
!,
write_canonical(Stream, (:- '$hide'(Dcl/4))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Dcl/6))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Def/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Def/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Super/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(IDcl/6))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(IDef/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(DDcl/2))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(DDef/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Rnm/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Dcl/4))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Dcl/6))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Def/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Def/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Super/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(IDcl/6))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(IDef/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(DDcl/2))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(DDef/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Rnm/3))), write(Stream, '.\n'),
write_canonical(Stream, '$lgt_current_object_'(Obj,Prefix,Dcl,Def,Super,IDcl,IDef,DDcl,DDef,Rnm,Flags)),
write(Stream, '.\n').
'$lgt_write_compiled_term'(Stream, '$lgt_current_category_'(Ctg,Prefix,Dcl,Def,Rnm,Flags), _, _, _) :-
!,
write_canonical(Stream, (:- '$hide'(Dcl/4))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Dcl/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Def/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Def/4))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Rnm/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Dcl/4))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Dcl/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Def/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Def/4))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Rnm/3))), write(Stream, '.\n'),
write_canonical(Stream, '$lgt_current_category_'(Ctg,Prefix,Dcl,Def,Rnm,Flags)),
write(Stream, '.\n').
'$lgt_write_compiled_term'(Stream, '$lgt_current_protocol_'(Ptc,Prefix,Dcl,Rnm,Flags), _, _, _) :-
!,
write_canonical(Stream, (:- '$hide'(Dcl/4))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Dcl/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- '$hide'(Rnm/3))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Dcl/4))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Dcl/5))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Rnm/3))), write(Stream, '.\n'),
write_canonical(Stream, '$lgt_current_protocol_'(Ptc,Prefix,Dcl,Rnm,Flags)),
write(Stream, '.\n').
'$lgt_write_compiled_term'(Stream, Term, runtime, _, _) :-
!,
write_canonical(Stream, Term), write(Stream, '.\n').
'$lgt_write_compiled_term'(Stream, (:- Directive), _, _, _) :-
% to cope with {(:- Directive)} entity terms
!,
write_canonical(Stream, (:- Directive)), write(Stream, '.\n').
'$lgt_write_compiled_term'(Stream, Term, user, File, Line) :-
!,
write_canonical(Stream, '$source_location'(File,Line):Term), write(Stream, '.\n').
'$lgt_write_compiled_term'(Stream, Term, aux, _, _) :-
!,
( Term = (Head :- _) ->
true
; Term = Head
),
functor(Head, Functor, Arity),
write_canonical(Stream, (:- '$hide'(Functor/Arity))), write(Stream, '.\n'),
write_canonical(Stream, (:- noprofile(Functor/Arity))), write(Stream, '.\n'),
write_canonical(Stream, Term), write(Stream, '.\n').
'$lgt_write_compiled_term'(Stream, Term, _, File, Line) :-
write_canonical(Stream, '$source_location'(File,Line):Term), write(Stream, '.\n').
% '$lgt_assertz_entity_clause'(@clause, +atom)
'$lgt_assertz_entity_clause'('$lgt_current_object_'(Obj,Prefix,Dcl,Def,Super,IDcl,IDef,DDcl,DDef,Rnm,Flags), _) :-
!,
'$hide'(Dcl/4),
'$hide'(Dcl/6),
'$hide'(Def/3),
'$hide'(Def/5),
'$hide'(Super/5),
'$hide'(IDcl/6),
'$hide'(IDef/5),
'$hide'(DDcl/2),
'$hide'(DDef/3),
'$hide'(Rnm/3),
noprofile(Dcl/4),
noprofile(Dcl/6),
noprofile(Def/3),
noprofile(Def/5),
noprofile(Super/5),
noprofile(IDcl/6),
noprofile(IDef/5),
noprofile(DDcl/2),
noprofile(DDef/3),
noprofile(Rnm/3),
assertz('$lgt_current_object_'(Obj,Prefix,Dcl,Def,Super,IDcl,IDef,DDcl,DDef,Rnm,Flags)).
'$lgt_assertz_entity_clause'('$lgt_current_category_'(Ctg,Prefix,Dcl,Def,Rnm,Flags), _) :-
!,
'$hide'(Dcl/4),
'$hide'(Dcl/5),
'$hide'(Def/3),
'$hide'(Def/4),
'$hide'(Rnm/3),
noprofile(Dcl/4),
noprofile(Dcl/5),
noprofile(Def/3),
noprofile(Def/4),
noprofile(Rnm/3),
assertz('$lgt_current_category_'(Ctg,Prefix,Dcl,Def,Rnm,Flags)).
'$lgt_assertz_entity_clause'('$lgt_current_protocol_'(Ptc,Prefix,Dcl,Rnm,Flags), _) :-
!,
'$hide'(Dcl/4),
'$hide'(Dcl/5),
'$hide'(Rnm/3),
noprofile(Dcl/4),
noprofile(Dcl/5),
noprofile(Rnm/3),
assertz('$lgt_current_protocol_'(Ptc,Prefix,Dcl,Rnm,Flags)).
'$lgt_assertz_entity_clause'(Term, aux) :-
!,
( Term = (Head :- _) ->
true
; Term = Head
),
functor(Head, Functor, Arity),
'$hide'(Functor/Arity),
noprofile(Functor/Arity),
assertz(Term).
'$lgt_assertz_entity_clause'(Term, _) :-
assertz(Term).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% error term normalization (when exception terms don't follow the ISO
% Prolog standard)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_normalize_error_term'(@callable, -callable)
'$lgt_normalize_error_term'(Error, NormalizedError) :-
( nonvar(Error),
Error = error(ErrorTerm, Context),
nonvar(Context),
Context = context(TFunctor/TArity, _),
'$lgt_decompile_predicate_indicators'(TFunctor/TArity, Entity, _, Functor/Arity),
functor(Goal, Functor, Arity) ->
NormalizedError = error(ErrorTerm, logtalk(Goal, Entity))
; NormalizedError = Error
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% message token printing
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- multifile('$logtalk#0.print_message_token#4'/5).
:- dynamic('$logtalk#0.print_message_token#4'/5).
'$logtalk#0.print_message_token#4'(Stream, _, ansi(Attributes, Format, Arguments), _, _) :-
prolog:message_line_element(Stream, ansi(Attributes, Format, Arguments)).
'$logtalk#0.print_message_token#4'(Stream, _, begin(Kind0, Var), _, _) :-
'$lgt_swi_convert_message_kind'(Kind0, Kind),
prolog:message_line_element(Stream, begin(Kind, Var)).
'$logtalk#0.print_message_token#4'(Stream, _, end(Var), _, _) :-
prolog:message_line_element(Stream, end(Var)).
'$lgt_swi_convert_message_kind'(comment, informational) :- !.
'$lgt_swi_convert_message_kind'(comment(_), informational) :- !.
'$lgt_swi_convert_message_kind'(Kind0, Kind) :-
functor(Kind0, Kind, _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% term hashing (not currently used in the compiler/runtime)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% term_hash(@callable, +integer, +integer, -integer) -- built-in
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% atomics concat (not currently used in the compiler/runtime)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% atomic_concat(+atomic, +atomic, ?atom) -- built-in
% atomic_list_concat(@list(atomic), ?atom) -- built-in
% atomic_list_concat(@list(atomic), +atom, ?atom) -- built-in
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% string built-in type
%
% define these predicates to trivially fail if no string type is available
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_string'(@term)
'$lgt_string'(String) :-
string(String).
% '$lgt_string_codes'(+string, -list(codes))
% '$lgt_string_codes'(-string, +list(codes))
'$lgt_string_codes'(String, Codes) :-
string_codes(String, Codes).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% module qualification to be used when calling Prolog meta-predicates
% with meta-arguments that are calls to object or category predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_user_module_qualification'(@callable, -callable)
term_expansion(
'$lgt_user_module_qualification'(_, _),
'$lgt_user_module_qualification'(Goal, Module:Goal)) :-
prolog_load_context(module, Module).
'$lgt_user_module_qualification'(_, _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% auxiliary predicates for compiling modules as objects
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_find_module_predicate'(+atom, -atom, @callable)
%
% succeeds when Module:Predicate is visible in module Current
'$lgt_find_visible_module_predicate'(_Current, Module, Predicate) :-
predicate_property(Predicate, imported_from(Module)).
'$lgt_find_visible_module_predicate'(Current, Module, Predicate) :-
import_module(Current, Module),
predicate_property(Predicate, defined),
!.
% '$lgt_current_module_predicate'(+atom, +predicate_indicator)
%
% succeeds when Module defines Predicate
'$lgt_current_module_predicate'(Module, Predicate) :-
current_predicate(Module:Predicate).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% shortcuts to the Logtalk built-in predicates logtalk_load/1 and
% logtalk_make/1
%
% defined in the adapter files to make it easier to comment them out in case
% of conflict with some Prolog native feature; they require conformance with
% the ISO Prolog standard regarding the definition of the {}/1 syntax
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
{X} :-
var(X),
throw(error(instantiation_error, logtalk({X}, _))).
{*} :-
!,
logtalk_make(all).
{!} :-
!,
logtalk_make(clean).
{?} :-
!,
logtalk_make(check).
{@} :-
!,
logtalk_make(circular).
{#} :-
!,
logtalk_make(documentation).
{+d} :-
!,
logtalk_make(debug).
{+n} :-
!,
logtalk_make(normal).
{+o} :-
!,
logtalk_make(optimal).
{$} :-
!,
logtalk_make(caches).
{Files} :-
'$lgt_conjunction_to_list'(Files, List),
logtalk_load(List).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% end!
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%