%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Adapter file for ECLiPSe 6.1#143 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.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% this file should be loaded into module "user" with language set to "iso";
% the provided "eclipselgt.sh" script ensures that by using the "eclipse"
% command-line options "-L iso -t user"
:- pragma(system).
:- pragma(nodebug).
:- if((get_flag(version_as_list, Version), Version @< [7,0,24])).
:- ensure_loaded(library(iso_strict)).
:- import compare/3, term_variables/2 from iso_strict.
:- endif.
:- if((get_flag(version_as_list, Version), Version @>= [7,0,26])).
:- ensure_loaded(library(prolog_extras)).
:- import predicate_property/2 from prolog_extras.
:- endif.
:- if((get_flag(version_as_list, Version), Version @>= [7])).
:- use_module(library(threads)).
:- if(\+ get_flag(mutex_property/2, defined, on)).
mutex_property(_, alias(Alias)) :-
catch(with_mutex(Alias,true), _, fail).
:- endif.
:- endif.
:- set_event_handler(134, '$lgt_eclipse_discontiguous_predicate_handler'/2).
'$lgt_eclipse_discontiguous_predicate_handler'(Err, Goal) :-
( '$lgt_increment_loading_warnings_counter' ->
true
; % likely not compiling a Logtalk source file
true
),
error(default(Err), Goal).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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.
:- local syntax_option(not(iso_restrictions)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% de facto standard Prolog predicates that might be missing
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% between(+integer, +integer, ?integer)
:- if(\+ get_flag(between/3, type, built_in)).
:- ensure_loaded(library(util)).
:- import between/3 from util.
:- endif.
% findall(?term, +callable, ?list, +list)
:- if(\+ get_flag(findall/4, type, built_in)).
findall(Term, Goal, List, Tail) :-
findall(Term, Goal, List0),
append(List0, Tail, List).
:- endif.
% forall(+callable, +callable)
:- meta_predicate(forall(0, 0)).
forall(Generate, Test) :-
\+ (Generate, \+ Test).
% format(+stream_or_alias, +character_code_list_or_atom, +list)
% format(+character_code_list_or_atom, +list)
:- use_module(library(format)).
'$lgt_format'(Stream, Format, Arguments) :-
format(Stream, Format, Arguments).
'$lgt_format'(Format, Arguments) :-
format(Format, Arguments).
% numbervars(?term, +integer, ?integer)
:- use_module(library(numbervars)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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'(':'(Module,Predicate), Property) :-
!,
functor(Predicate, Functor, Arity),
'$lgt_eclipse_module_predicate_property'(Module, Functor/Arity, Property).
:- if((get_flag(version_as_list, Version), Version @> [7,0,24])).
'$lgt_predicate_property'(setup_call_cleanup(_, _, _), built_in).
:- endif.
'$lgt_predicate_property'(Predicate, Property) :-
!,
functor(Predicate, Functor, Arity),
'$lgt_eclipse_plain_predicate_property'(Functor/Arity, Property).
'$lgt_eclipse_module_predicate_property'(Module, Predicate, built_in) :-
get_flag(Predicate, type, built_in)@Module.
'$lgt_eclipse_module_predicate_property'(Module, Predicate, dynamic) :-
get_flag(Predicate, stability, dynamic)@Module.
'$lgt_eclipse_module_predicate_property'(Module, Predicate, static) :-
get_flag(Predicate, stability, static)@Module.
'$lgt_eclipse_module_predicate_property'(Module, Predicate, meta_predicate(Template)) :-
get_flag(Predicate, meta_predicate, Template)@Module.
:- if(\+ get_flag(numbervars/3, type, built_in)).
'$lgt_eclipse_plain_predicate_property'(numbervars/3, built_in).
:- endif.
:- if(get_flag(predicate_property/2, defined, on)).
'$lgt_eclipse_plain_predicate_property'(predicate_property/2, built_in).
:- endif.
:- if((get_flag(version_as_list, Version), Version @>= [7])).
'$lgt_eclipse_plain_predicate_property'(thread_exit/1, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_sleep/1, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_property/2, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_self/1, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_create/1, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_create/2, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_create/3, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_join/2, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_signal/2, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_peek_message/1, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_peek_message/2, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_get_message/1, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_get_message/2, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_send_message/1, built_in).
'$lgt_eclipse_plain_predicate_property'(thread_send_message/2, built_in).
'$lgt_eclipse_plain_predicate_property'(mutex_create/1, built_in).
'$lgt_eclipse_plain_predicate_property'(mutex_create/2, built_in).
'$lgt_eclipse_plain_predicate_property'(with_mutex/2, built_in).
'$lgt_eclipse_plain_predicate_property'(message_queue_create/2, built_in).
'$lgt_eclipse_plain_predicate_property'(message_queue_create/1, built_in).
'$lgt_eclipse_plain_predicate_property'(message_queue_destroy/1, built_in).
:- endif.
'$lgt_eclipse_plain_predicate_property'(Predicate, built_in) :-
get_flag(Predicate, type, built_in).
'$lgt_eclipse_plain_predicate_property'(Predicate, dynamic) :-
get_flag(Predicate, stability, dynamic).
'$lgt_eclipse_plain_predicate_property'(Predicate, static) :-
get_flag(Predicate, stability, static).
'$lgt_eclipse_plain_predicate_property'(Predicate, meta_predicate(Template)) :-
get_flag(Predicate, meta_predicate, Template).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% meta-predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% setup_call_cleanup(+callable, +callable, +callable)
:- if((get_flag(version_as_list, Version), Version @> [7,0,24])).
:- ensure_loaded(library(prolog_extras)).
:- import setup_call_cleanup/3 from prolog_extras.
:- endif.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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).
'$lgt_prolog_meta_predicate'(~(_), ~(0), control_construct).
'$lgt_prolog_meta_predicate'(block(_, _, _), block(0, *, 0), predicate).
'$lgt_prolog_meta_predicate'(call_priority(_, _), call_priority(0, *), predicate).
'$lgt_prolog_meta_predicate'(coverof(_, _, _), coverof(*, 0, *), predicate).
'$lgt_prolog_meta_predicate'(do(_, _), do(*, 0), predicate).
'$lgt_prolog_meta_predicate'(event_create(_, _, _), event_create(0, *, *), predicate).
'$lgt_prolog_meta_predicate'(fail_if(_), fail_if(0), predicate).
'$lgt_prolog_meta_predicate'(make_suspension(_, _, _), make_suspension(0, *, *), predicate).
'$lgt_prolog_meta_predicate'(mutex(_, _), mutex(*, 0), predicate).
'$lgt_prolog_meta_predicate'(not(_), not(0), predicate).
:- if((get_flag(version_as_list, Version), Version @> [7,0,24])).
'$lgt_prolog_meta_predicate'(setup_call_cleanup(_, _, _), setup_call_cleanup(0, 0, 0), predicate).
:- endif.
'$lgt_prolog_meta_predicate'(subcall(_, _), subcall(0, *), predicate).
'$lgt_prolog_meta_predicate'(suspend(_, _, _), suspend(0, *, *), predicate).
'$lgt_prolog_meta_predicate'(suspend(_, _, _, _), suspend(0, *, *, *), predicate).
:- if((get_flag(version_as_list, Version), Version @>= [7,0,35])).
'$lgt_prolog_meta_predicate'(engine_post(_, _), engine_post(*, 0), predicate).
'$lgt_prolog_meta_predicate'(thread_create(_), thread_create(0), predicate).
'$lgt_prolog_meta_predicate'(thread_create(_, _), thread_create(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'(with_mutex(_, _), with_mutex(*, 0), predicate).
:- endif.
% '$lgt_prolog_meta_directive'(@callable, -callable)
'$lgt_prolog_meta_directive'(demon(_), demon(/)).
'$lgt_prolog_meta_directive'(inline(_, _), inline(/, /)).
'$lgt_prolog_meta_directive'(set_error_handler(_, _), set_error_handler(*, /)).
'$lgt_prolog_meta_directive'(set_flag(_, _, _), set_flag(/, *, *)).
'$lgt_prolog_meta_directive'(skipped(_), skipped(/)).
% '$lgt_prolog_to_logtalk_meta_argument_specifier_hook'(@nonvar, -atom)
'$lgt_prolog_to_logtalk_meta_argument_specifier_hook'(++, *). % ground normal argument
% '$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'(_) :-
fail.
% '$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'(atom_string(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(breal(_)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(integer_atom(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(name(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(number_string(_, _)).
'$lgt_candidate_tautology_or_falsehood_goal_hook'(rational(_)).
% '$lgt_prolog_database_predicate'(@callable)
%
% table of non-standard database built-in predicates
'$lgt_prolog_database_predicate'(assert(_)).
'$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'(_) :-
fail.
% '$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, '.ecl').
'$lgt_file_extension'(prolog, '.prolog').
'$lgt_file_extension'(prolog, '.pro').
'$lgt_file_extension'(tmp, Extension) :-
get_flag(eclipse_object_suffix, Extension0), % '.eco' by default
atom_string(Extension, Extension0).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% backend Prolog compiler features
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_prolog_feature'(?atom, ?atom)
%
% backend Prolog compiler supported features (that are compatible with Logtalk)
'$lgt_prolog_feature'(prolog_dialect, eclipse).
'$lgt_prolog_feature'(prolog_version, v(Major, Minor, Build)) :-
get_flag(version_as_list, [Major, Minor, Build]).
'$lgt_prolog_feature'(prolog_compatible_version, @>=(v(6,1,143))).
'$lgt_prolog_feature'(encoding_directive, unsupported).
'$lgt_prolog_feature'(tabling, unsupported).
:- if((get_flag(version_as_list, Version), Version @>= [7,0,35])).
'$lgt_prolog_feature'(engines, supported).
:- else.
'$lgt_prolog_feature'(engines, unsupported).
:- endif.
'$lgt_prolog_feature'(threads, unsupported).
'$lgt_prolog_feature'(modules, supported).
'$lgt_prolog_feature'(coinduction, supported).
'$lgt_prolog_feature'(unicode, unsupported).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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) :-
( getenv('COMSPEC', _) ->
% Windows systems define this environment variable...
ScratchDirectory = './lgt_tmp/'
; % ... but not POSIX systems
ScratchDirectory = './.lgt_tmp/'
).
'$lgt_default_flag'(report, Report) :-
argv(all, Arguments),
atom_string('--quiet', String),
( member(String, Arguments) ->
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, [debug:off]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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) :-
os_file_name(PrologPath, OSPath).
% '$lgt_expand_path'(+atom, -atom)
%
% expands a file path to a full path
'$lgt_expand_path'(Path, ExpandedPath) :-
canonical_path_name(Path, ExpandedPath0),
% delete any ending slash as we can have a file with
% the same name (minus extension) as a sub-directory
( sub_atom(ExpandedPath0, _, 1, 0, '/') ->
sub_atom(ExpandedPath0, 0, _, 1, ExpandedPath)
; ExpandedPath = ExpandedPath0
).
% '$lgt_file_exists'(+atom)
%
% checks if a directory exists
'$lgt_file_exists'(File) :-
exists(File),
get_file_info(File, type, file).
% '$lgt_delete_file'(+atom)
%
% deletes a file
'$lgt_delete_file'(File) :-
( exists(File) ->
delete(File)
; true
).
% '$lgt_directory_exists'(+atom)
%
% checks if a directory exists
'$lgt_directory_exists'(Directory) :-
canonical_path_name(Directory, Path),
exists(Path),
get_file_info(Path, type, directory).
% '$lgt_current_directory'(-atom)
%
% gets current working directory
'$lgt_current_directory'(Directory) :-
getcwd(DirectoryString),
atom_string(Directory, DirectoryString).
% '$lgt_change_directory'(+atom)
%
% changes current working directory
'$lgt_change_directory'(Directory) :-
cd(Directory).
% '$lgt_make_directory'(+atom)
%
% makes a new directory; succeeds if the directory already exists
'$lgt_make_directory'(Directory) :-
( '$lgt_directory_exists'(Directory) ->
true
; mkdir(Directory)
).
% '$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, 1, 2147483647, Hash),
'$lgt_prolog_feature'(prolog_dialect, Dialect),
get_flag(pid, PID),
atomics_to_string(['_', Hash, '_', Dialect], HashDialectString),
atom_string(HashDialect, HashDialectString),
atomics_to_string(['_', Hash, '_', PID], HashPidString),
atom_string(HashPid, HashPidString).
% '$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, _, Options) :-
% remove the Prolog file name extension in order to support generating
% and loading of .eco files when using the output:eco option
'$lgt_file_extension'(object, Extension),
atom_concat(Path, Extension, File),
get_stream(log_output, Stream),
set_stream(log_output, null),
( compile(Path, Options) ->
set_stream(log_output, Stream)
; set_stream(log_output, Stream),
fail
).
% '$lgt_load_prolog_file'(+atom)
%
% compile and (re)load a Prolog file (used in standards compliance tests)
'$lgt_load_prolog_file'(File) :-
compile(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) :-
get_file_info(File, mtime, Time).
% '$lgt_environment_variable'(?atom, ?atom)
%
% access to operating-system environment variables
'$lgt_environment_variable'(Variable, Value) :-
getenv(Variable, ValueString),
atom_string(Value, ValueString).
% '$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) :-
pathname(File, DirectoryString, NameString, ExtensionString),
atom_string(Directory0, DirectoryString),
( Directory0 = '' ->
Directory = './'
; Directory = Directory0
),
atom_string(Name, NameString),
atom_string(Extension, ExtensionString).
% '$lgt_directory_files'(+atom, -list(atom))
%
% returns a list of files in the given directory
'$lgt_directory_files'(Directory, Files) :-
read_directory(Directory, '*', Directories0, Files0),
findall(File1, (member(File0, Files0), atom_string(File1, File0)), Files1),
findall(Directory1, (member(Directory0, Directories0), atom_string(Directory1, Directory0)), Directories1),
append(['.', '..'| Directories1], Files1, 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) :-
get_stream_info(Stream, line, Last),
Line is Last + 1.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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_open'(File, Mode, Stream, Options) :-
open(File, Mode, Stream, Options).
% '$lgt_close'(@stream)
'$lgt_close'(Stream) :-
close(Stream).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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))
:- if((get_flag(version_as_list, Version), Version @>= [7,0,35])).
'$lgt_read_term'(Stream, Term, Options, LineBegin-LineEnd) :-
get_stream_info(Stream, line, LineLast),
read_term(Stream, Term, [syntax_errors(error)| Options]),
LineBegin is LineLast + 1,
get_stream_info(Stream, line, LineEnd).
:- else.
'$lgt_read_term'(Stream, Term, Options, LineBegin-LineEnd) :-
get_stream_info(Stream, line, LineLast),
( read_term(Stream, Term, Options) ->
LineBegin is LineLast + 1,
get_stream_info(Stream, line, LineEnd)
; throw(syntax_error)
).
:- endif.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Prolog dialect specific term and goal expansion
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'$lgt_prolog_term_expansion'((:- Directive), Expanded) :-
nonvar(Directive),
% allow first-argument indexing
catch('$lgt_eclipse_directive_expansion'(Directive, Expanded), _, fail).
'$lgt_eclipse_directive_expansion'(module(Spec), (:- module(Spec, []))).
'$lgt_eclipse_directive_expansion'(mode(_), []).
'$lgt_eclipse_directive_expansion'(comment(_, _), []).
'$lgt_eclipse_directive_expansion'(export(chtab(Char, Class)), {:- export(chtab(Char, Class))}).
'$lgt_eclipse_directive_expansion'(export(domain(Domain)), {:- export(domain(Domain))}).
'$lgt_eclipse_directive_expansion'(export(struct(Struct)), {:- export(struct(Struct))}).
'$lgt_eclipse_directive_expansion'(export(syntax_option(SyntaxOption)), {:- export(syntax_option(SyntaxOption))}).
'$lgt_eclipse_directive_expansion'(op(Priority, Specifier, ':'(Module,Operators)), {:- op(Priority, Specifier, Operators)}) :-
Module == user.
'$lgt_eclipse_directive_expansion'(pragma(Pragma), {:- pragma(Pragma)}).
'$lgt_eclipse_directive_expansion'(set_event_handler(Event, defers(Functor/Arity)), {:- set_event_handler(Event, defers(CFunctor/CArity))}) :-
logtalk_load_context(entity_type, _),
'$lgt_compile_predicate_indicators'(Functor/Arity, _, CFunctor/CArity).
'$lgt_eclipse_directive_expansion'(set_event_handler(Event, Functor/Arity), {:- set_event_handler(Event, CFunctor/CArity)}) :-
logtalk_load_context(entity_type, _),
'$lgt_compile_predicate_indicators'(Functor/Arity, _, CFunctor/CArity).
'$lgt_eclipse_directive_expansion'(import(from(Conjunction, Module)), (:- 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_flatten_to_list'(Conjunction, Imports).
'$lgt_eclipse_directive_expansion'(import(from(Conjunction, Module)), [{:- import(from(Conjunction, Module))}, (:- use_module(Module, Imports))]) :-
logtalk_load_context(entity_type, _),
% object or category using a Prolog module
'$lgt_flatten_to_list'(Conjunction, Imports),
import(from(Conjunction, Module)).
'$lgt_eclipse_directive_expansion'(local(Functor/Arity), (:- private(Functor/Arity))).
'$lgt_eclipse_directive_expansion'(local(op(Priority, Spec, Operators)), (:- op(Priority, Spec, Operators))).
'$lgt_eclipse_directive_expansion'(lib(Library), (:- use_module(Module, Exports))) :-
logtalk_load_context(entity_type, module),
% we're compiling a module as an object; assume referenced modules are also compiled as objects
!,
'$lgt_eclipse_list_of_exports'(library(Library), Module, Exports).
'$lgt_eclipse_directive_expansion'(lib(Library), [{:- lib(Library)}, (:- use_module(Module, Exports))]) :-
logtalk_load_context(entity_type, _),
% object or category using a Prolog module
'$lgt_eclipse_list_of_exports'(library(Library), Module, Exports),
lib(Library).
'$lgt_eclipse_directive_expansion'(reexport(File), [(:- use_module(Module, Exports)), (:- export(Exports))]) :-
atom(File),
'$lgt_eclipse_list_of_exports'(File, Module, Exports).
'$lgt_eclipse_directive_expansion'(reexport(from(Conjunction, Module)), (:- reexport(Module, Exports))) :-
'$lgt_flatten_to_list'(Conjunction, Exports).
'$lgt_eclipse_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_eclipse_list_of_exports'(File, Module, Imports).
'$lgt_eclipse_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, _),
'$lgt_eclipse_list_of_exports'(File, Module, Imports),
use_module(File).
'$lgt_eclipse_list_of_exports'(File, Module, Exports) :-
( get_flag(prolog_suffix, Suffixes), existing_file(File, Suffixes, [], ExtRel) ->
true
; % we may be compiling Prolog module files as Logtalk objects
existing_file(File, [`.lgt`,`.logtalk`], [], ExtRel) ->
true
; ExtRel = File
),
canonical_path_name(ExtRel, Path),
open(Path, read, In),
catch(read(In, ModuleDecl), _, (close(In), fail)),
( ModuleDecl = (:- module(Module, Interface)) ->
true
; ModuleDecl = (:- module(Module)) ->
( current_module(Module) ->
true
; ensure_loaded(File)
),
get_module_info(Module, interface, Interface)
),
'$lgt_eclipse_filter_exports'(Interface, Exports),
!.
'$lgt_eclipse_filter_exports'([], []).
'$lgt_eclipse_filter_exports'([Functor/Arity| Interface], [Functor/Arity| Exports]) :-
'$lgt_eclipse_filter_exports'(Interface, Exports).
'$lgt_eclipse_filter_exports'([op(Priority, Spec, Operators)| Interface], [op(Priority, Spec, Operators)| Exports]) :-
'$lgt_eclipse_filter_exports'(Interface, Exports).
'$lgt_eclipse_filter_exports'([export(Functor/Arity)| Interface], [Functor/Arity| Exports]) :-
!,
'$lgt_eclipse_filter_exports'(Interface, Exports).
'$lgt_eclipse_filter_exports'([export(op(Priority, Spec, Operators))| Interface], [op(Priority, Spec, Operators)| Exports]) :-
!,
'$lgt_eclipse_filter_exports'(Interface, Exports).
'$lgt_eclipse_filter_exports'([export(_)| Interface], Exports) :-
!,
'$lgt_eclipse_filter_exports'(Interface, Exports).
% '$lgt_prolog_goal_expansion'(@callable, -callable)
'$lgt_prolog_goal_expansion'(_, _) :-
fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% converts between Prolog stream encoding names and XML encoding names
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_logtalk_prolog_encoding'(?atom, ?atom, +stream)
'$lgt_logtalk_prolog_encoding'(_, _, _) :-
fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% lambda expressions support predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_copy_term_without_constraints'(@term, ?term)
'$lgt_copy_term_without_constraints'(Term, Copy) :-
copy_term(Term, Copy, _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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, _Kind, _Path, _Line) :-
write_canonical(Stream, Term),
write(Stream, '.\n').
% '$lgt_assertz_entity_clause'(@clause, +atom)
'$lgt_assertz_entity_clause'(Clause, _Kind) :-
assertz(Clause).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% error term normalization (when exception terms don't follow the ISO
% Prolog standard)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_normalize_error_term'(@callable, -callable)
'$lgt_normalize_error_term'(
Error,
Error
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% message token printing
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%:- multifile('$logtalk#0.print_message_token#4'/5).
%:- dynamic('$logtalk#0.print_message_token#4'/5).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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)
:- if(\+ predicate_property(atomic_concat(_, _, _), built_in)).
atomic_concat(Atomic1, Atomic2, Atom) :-
( var(Atomic1) ->
throw(error(instantiation_error, atomic_concat/3))
; var(Atomic2) ->
throw(error(instantiation_error, atomic_concat/3))
; \+ atomic(Atomic1) ->
throw(error(type_error(atomic, Atomic1), atomic_concat/3))
; \+ atomic(Atomic2) ->
throw(error(type_error(atomic, Atomic2), atomic_concat/3))
; '$lgt_eclipse_atomic_atom'(Atomic1, Atom1),
'$lgt_eclipse_atomic_atom'(Atomic2, Atom2),
atom_concat(Atom1, Atom2, Atom)
).
'$lgt_eclipse_atomic_atom'(Atomic, Atom) :-
( atom(Atomic) ->
Atom = Atomic
; number_codes(Atomic, Codes),
atom_codes(Atom, Codes)
).
:- endif.
% atomic_list_concat(@list(atomic), ?atom)
:- if(\+ predicate_property(atomic_list_concat(_, _), built_in)).
atomic_list_concat([Atomic| Atomics], Atom) :-
!,
( var(Atomic) ->
throw(error(instantiation_error, atomic_list_concat/2))
; \+ atomic(Atomic) ->
throw(error(type_error(atomic, Atomic), atomic_list_concat/2))
; '$lgt_eclipse_atomic_atom'(Atomic, Atom0),
'$lgt_eclipse_atomic_list_concat'(Atomics, Atom0, Atom)
).
atomic_list_concat([], '').
'$lgt_eclipse_atomic_list_concat'([Next| Atomics], Atom0, Atom) :-
!,
atomic_list_concat([Next| Atomics], Atom1),
atom_concat(Atom0, Atom1, Atom).
'$lgt_eclipse_atomic_list_concat'([], Atom, Atom).
:- endif.
% atomic_list_concat(@list(atomic), +atom, ?atom)
:- if(\+ predicate_property(atomic_list_concat(_, _, _), built_in)).
atomic_list_concat([Atomic| Atomics], Separator, Atom) :-
!,
( var(Atomic) ->
throw(error(instantiation_error, atomic_list_concat/3))
; var(Separator) ->
throw(error(instantiation_error, atomic_list_concat/3))
; \+ atomic(Atomic) ->
throw(error(type_error(atomic, Atomic), atomic_list_concat/3))
; \+ atomic(Separator) ->
throw(error(type_error(atomic, Separator), atomic_list_concat/3))
; '$lgt_eclipse_atomic_atom'(Atomic, Atom0),
'$lgt_eclipse_atomic_atom'(Separator, SeparatorAtom),
'$lgt_eclipse_atomic_list_concat'(Atomics, Atom0, SeparatorAtom, Atom)
).
atomic_list_concat([], _, '').
'$lgt_eclipse_atomic_list_concat'([Next| Atomics], Atom0, SeparatorAtom, Atom) :-
!,
atomic_list_concat([Next| Atomics], SeparatorAtom, Atom2),
atom_concat(SeparatorAtom, Atom2, Atom1),
atom_concat(Atom0, Atom1, Atom).
'$lgt_eclipse_atomic_list_concat'([], Atom, _, Atom).
:- endif.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% string built-in type
%
% define these predicates to trivially fail if no string type is available
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% '$lgt_string'(@term)
'$lgt_string'(Term) :-
string(Term).
% '$lgt_string_codes'(+string, -list(codes))
% '$lgt_string_codes'(-string, +list(codes))
'$lgt_string_codes'(String, Codes) :-
string_list(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)
'$lgt_user_module_qualification'(Goal, Goal).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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) :-
fail.
% '$lgt_current_module_predicate'(+atom, +predicate_indicator)
%
% succeeds when Module defines Predicate
'$lgt_current_module_predicate'(user, Predicate) :-
!,
current_module_predicate(defined, Predicate)@user.
'$lgt_current_module_predicate'(Module, Predicate) :-
current_module_predicate(exported_reexported, Predicate)@Module.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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!
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%