% utilities.pl :- ensure_loaded('$REGULUS/PrologLib/compatibility'). :- module(utilities, [safe_directory_exists/1, safe_nth/3, safe_working_directory/2, safe_mod_time_for_file/2, safe_remove_duplicates/2, safe_remove_duplicates_preserving_order/2, safe_abolish/1, safe_subsumes_chk/2, safe_print_message/2, %print_message_work_around/2, safe_sum_list/2, safe_max_list/2, safe_min_list/2, is_contiguous_sublist/2, safe_prefix/2, safe_suffix/2, safe_trimcore/0, sleep_if_sicstus4_and_using_gui/0, safe_close_all_streams/0, safe_process_id/1, safe_exec/3, safe_shell/1, safe_shell/2, safe_socket/2, safe_socket_connect/4, safe_socket_connect/5, safe_socket_close/1, safe_socket_server_open/2, safe_socket_server_close/1, safe_socket_server_accept/3, safe_socket_server_accept/4, safe_random_member/2, safe_format_to_chars/3, safe_read_from_chars/2, safe_read_from_chars/3, safe_read/2, safe_close/1, safe_average_list/2, is_assoc_generic/1, empty_assoc_generic/1, assoc_generic_to_list/2, list_to_assoc_generic/2, get_assoc_generic/3, put_assoc_generic/4, min_assoc_generic/3, get_next_assoc_generic/4, require_sicstus_version/2, running_under_windows/0, nuance10_loaded/0, on_cygwin_and_bin_dir_found/0, find_sicstus_encoding_for_file/2, replace_strings_with_atoms_in_xml/2, remove_comments_in_xml/2, set_random_generator_state_from_time/0, safe_number_codes/2, timeouts_unavailable/0, disable_timeouts/0, abolish_if_defined/1, set_compile_timeout/1, safe_compile/2, safe_compile_list/2, safe_compile_with_redefine_warnings_off/2, safe_compile_with_discontiguous_warnings_off/2, safe_compile_with_redefine_and_single_var_warnings_off/2, safe_absolute_file_name/2, safe_rename_file/2, safe_rename_file_using_mv_if_possible/2, safe_directory_files/2, safe_is_directory/1, directory_files_recursive/2, safe_file_exists/1, get_windows_ps_info/1, exec_and_check_process_started/3, kill_process/1, consume_parameter_value_pair/3, current_datime_formatted_as_HMS/1, datime_for_directory/3, datime_for_directory/4, datime_for_directory_recursive/3, datime_for_directory_recursive/4, age_of_file/2, file_is_more_recent_than_files/2, order_files_by_age_most_recent_first/2, datime_for_file/2, datime_for_file_list/3, real_datime/1, earlier_datime/2, datime_to_timestamp/2, parse_datime/2, set_notional_time/1, unset_notional_time/0, get_notional_time/1, set_notional_speaker/1, unset_notional_speaker/0, get_notional_speaker/1, atom_to_int/2, is_number_atom/1, coerce_atom_to_int/2, coerce_int_to_atom/2, timestamped_file/4, next_numbered_file/3, coerce_int_to_two_digit_atom/2, coerce_int_to_three_digit_atom/2, length_of_wavfile_in_seconds/2, wavfile_format_and_encoding/3, wavconvert_file/4, get_transcription_from_wavfile/2, add_transcription_to_wavfile/3, add_transcription_to_wavfile_binary/3, sort_file/2, %get_pulist/1, existing_absolute_file_name/2, %files_in_directory/3, %get_files_in_directory/2, copy_file_between_directories/3, %delete_all_files_in_directory/1, delete_all_files_in_list/1, delete_file_with_status/2, pathname_has_extension/2, split_off_extension_from_pathname/3, change_extension_in_file/3, derived_file_names/5, escape_spaces_in_atom/2, unescape_spaces_in_atom/2, system_on_list/1, system_on_list_to_result/2, shell_writing_output_to_file_and_printing/4, shell_sequence_operator/1, get_java_version/1, last_wavfile_in_dir/2, add_directory_in_pathname/3, wrap_file_names_with_search_paths/3, absolute_windows_file_name/2, directory_and_file_for_pathname/3, create_directory_if_necessary/1, create_directory_above_if_necessary/1, create_directory_for_file_if_necessary/1, create_directory_for_file_if_necessary/2, parent_directory/2, format_to_atom/3, change_slash_to_backslash/2, choose_from_text_menu/3, get_confirmation/2, open_regulus_file/3, divide_file_into_n_parts/2, read_lines_until_non_empty_line/2, read_file_to_string/2, read_file_to_string/3, read_unicode_file_to_string/2, read_unicode_file_to_string_list/2, read_unicode_file_to_atom_list/2, unicode_file_to_normal_file/2, normal_file_to_unicode_file/2, normal_file_to_unicode_file/3, read_file_to_atom_list/2, read_file_to_atom_list/3, read_first_n_records_of_file_to_atom_list/3, number_of_prolog_records_in_file/2, safe_prolog_file_to_list/2, safe_prolog_file_to_list/3, prolog_file_to_list_vars_as_consts/3, safe_prolog_file_to_list_printing_statistics/2, safe_prolog_file_to_list_printing_statistics/3, regulus_file_to_list/2, prolog_file_to_list_null_if_no_file/2, prolog_file_to_list/2, prolog_file_or_files_to_list/2, prolog_file_or_files_to_list/3, prolog_file_to_list_stream/2, prolog_file_or_files_to_list_including_line_info/2, list_to_prolog_file/2, list_to_prolog_file_with_encoding/3, normal_prolog_file_to_prolog_file_with_encoding/3, safe_list_to_prolog_file_printing_statistics/2, list_to_prolog_file_prettyprint/2, list_to_prolog_file_prettyprint_with_encoding/3, list_to_prolog_file_prettyprint_unicode/2, list_to_regulus_file/2, print_file/1, cat_files/2, cat_prolog_files/2, cat_prolog_files/3, copy_file/2, copy_file_binary/2, copy_file_to_stream/2, copy_file_to_dir/2, copy_files_to_dir/2, subtract_files/3, subtract_files/4, print_lines_from_file/3, create_timestamped_copy/2, parse_file/4, getline/2, getline_as_words/2, split_atom_into_words/2, split_atom_into_words/3, split_string_into_words/2, split_string_into_words/3, split_string_into_strings/3, atom_name_contains_string/2, timed_call/2, absolute_timed_call/2, safe_call_saving_output/3, get_tmp_trace_file/1, tmp_regulus_file/2, csv_fields_contain_word_ignoring_case/2, list_of_lists_to_csv_file/2, list_of_lists_to_csv_file/3, list_of_lists_to_csv_file/4, csv_file_to_list_of_lists/2, csv_file_to_list_of_lists/4, csv_file_to_list_of_lists/5, combine_columns_from_csv_files/5, concatenate_headed_csv_files/2, concatenate_headed_csv_files/3, remove_null_lines_from_csv_file/2, remove_null_lines_from_csv_file/3, html_table_file_to_list/2, html_table_file_to_list/3, write_string_list_to_unicode_file/2, write_atom_list_to_unicode_file/2, write_atom_list_to_unicode_file/3, write_atom_list_to_file/2, write_atom_list_to_stream/2, join_with_spaces/2, join_with_underscore/2, append_n_copies/3, append_atoms/2, append_atoms/3, append_strings_with_char/3, atom_or_number_codes/2, term_contains_functor/2, term_contains_subterm/2, substitute_in_term/4, read_prolog_file_and_assert_goals/2, assert_list_of_goals/2, append_list/2, firstn_or_all/3, split_off_firstn/4, is_substring/2, flatten/2, flatten_comma_list/2, is_comma_list/1, is_curly_bracket_list/1, length_of_curly_bracket_list/2, length_of_comma_list/2, curly_bracket_list_to_list/2, comma_list_to_list/2, list_to_curly_bracket_list/2, list_to_comma_list/2, first_elements_of_pairs/2, second_elements_of_pairs/2, normalise_prolog_dcg_clause_to_c_version/2, unkey_list/2, remove_duplicates_from_sorted_file/2, id_member/2, pick_n_random_members_from_list/3, pick_n_random_members_from_list/4, assoc_generics_to_lists_in_term/2, inc_assoc_generic/3, inc_assoc_generic/4, get_assoc_generic_or_zero/3, list_to_ordered_multiset/2, insertions_deletions_substitutions/6, insertions_deletions_substitutions_and_matches/7, identical_up_to_variable_renaming/2, var_or_grounded_var/1, no_vars_or_grounded_vars_in_term/1, make_ground/1, unground/2, try/1, %assert_general/1, numbervars/4, align_word_atoms_for_printing/3, is_list_of_atoms/1, is_prolog_string/1, is_list_of_non_negative_integers/1, quote_layout_chars_in_string/2, quote_layout_chars_in_string_for_json/2, string_to_unicode_string/2, string_to_json_unicode_string/2, convert_strings_to_quoted_atoms/2, strings_same_modulo_casing/2, lowercase_atom_list/2, uppercase_atom/2, uppercase_string/2, initial_uppercase_atom/2, initial_uppercase_string/2, lowercase_atom/2, lowercase_string/2, deaccent_atom/2, deaccent_string/2, whitespace_atom/1, whitespace_char/1, lowercase_string/1, uppercase_string/1, digit_char/1, lowercase_char/1, uppercase_char/1, lowercase_uppercase/2, accented_char/1, deaccent_char/2, punctuation_char/1, set_pp_width/1, set_pp_depth/1, prettyprint/1, prettyprint/2, prettyprint/3, prettyprint/4, prettyprint_to_stream/2, prettyprint_to_stream/3, prettyprint_to_stream/4, prettyprint_to_stream/5, prettyprint_key_val_pair/2, prettyprintq/1, prettyprintq/2, prettyprintq/3, prettyprintq/4, prettyprintq_key_val_pair/2, prettyprintq_to_stream_unlimited_depth/2, prettyprintq_to_stream/2, prettyprintq_to_stream/3, prettyprintq_to_stream/4, prettyprintq_to_stream/5, prettyprintq_to_stream_key_val_pair/3, prettyprint_term_with_intro_grounded/2, prettyprint_term_with_intro_grounded/3, prettyprint_term_with_intro/2, prettyprint_term_with_intro/3, pp_debug/0, no_pp_debug/0 ] ). 'SICSTUS4ONLY'( ( :- use_module(library(file_systems)) ) ). 'SICSTUS4ONLY'( ( :- use_module(library(process)) ) ). :- use_module(library(lists)). :- use_module(library(terms)). :- use_module(library(sockets)). :- use_module(library(random)). :- use_module(library(xml)). :- meta_predicate safe_call_saving_output(:, -, -). :- meta_predicate timed_call(:, +). :- meta_predicate absolute_timed_call(:, +). :- meta_predicate parse_file(+, +, :, +). :- meta_predicate try(:). %:- meta_predicate assert_general(:). %------------------------------------------------------------------------------------ %:- use_module(library(system)). 'SICSTUS3/4'( ( :- use_module(library(system)) ), ( :- use_module(library(system3), [now/1, datime/1, datime/2, environ/2, shell/1, shell/2, sleep/1, exec/3, host_id/1, pid/1, host_name/1, mktemp/2, system/1, system/2, working_directory/2] ) ) ). 'SICSTUS3/4'( ( :- use_module(library(charsio)) ), ( :- use_module('$REGULUS/PrologLib/compatibility_charsio') ) ). 'SICSTUS3/4'( ( :- use_module(library(assoc)) ), ( :- use_module(library(avl) ) ) ). %'SICSTUS3/4'( ( :- use_module(library(assoc)) ), ( :- use_module(library(assoc3) ) ) ). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_directory_exists(Dir) :- file_exists(Dir), file_property(Dir, type(directory)) ), ( safe_directory_exists(Dir) :- directory_exists(Dir) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_nth(N, List, Elem) :- nth(N, List, Elem) ), ( safe_nth(N, List, Elem) :- nth1(N, List, Elem) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_working_directory(Dir1, Dir2) :- working_directory(Dir1, Dir2) ), ( safe_working_directory(Dir1, Dir2) :- current_directory(Dir1, Dir2) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_mod_time_for_file(File, UnixTime) :- file_exists(File), file_property(File, mod_time(UnixTime)) ), ( safe_mod_time_for_file(File, UnixTime) :- ( file_exists(File) -> file_property(File, modify_timestamp, UnixTime) ; directory_exists(File) -> directory_property(File, modify_timestamp, UnixTime) ) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_directory_base_files(Dir, Files) :- directory_files(Dir, Files) ), ( safe_directory_base_files(Dir, BaseFiles) :- directory_exists(Dir), file_members_of_directory(Dir, ProperFilePairs), directory_members_of_directory(Dir, DirectoryPairs), append(ProperFilePairs, DirectoryPairs, FilePairs), first_elements_in_pairs(FilePairs, BaseFiles) )). %------------------------------------------------------------------------------------ % Nasty point: apparently, Sicstus 3 version preserves order, Sicstus 4 version sorts, % and neither piece of functionality is documented! 'SICSTUS3/4'(( safe_remove_duplicates(L1, L2) :- remove_duplicates(L1, L2) ), ( safe_remove_duplicates(L1, L2) :- remove_dups(L1, L2) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_remove_duplicates_preserving_order(L1, L2) :- remove_duplicates(L1, L2) ), ( safe_remove_duplicates_preserving_order(L1, L2) :- remove_dups_preserving_order(L1, [], L2) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_abolish(Pred) :- abolish(Pred) ), ( safe_abolish(Pred) :- abolish(Pred, [force(true)]) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_subsumes_chk(X, Y) :- subsumes_chk(X, Y) ), ( safe_subsumes_chk(X, Y) :- subsumeschk(X, Y) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_print_message(X, Y) :- print_message_work_around(X, Y) ), ( safe_print_message(X, Y) :- print_message(X, Y) %print_message_work_around(X, Y) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_sum_list(X, Y) :- sum_list(X, Y) ), ( safe_sum_list(X, Y) :- sumlist(X, Y) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_max_list(List, Max) :- max_list(List, Max) ), ( safe_max_list(List, Max) :- max_member(Max, List) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_min_list(List, Min) :- min_list(List, Min) ), ( safe_min_list(List, Min) :- min_member(Min, List) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_trimcore :- trimcore ), ( safe_trimcore :- true )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( sleep_if_sicstus4_and_using_gui :- true ), ( sleep_if_sicstus4_and_using_gui :- sleep(1) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_close_all_streams :- true ), ( safe_close_all_streams :- close_all_streams )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_process_id(PID) :- pid(PID) ), ( safe_process_id(PID) :- process_id(PID) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_socket(Type, Socket) :- socket(Type, Socket) ), ( safe_socket(Type, Socket) :- Socket = dummy_socket(Type) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_socket_connect(Socket, Host, Port, Stream) :- safe_socket_connect_sicstus3(Socket, Host, Port, Stream) ), ( safe_socket_connect(_Socket, Host, Port, Stream) :- safe_socket_connect_sicstus4(Host, Port, Stream) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_socket_connect(_Socket, _Host, _Port, _Stream, _OpenStreamParameters) :- require_sicstus_version(4, safe_socket_connect/5) ), ( safe_socket_connect(_Socket, Host, Port, Stream, OpenStreamParameters) :- safe_socket_connect_sicstus4(Host, Port, Stream, OpenStreamParameters) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_socket_close(Socket) :- safe_socket_close_sicstus3(Socket) ), ( safe_socket_close(_Socket) :- true )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_socket_server_open(Port, Socket) :- safe_socket_server_open_sicstus3(Port, Socket) ), ( safe_socket_server_open(Port, Socket) :- socket_server_open(Port, Socket) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_socket_server_close(Socket) :- safe_socket_close_sicstus3(Socket) ), ( safe_socket_server_close(Socket) :- socket_server_close(Socket) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_socket_server_accept(Socket, Client, Stream) :- socket_accept(Socket, Client, Stream) ), ( safe_socket_server_accept(Socket, Client, Stream) :- socket_server_accept(Socket, Client, Stream, [type(text)]) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_socket_server_accept(_Socket, _Client, _Stream, _OpenStreamParameters) :- require_sicstus_version(4, safe_socket_server_accept/4) ), ( safe_socket_server_accept(Socket, Client, Stream, OpenStreamParameters) :- require_sicstus_version(4, socket_server_accept/4), socket_server_accept(Socket, Client, Stream, OpenStreamParameters) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( is_contiguous_sublist(SubList, List) :- is_contiguous_sublist_sicstus3(SubList, List) ), ( is_contiguous_sublist(SubList, List) :- segment(List, SubList) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_prefix(Prefix, List) :- prefix(Prefix, List) ), ( safe_prefix(Prefix, List) :- prefix(List, Prefix) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_suffix(Suffix, List) :- suffix(Suffix, List) ), ( safe_suffix(Suffix, List) :- suffix(List, Suffix) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( is_assoc_generic(Assoc) :- is_assoc(Assoc) ), ( is_assoc_generic(Assoc) :- is_avl(Assoc) %is_assoc(Assoc) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( empty_assoc_generic(Assoc) :- empty_assoc(Assoc) ), ( empty_assoc_generic(Assoc) :- empty_avl(Assoc) %empty_assoc(Assoc) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( assoc_generic_to_list(Assoc, List) :- assoc_to_list(Assoc, List) ), ( assoc_generic_to_list(Assoc, List) :- avl_to_list(Assoc, List) %assoc_to_list(Assoc, List) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( list_to_assoc_generic(List, Assoc) :- list_to_assoc(List, Assoc) ), ( list_to_assoc_generic(List, Assoc) :- list_to_avl(List, Assoc) %list_to_assoc(List, Assoc) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( get_assoc_generic(Key, Assoc, Val) :- get_assoc(Key, Assoc, Val) ), ( get_assoc_generic(Key, Assoc, Val) :- avl_fetch(Key, Assoc, Val) %get_assoc(Key, Assoc, Val) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( put_assoc_generic(Key, OldAssoc, Val, NewAssoc) :- put_assoc(Key, OldAssoc, Val, NewAssoc) ), ( put_assoc_generic(Key, OldAssoc, Val, NewAssoc) :- avl_store(Key, OldAssoc, Val, NewAssoc) %put_assoc(Key, OldAssoc, Val, NewAssoc) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( min_assoc_generic(Assoc, Key, Val) :- min_assoc(Assoc, Key, Val) ), ( min_assoc_generic(Assoc, Key, Val) :- avl_min(Assoc, Key, Val) %min_assoc(Assoc, Key, Val) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( get_next_assoc_generic(Key, Assoc, Knext, Vnext) :- get_next_assoc(Key, Assoc, Knext, Vnext) ), ( get_next_assoc_generic(Key, Assoc, Knext, Vnext) :- avl_next(Key, Assoc, Knext, Vnext) %get_next_assoc(Key, Assoc, Knext, Vnext) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( set_random_generator_state_from_time :- set_random_generator_state_from_time_sicstus3 ), ( set_random_generator_state_from_time :- set_random_generator_state_from_time_sicstus4 )). %------------------------------------------------------------------------------------ 'SICSTUS3/4'(( safe_random_member(X, List) :- safe_random_member_sicstus3(X, List) ), ( safe_random_member(X, List) :- random_member(X, List) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4.0.2/4.other'(( safe_exec(Cmd, Streams, Pid) :- exec(Cmd, Streams, Pid) ), % Patch definition to cover bug in Sicstus 4.0.2 ( safe_exec(Cmd, [Stdin, Stdout, Stderr], Pid) :- system3:system_binary(Binary, DashC), process_create(Binary, [DashC, Cmd], [stdin(Stdin), stdout(Stdout), stderr(Stderr), process(ProcessRef)]), process_id(ProcessRef, Pid) ), ( safe_exec(Cmd, Streams, Pid) :- exec(Cmd, Streams, Pid) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4.0.2/4.other'(( safe_shell(Cmd) :- shell(Cmd) ), ( safe_shell(Cmd) :- shell(Cmd) ), % Problems with Sicstus 4.0.3's version of the system3 library ( safe_shell(Cmd) :- %format('~N*** Warning: call "~w" may not work, due to compatibility library problems in SICStus 4.0.3 and upward~n', [shell(Cmd)]), shell(Cmd) )). %------------------------------------------------------------------------------------ 'SICSTUS3/4.0.2/4.other'(( safe_shell(Cmd, Status) :- shell(Cmd, Status) ), ( safe_shell(Cmd, Status) :- shell(Cmd, Status) ), % Problems with Sicstus 4.0.3's version of the system3 library ( safe_shell(Cmd, Status) :- %format('~N*** Warning: call "~w" may not work, due to compatibility library problems in SICStus 4.0.3 and upward~n', [shell(Cmd, Status)]), shell(Cmd, Status) )). %------------------------------------------------------------------------------------ safe_average_list(List, Av) :- safe_sum_list(List, Total), length(List, N), ( N = 0 -> Av = 0 ; otherwise -> Av is Total / N ). %------------------------------------------------------------------------------------ max_exceptions_when_reading_prolog_file(100). %------------------------------------------------------------------------------------ safe_format_to_chars(FormatAtom, Args, Result) :- format_to_chars(FormatAtom, Args, Result). safe_read_from_chars(Chars, Term) :- read_from_chars(Chars, Term). safe_read_from_chars(Chars, Term, Options) :- read_from_chars(Chars, Term, Options). %------------------------------------------------------------------------------------ require_sicstus_version(Version, Predicate) :- ( user:sicstus_version(Version) -> true ; format('~N*** Error: ~w requires SICStus ~w~n', [Predicate, Version]), fail ). %------------------------------------------------------------------------------------ running_under_windows :- \+ current_predicate(_Package:environ/2), !, format('~N*** Warning: the predicate environ/2, required to find out which operating system is being used, is not defined. Assuming we are not using Windows.~n', []), fail. running_under_windows :- ( environ('OS', Env) -> Env = 'Windows_NT' ; otherwise -> format('~N*** Warning: attempt to look up value of environment variable \'OS\' failed. Assuming we are not using Windows.~n', []), fail ), !. %------------------------------------------------------------------------------------ on_cygwin_and_bin_dir_found :- running_under_windows, environ('PATH', PathAtom), split_atom_into_words(PathAtom, 0';, Dirs), member(Dir, Dirs), safe_absolute_file_name(Dir, AbsDir), atom_codes(AbsDir, DirString), dir_pattern_string(DirPatternString), is_substring(DirPatternString, DirString), !. dir_pattern_string("cygwin/bin"). dir_pattern_string("cygwin64/bin"). %------------------------------------------------------------------------------------ % NUANCE_VERSION is not set in N8.5, the only other version we care about for now. nuance10_loaded :- environ('NUANCE_VERSION', _Version), !. %------------------------------------------------------------------------------------ /* $ file -bi english.txt text/plain; charset=iso-8859-1 $ file -bi english_chinese.txt text/plain; charset=utf-16le */ find_sicstus_encoding_for_file(File, Encoding) :- on_cygwin_and_bin_dir_found, safe_absolute_file_name(File, AbsFile), get_tmp_trace_file(TmpOutputFile), %absolute_file_name('$REGULUS/Prolog/tmp_output_xxx.txt', TmpOutputFile), system_on_list(['file -bi', AbsFile, '>', TmpOutputFile]), ( file_exists(TmpOutputFile) -> read_file_to_atom_list(TmpOutputFile, Result), delete_file(TmpOutputFile); Result = [] ), Result = [ResultAtom], parse_file_encoding_result(ResultAtom, Encoding), !. find_sicstus_encoding_for_file(File, Encoding) :- format('~N*** Error: bad call: ~w~n', [find_sicstus_encoding_for_file(File, Encoding)]), fail. parse_file_encoding_result(ResultAtom, Encoding) :- atom_codes(ResultAtom, ResultStr), file_encoding_result(Encoding0, ResultStr, []), cygwin_encoding_to_prolog_encoding(Encoding0, Encoding). file_encoding_result(Encoding) --> string_ending_in_semicolon, optional_whitespace_sequence, "charset=", non_whitespace_word(Encoding). cygwin_encoding_to_prolog_encoding(Unix, Prolog) :- uppercase_atom(Unix, UppercaseUnix), known_prolog_encoding(UppercaseUnix), UppercaseUnix = Prolog, !. cygwin_encoding_to_prolog_encoding(Unix, Prolog) :- format('~N*** Warning: unknown encoding "~w" treated as "ISO-8859-1"', [Unix]), Prolog = 'ISO-8859-1', !. string_ending_in_semicolon --> [0';], !. string_ending_in_semicolon --> [F], {F \== 0';}, !, string_ending_in_semicolon. /* The following character encodings are currently supported by SICStus Prolog. ANSI_X3.4-1968 ISO-8859-1 ISO-8859-2 ISO-8859-15 windows 1252 UTF-8 UTF-16 UTF-16LE UTF-16BE UTF-32 UTF-32LE UTF-32BE */ known_prolog_encoding('ANSI_X3.4-1968'). known_prolog_encoding('ISO-8859-1'). known_prolog_encoding('ISO-8859-2'). known_prolog_encoding('ISO-8859-15'). known_prolog_encoding('windows 1252'). known_prolog_encoding('UTF-8'). known_prolog_encoding('UTF-16'). known_prolog_encoding('UTF-16LE'). known_prolog_encoding('UTF-16BE'). known_prolog_encoding('UTF-32'). known_prolog_encoding('UTF-32LE'). known_prolog_encoding('UTF-32BE'). %------------------------------------------------------------------------------------ replace_strings_with_atoms_in_xml(Atom, Atom) :- atomic(Atom), !. replace_strings_with_atoms_in_xml(pcdata(String), Atom) :- is_prolog_string(String), ( safe_number_codes(Atom, String) ; atom_codes(Atom, String) ), !. replace_strings_with_atoms_in_xml(String, Atom) :- is_prolog_string(String), ( safe_number_codes(Atom, String) ; atom_codes(Atom, String) ), !. replace_strings_with_atoms_in_xml(Term, Term1) :- functor(Term, F, N), functor(Term1, F, N), replace_strings_with_atoms_in_xml_args(N, Term, Term1). replace_strings_with_atoms_in_xml_args(I, _Term, _Term1) :- I =< 0, !. replace_strings_with_atoms_in_xml_args(I, Term, Term1) :- I > 0, arg(I, Term, Arg), arg(I, Term1, Arg1), replace_strings_with_atoms_in_xml(Arg, Arg1), I1 is I - 1, !, replace_strings_with_atoms_in_xml_args(I1, Term, Term1). %====================================================================== remove_comments_in_xml(Var, Var) :- var(Var), !. remove_comments_in_xml(Atom, Atom) :- atomic(Atom), !. remove_comments_in_xml(List, List1) :- is_list(List), remove_comments_in_xml_list(List, List1), !. remove_comments_in_xml(Term, Term1) :- functor(Term, F, N), functor(Term1, F, N), remove_comments_in_xml_args(N, Term, Term1). remove_comments_in_xml_list([], []). remove_comments_in_xml_list([comment(_) | R], R1) :- !, remove_comments_in_xml_list(R, R1). remove_comments_in_xml_list([F | R], [F1 | R1]) :- remove_comments_in_xml(F, F1), !, remove_comments_in_xml_list(R, R1). remove_comments_in_xml_args(I, _Term, _Term1) :- I =< 0, !. remove_comments_in_xml_args(I, Term, Term1) :- I > 0, arg(I, Term, Arg), arg(I, Term1, Arg1), remove_comments_in_xml(Arg, Arg1), I1 is I - 1, !, remove_comments_in_xml_args(I1, Term, Term1). %------------------------------------------------------------------------------------ safe_number_codes(N, Codes) :- on_exception(_Exception, number_codes(N, Codes), fail ). %------------------------------------------------------------------------------------ is_contiguous_sublist_sicstus3(SubList, List) :- prefix(SubList, List), !. is_contiguous_sublist_sicstus3(SubList, [_F | R]) :- is_contiguous_sublist_sicstus3(SubList, R), !. %------------------------------------------------------------------------------------ set_random_generator_state_from_time_sicstus3 :- random_number_params_from_time(A, B, C, _D), setrand(rand(A, B, C)). set_random_generator_state_from_time_sicstus4 :- random_number_params_from_time(A, B, C, D), setrand(random(A, B, C, D)). random_number_params_from_time(A, B, C, D) :- now(Time), A is Time mod 10000, B is A + 1000, C is A + 2000, D is A + 3000. %------------------------------------------------------------------------------------ % For some reason, the usual print_message doesn't interact correctly with with_output_to_chars % in SICStus 3. print_message_work_around(Severity, Exception) :- 'SU_messages':generate_message(Exception, Lines, []), print_message_lines_work_around(Severity, Lines). print_message_lines_work_around(_Severity, []). print_message_lines_work_around(Severity, [F | R]) :- print_message_line_work_around(Severity, F), !, print_message_lines_work_around(Severity, R). print_message_line_work_around(_Severity, Line) :- %format('~N! ', []), print_message_line_work_around1(Line). print_message_line_work_around1(String-Args) :- format(String, Args), !. print_message_line_work_around1(nl) :- format('~n', []), !. print_message_line_work_around1(format(String, Args)) :- format(String, Args), !. print_message_line_work_around1(write_term(Term, Options)) :- write_term(Term, Options), !. print_message_line_work_around1(write_term(Term)) :- prolog_flag(toplevel_print_options, Options, Options), write_term(Term, Options), !. print_message_line_work_around1(Other) :- format('~w', [Other]). %------------------------------------------------------------------------------------ safe_read(Stream, Term) :- on_exception(Exception, read(Stream, Term), ( close(Stream), raise_exception(Exception) ) ). safe_read_no_exceptions(Stream, InFile, Term) :- on_exception(_Exception, read(Stream, Term), ( format('~N*** Warning: bad Prolog term when reading from file ~w~n', [InFile]), fail ) ). safe_read_no_exceptions_vars_as_consts(Stream, InFile, Term) :- on_exception(_Exception, ( read_term(Stream, Term, [variable_names(Names)]), instantiate_name_pairs(Names) ), ( format('~N*** Warning: bad Prolog term when reading from file ~w~n', [InFile]), fail ) ). instantiate_name_pairs([]). instantiate_name_pairs([Name=Var | R]) :- Name = Var, instantiate_name_pairs(R). %------------------------------------------------------------------------------------ safe_close(S) :- on_exception(_Exception, close(S), true ). %------------------------------------------------------------------------------------ :- dynamic timeouts_disabled/0. disable_timeouts :- timeouts_disabled, !. disable_timeouts :- assertz(timeouts_disabled), format('~N--- Switching off timeouts~n', []), !. timeouts_unavailable :- \+ predicate_property(time_out(_, _, _), _Property), !. timeouts_unavailable :- timeouts_disabled. %------------------------------------------------------------------------------------ exec_and_check_process_started(Command, Timeout, PID) :- safe_exec(Command, [null, null, null], PID), check_new_process_started(PID, Timeout), !. exec_and_check_process_started(Command, Timeout, _PID) :- format('~N*** Error: command "~w" apparently not running after ~d seconds~n', [Command, Timeout]), fail. check_new_process_started(PID, _Timeout) :- PID = '$process'(_), !. check_new_process_started(PID, Timeout) :- integer(PID), Timeout > 0, get_windows_ps_info(Results), member(Line, Results), member(pid=PID, Line), !. check_new_process_started(PID, Timeout) :- integer(PID), Timeout > 0, sleep(1), Timeout1 is Timeout - 1, !, check_new_process_started(PID, Timeout1). %------------------------------------------------------------------------------------ kill_process(PID) :- system_on_list(['kill -f', PID]). %------------------------------------------------------------------------------------ /* Cygwin access to Windows processes ps -W - get Windows processes /bin/kill -f - kill process with given Windows PID from Cygwin Typical info from ps -W: PID PPID PGID WINPID TTY UID STIME COMMAND 4260 0 0 4260 ? 0 Feb 7 C:\Program Files\Ghostgum\gsview\gsview32.exe 5532 0 0 5532 ? 0 Feb 8 C:\Program Files\Adobe\Acrobat 7.0\Reader\AcroRd32.exe 5736 0 0 5736 ? 0 Feb 8 C:\WINDOWS\system32\cmd.exe 4688 1 4688 4688 con 1006 Feb 8 /usr/bin/bash 4324 0 0 4324 ? 0 Feb 9 C:\Program Files\Mozilla Firefox\firefox.exe 1240 0 0 1240 ? 0 Feb 9 C:\Program Files\SICStus Prolog 3.12.5\bin\spwin.exe 4584 0 0 4584 ? 0 08:20:37 C:\WINDOWS\system32\cmd.exe 4784 0 0 4784 ? 0 11:04:13 C:\WINDOWS\system32\cmd.exe 928 1 928 928 con 1006 11:04:13 /usr/bin/bash 204 928 204 1244 con 1006 11:04:21 /usr/bin/man 4344 204 204 4344 con 1006 11:04:22 /usr/bin/sh 5592 4344 204 5592 con 1006 11:04:22 /usr/bin/sh I 5396 5592 204 5856 con 1006 11:04:22 /usr/bin/less 5776 4688 5776 5528 con 1006 14:26:54 /usr/bin/ps Primitives: - Kill process with given Windows PID */ get_windows_ps_info(Result) :- %require_sicstus_version(3, get_windows_ps_info/1), absolute_file_name('$REGULUS/Prolog/tmp_output_xxx.txt', TmpOutputFile), system_on_list(['ps -W', '>', TmpOutputFile]), ( file_exists(TmpOutputFile) -> read_file_to_atom_list(TmpOutputFile, Result0), delete_file(TmpOutputFile); Result0 = [] ), Result0 = [_Heading | Result0WithoutHeading], parse_ps_info_list(Result0WithoutHeading, Result), !. get_windows_ps_info(Result) :- format('~N*** Error: bad call: ~w~n', [get_windows_ps_info(Result)]), fail. parse_ps_info_list([], []). parse_ps_info_list([F | R], [F1 | R1]) :- parse_ps_info_item(F, F1), !, parse_ps_info_list(R, R1). parse_ps_info_list([_F | R], R1) :- !, parse_ps_info_list(R, R1). parse_ps_info_item(Atom, Alist) :- atom_codes(Atom, Chars), ps_info_line(Alist, Chars, []), !. parse_ps_info_item(Atom, _Alist) :- format('~N*** Warning: unable to parse ps line, "~w"~n', [Atom]), fail. /* PID PPID PGID WINPID TTY UID STIME COMMAND I 5396 5592 204 5856 con 1006 11:04:22 /usr/bin/less 5776 4688 5776 5528 con 1006 14:26:54 /usr/bin/ps */ ps_info_line(Alist) --> ps_info_i_o_or_nothing, ps_info_pid(Alist-Alist1), ps_info_ppid(Alist1-Alist2), ps_info_pgid(Alist2-Alist3), ps_info_winpid(Alist3-Alist4), ps_info_tty(Alist4-Alist5), ps_info_uid(Alist5-Alist6), ps_info_time_or_date(Alist6-Alist7), ps_info_command(Alist7). ps_info_i_o_or_nothing --> "I", optional_whitespace_sequence, !. ps_info_i_o_or_nothing --> "O", optional_whitespace_sequence, !. ps_info_i_o_or_nothing --> "S", optional_whitespace_sequence, !. ps_info_i_o_or_nothing --> optional_whitespace_sequence. ps_info_pid([pid=N | R]-R) --> integer_word(N), optional_whitespace_sequence. ps_info_ppid([ppid=N | R]-R) --> integer_word(N), optional_whitespace_sequence. ps_info_pgid([pgid=N | R]-R) --> integer_word(N), optional_whitespace_sequence. ps_info_winpid([winpid=N | R]-R) --> integer_word(N), optional_whitespace_sequence. ps_info_uid([uid=N | R]-R) --> integer_word(N), optional_whitespace_sequence. ps_info_tty([tty=TTY | R]-R) --> non_whitespace_word(TTY), optional_whitespace_sequence. ps_info_time_or_date([date_or_time=date(Month, Day) | R]-R) --> non_whitespace_word(Month), optional_whitespace_sequence, integer_word(Day), optional_whitespace_sequence, !. ps_info_time_or_date([date_or_time=time(H, M, S) | R]-R) --> integer_word(H), ":", integer_word(M), ":", integer_word(S). ps_info_command([command=Word]) --> any_chars_word(Word). %------------------------------------------------------------------------------------ abolish_if_defined(PredSpec) :- current_predicate(PredSpec), %format('~N[Abolishing defined predicate ~w]~n', [PredSpec]), safe_abolish(PredSpec), !. abolish_if_defined(_PredSpec). %------------------------------------------------------------------------------------ safe_compile_with_redefine_warnings_off(Module, File) :- set_prolog_flags_for_redefine_warnings_off(OldFlags), on_exception( _Exception, safe_compile(Module, File), restore_prolog_flags_after_redefine_warnings_off(OldFlags) ), restore_prolog_flags_after_redefine_warnings_off(OldFlags). set_prolog_flags_for_redefine_warnings_off(OldFlags) :- prolog_flag(redefine_warnings, OldRedefine, off), OldFlags = [OldRedefine]. restore_prolog_flags_after_redefine_warnings_off(OldFlags) :- OldFlags = [OldRedefine], prolog_flag(redefine_warnings, _Current, OldRedefine). %------------------------------------------------------------------------------------ safe_compile_with_discontiguous_warnings_off(Module, File) :- set_prolog_flags_for_discontiguous_warnings_off(OldFlags), on_exception( _Exception, safe_compile(Module, File), restore_prolog_flags_after_discontiguous_warnings_off(OldFlags) ), restore_prolog_flags_after_discontiguous_warnings_off(OldFlags). set_prolog_flags_for_discontiguous_warnings_off(OldFlags) :- prolog_flag(discontiguous_warnings, OldDiscontiguous, off), OldFlags = [OldDiscontiguous]. restore_prolog_flags_after_discontiguous_warnings_off(OldFlags) :- OldFlags = [OldDiscontiguous], prolog_flag(discontiguous_warnings, _Current, OldDiscontiguous). %------------------------------------------------------------------------------------ safe_compile_with_redefine_and_single_var_warnings_off(Module, File) :- set_prolog_flags_for_redefine_and_single_var_warnings_off(OldFlags), on_exception( _Exception, safe_compile(Module, File), restore_prolog_flags_after_redefine_and_single_var_warnings_off(OldFlags) ), restore_prolog_flags_after_redefine_and_single_var_warnings_off(OldFlags). set_prolog_flags_for_redefine_and_single_var_warnings_off(OldFlags) :- prolog_flag(redefine_warnings, OldRedefine, off), prolog_flag(single_var_warnings, OldSingleVar, off), OldFlags = [OldRedefine, OldSingleVar]. restore_prolog_flags_after_redefine_and_single_var_warnings_off(OldFlags) :- OldFlags = [OldRedefine, OldSingleVar], prolog_flag(redefine_warnings, _Current, OldRedefine), prolog_flag(single_var_warnings, _Current1, OldSingleVar). %------------------------------------------------------------------------------------ safe_compile_list(_Module, []) :- !. safe_compile_list(Module, List) :- is_list(List), List = [F | R], safe_compile(Module, F), !, safe_compile_list(Module, R). safe_compile_list(Module, Other) :- format('*** Error: bad call ~w~n', [safe_compile_list(Module, Other)]), fail. %------------------------------------------------------------------------------------ :- dynamic compile_timeout/1. set_compile_timeout(Timeout) :- number(Timeout), Timeout > 0, retractall(compile_timeout(_)), assertz(compile_timeout(Timeout)), !. set_compile_timeout(_Timeout). %------------------------------------------------------------------------------------ safe_compile(Module, File) :- nonvar(File), safe_absolute_file_name(File, AbsFile), % Maybe wait a little bit to try and avoid possible race conditions. % This shouldn't be necessary, of course. ( compile_timeout(Timeout) -> format('~N--- Waiting ~2f seconds before starting compilation~n', [Timeout]), flush_output(user), sleep(Timeout) ; true ), safe_compile1(Module, AbsFile). safe_compile1(_Module, File) :- \+ file_exists(File), !, format('*** Error: unable to find file ~w~n', [File]), fail. safe_compile1(Module, File) :- on_exception( Exception, compile(Module:File), ( inform_about_error_in_compile(File, Exception) ) ), !. inform_about_error_in_compile(File, Exception) :- format('~N~nCompilation of file ~w aborted due to error:~n~n', [File]), print_message(error, Exception), format('~n', []), fail. %------------------------------------------------------------------------------------ safe_absolute_file_name(Var, _) :- var(Var), !, format('*** Error: variable argument to safe_absolute_file_name/2~n', []), fail. safe_absolute_file_name([], []) :- !. safe_absolute_file_name([F | R], [F1 | R1]) :- safe_absolute_file_name(F, F1), !, safe_absolute_file_name(R, R1). safe_absolute_file_name(File, AbsFile) :- possible_input_to_absolute_file_name(File), !, absolute_file_name(File, AbsFile). safe_absolute_file_name(File, _AbsFile) :- format('*** Error: unable to interpret ~w as file description~n', [File]), fail. possible_input_to_absolute_file_name(File) :- atom(File), !. possible_input_to_absolute_file_name(FileDescription) :- compound(FileDescription), FileDescription =.. [FileSearchPath, File], ( \+ valid_file_search_path(FileSearchPath) -> format('*** Error: ~w is not currently declared as a file_search_path~n', [FileSearchPath]), fail ; \+ atom(File) -> format('*** Error: ~w must be an atom~n', [File]), fail ; true ). valid_file_search_path(FileSearchPath) :- current_predicate(file_search_path, user:file_search_path(_, _)), user:file_search_path(FileSearchPath, _Value), !. %------------------------------------------------------------------------------------ safe_rename_file(File1, File2) :- safe_absolute_file_name(File1, AbsFile1), safe_absolute_file_name(File2, AbsFile2), ( safe_file_exists(AbsFile2) -> delete_file(AbsFile2) ; otherwise -> true ), rename_file(AbsFile1, AbsFile2). %------------------------------------------------------------------------------------ safe_file_exists(File) :- safe_absolute_file_name(File, AbsFile), file_exists(AbsFile). %------------------------------------------------------------------------------------ safe_directory_files(Dir, Files) :- on_exception(_Exception, safe_directory_files1(Dir, Files), ( format('~N*** Error: exception in: ~w~n', [safe_directory_files(Dir, Files)]), fail ) ). safe_directory_files1(Dir, Files) :- safe_absolute_file_name(Dir, AbsDir), safe_directory_exists(AbsDir), safe_directory_base_files(AbsDir, Files). %------------------------------------------------------------------------------------ first_elements_in_pairs([], []). first_elements_in_pairs([F-_Second | R], [F | R1]) :- first_elements_in_pairs(R, R1). %------------------------------------------------------------------------------------ safe_is_directory(Dir) :- safe_absolute_file_name(Dir, AbsDir), safe_directory_exists(AbsDir), !. %------------------------------------------------------------------------------------ directory_files_recursive(Dir, AllFiles) :- safe_absolute_file_name(Dir, AbsDir), safe_is_directory(AbsDir), directory_files_recursive1(AbsDir, AllFiles-[]). directory_files_recursive1(File, [File | Out]-Out) :- \+ safe_is_directory(File), !. directory_files_recursive1(Dir, In-Out) :- safe_is_directory(Dir), !, safe_directory_files(Dir, Files0), reverse(Files0, Files), directory_files_recursive2(Files, Dir, In-Out). directory_files_recursive2([], _Dir, In-In) :- !. directory_files_recursive2([F | R], Dir, In-Out) :- dummy_dir_file(F), !, directory_files_recursive2(R, Dir, In-Out). directory_files_recursive2([F | R], Dir, In-Out) :- format_to_atom('~w/~w', [Dir, F], FullF), directory_files_recursive1(FullF, In-Next), !, directory_files_recursive2(R, Dir, Next-Out). dummy_dir_file('.'). dummy_dir_file('..'). %------------------------------------------------------------------------------------ safe_socket_connect_sicstus3(Socket, Host, Port, Stream) :- require_sicstus_version(3, safe_socket_connect_sicstus3/4), on_exception(Exception, socket_connect(Socket, 'AF_INET'(Host, Port), Stream), safe_socket_connect_sicstus3_handle_exception(Exception, Host, Port) ), !. safe_socket_connect_sicstus3_handle_exception(Exception, Host, Port) :- format('~N*** Error: exception raised when trying to connect to port ~w on ~w~n', [Port, Host]), print_message(error, Exception), fail. %------------------------------------------------------------------------------------ safe_socket_connect_sicstus4(Host, Port, Stream) :- require_sicstus_version(4, safe_socket_connect_sicstus4/3), on_exception(Exception, socket_client_open(Host:Port, Stream, [type(text)]), safe_socket_connect_sicstus4_handle_exception(Exception, Host, Port) ), !. safe_socket_connect_sicstus4_handle_exception(Exception, Host, Port) :- format('~N*** Error: exception raised when trying to connect to port ~w on ~w~n', [Port, Host]), print_message(error, Exception), fail. %------------------------------------------------------------------------------------ safe_socket_connect_sicstus4(Host, Port, Stream, OpenStreamParameters) :- require_sicstus_version(4, safe_socket_connect_sicstus4/4), on_exception(Exception, socket_client_open(Host:Port, Stream, OpenStreamParameters), safe_socket_connect_sicstus4_handle_exception(Exception, Host, Port, OpenStreamParameters) ), !. safe_socket_connect_sicstus4_handle_exception(Exception, Host, Port, _OpenStreamParameters) :- format('~N*** Error: exception raised when trying to connect to port ~w on ~w~n', [Port, Host]), print_message(error, Exception), fail. %------------------------------------------------------------------------------------ safe_socket_server_open_sicstus3(Port, Socket) :- require_sicstus_version(3, safe_socket_server_open_sicstus3/2), current_host(Host), socket('AF_INET', Socket), socket_bind(Socket, 'AF_INET'(Host, Port)), socket_listen(Socket, 5). %------------------------------------------------------------------------------------ safe_socket_close_sicstus3(Socket) :- require_sicstus_version(3, safe_socket_close_sicstus3/1), on_exception(Exception, socket_close(Socket), safe_socket_close_handle_exception(Exception, Socket) ), !. safe_socket_close_handle_exception(Exception, Socket) :- format('~N*** Error: exception raised when trying to close socket ~w~n', [Socket]), print_message(error, Exception), fail. %------------------------------------------------------------------------------------ safe_random_member_sicstus3(X, List) :- length(List, N), random(0, N, I), IPlus1 is I + 1, safe_nth(IPlus1, List, X). %------------------------------------------------------------------------------------ consume_parameter_value_pair(InList, FeatVal, OutList) :- \+ is_list(InList), !, format('~N*** Error: bad call ~q~n. First arg must be list~n', [consume_parameter_value_pair(InList, FeatVal, OutList)]), fail. consume_parameter_value_pair(InList, FeatVal, OutList) :- \+ safe_subsumes_chk(_=_, FeatVal), !, format('~N*** Error: bad call ~q~n. Second arg must be of form X=Y~n', [consume_parameter_value_pair(InList, FeatVal, OutList)]), fail. consume_parameter_value_pair([(X=Y) | R], (X=Y), R) :- !. consume_parameter_value_pair([_F | R], FeatVal, Out) :- consume_parameter_value_pair(R, FeatVal, Out). %------------------------------------------------------------------------------------ datime_for_file(File, Datime) :- safe_absolute_file_name(File, AbsFile), safe_mod_time_for_file(AbsFile, UnixTime), datime(UnixTime, Datime), !. %------------------------------------------------------------------------------------ age_of_file(File, Age) :- safe_absolute_file_name(File, AbsFile), safe_mod_time_for_file(AbsFile, UnixTime), now(UnixTimeNow), Age is UnixTimeNow - UnixTime, !. %------------------------------------------------------------------------------------ file_is_more_recent_than_files(File, Files) :- safe_file_exists(File), age_of_file(File, Age), files_exist_and_are_older_than_age(Files, Age). files_exist_and_are_older_than_age([], _Age). files_exist_and_are_older_than_age([F | R], Age) :- safe_file_exists(F), age_of_file(F, Age1), Age1 > Age, !, files_exist_and_are_older_than_age(R, Age). %------------------------------------------------------------------------------------ order_files_by_age_most_recent_first(Files, SortedFiles) :- tag_files_by_age(Files, TaggedFiles), keysort(TaggedFiles, SortedTaggedFiles), unkey_list(SortedTaggedFiles, SortedFiles). tag_files_by_age([], []). tag_files_by_age([F | R], [Age-F | R1]) :- age_of_file(F, Age), !, tag_files_by_age(R, R1). %------------------------------------------------------------------------------------ % Returns latest datime for all items in the directory, including the directory itself datime_for_directory_recursive(Dir, EarliestOrLatest, ExtremeDatime) :- datime_for_directory_recursive(Dir, EarliestOrLatest, '*no_extension_specified*', ExtremeDatime). datime_for_directory_recursive(Dir, EarliestOrLatest, Extensions, ExtremeDatime) :- datime_for_file(Dir, DirDatime), safe_directory_files(Dir, Files), datimes_for_directory_files_recursive(Files, Dir, Extensions, FileDatimes-[]), add_directory_time_if_included_in_extensions(FileDatimes, DirDatime, Extensions, AllFileDatimes), extreme_time_in_list(AllFileDatimes, EarliestOrLatest, ExtremeDatime). datimes_for_directory_files_recursive([], _Dir, _Extensions, DatimesIn-DatimesIn). datimes_for_directory_files_recursive([F | R], Dir, Extensions, DatimesIn-DatimesOut) :- format_to_atom('~w/~w', [Dir, F], SubDir), safe_is_directory(SubDir), datime_for_file(SubDir, DirDatime), safe_directory_files(SubDir, SubFiles), add_directory_time_if_included_in_extensions(DatimesNext, DirDatime, Extensions, DatimesIn), datimes_for_directory_files_recursive(SubFiles, SubDir, Extensions, DatimesNext-DatimesNext2), !, datimes_for_directory_files_recursive(R, Dir, Extensions, DatimesNext2-DatimesOut). datimes_for_directory_files_recursive([F | R], Dir, Extensions, DatimesIn-DatimesOut) :- Extensions \== '*no_extension_specified*', split_off_extension_from_pathname(F, _WithoutExtension, Extension), \+ member(Extension, Extensions), !, datimes_for_directory_files_recursive(R, Dir, Extensions, DatimesIn-DatimesOut). datimes_for_directory_files_recursive([F | R], Dir, Extensions, [Datime | DatimesNext]-DatimesOut) :- format_to_atom('~w/~w', [Dir, F], FullPathname), datime_for_file(FullPathname, Datime), !, datimes_for_directory_files_recursive(R, Dir, Extensions, DatimesNext-DatimesOut). add_directory_time_if_included_in_extensions(FileDatimes, DirDatime, Extensions, AllFileDatimes) :- ( Extensions = '*no_extension_specified*' -> AllFileDatimes = [DirDatime | FileDatimes] ; ( is_list(Extensions), member(directory, Extensions) ) -> AllFileDatimes = [DirDatime | FileDatimes] ; otherwise -> AllFileDatimes = FileDatimes ). %------------------------------------------------------------------------------------ % Returns latest datime for all items in the directory, including the directory itself datime_for_directory(Dir, EarliestOrLatest, ExtremeDatime) :- datime_for_directory(Dir, EarliestOrLatest, '*no_extension_specified*', ExtremeDatime). datime_for_directory(Dir, EarliestOrLatest, Extension, ExtremeDatime) :- datime_for_file(Dir, DirDatime), safe_directory_files(Dir, Files), datimes_for_directory_files(Files, Dir, Extension, FileDatimes), extreme_time_in_list([DirDatime | FileDatimes], EarliestOrLatest, ExtremeDatime). datimes_for_directory_files([], _Dir, _Extension, []). datimes_for_directory_files([F | R], Dir, Extension, R1) :- Extension \== '*no_extension_specified*', \+ pathname_has_extension(F, Extension), !, datimes_for_directory_files(R, Dir, Extension, R1). datimes_for_directory_files([F | R], Dir, Extension, [Datime | Datimes]) :- format_to_atom('~w/~w', [Dir, F], FullPathname), datime_for_file(FullPathname, Datime), !, datimes_for_directory_files(R, Dir, Extension, Datimes). %------------------------------------------------------------------------------------ datime_for_file_list(List, EarliestOrLatest, ExtremeDatime) :- datimes_for_file_list1(List, EarliestOrLatest, Datimes), extreme_time_in_list(Datimes, EarliestOrLatest, ExtremeDatime). datimes_for_file_list1([], _EarliestOrLatest, []). datimes_for_file_list1([F | R], EarliestOrLatest, R1) :- \+ file_exists(F), !, datimes_for_file_list1(R, EarliestOrLatest, R1). datimes_for_file_list1([F | R], EarliestOrLatest, [F1 | R1]) :- ( safe_directory_exists(F) -> datime_for_directory(F, EarliestOrLatest, F1) ; datime_for_file(F, F1) ), !, datimes_for_file_list1(R, EarliestOrLatest, R1). %------------------------------------------------------------------------------------ extreme_time_in_list(Datimes, EarliestOrLatest, ExtremeDatime) :- default_extreme_time(EarliestOrLatest, StartDatime), extreme_time_in_list1(Datimes, EarliestOrLatest, StartDatime-ExtremeDatime). default_extreme_time(earliest, datime(2100, 1, 1, 0, 0, 0)) :- !. default_extreme_time(latest, datime(0, 1, 1, 0, 0, 0)) :- !. default_extreme_time(Other, D) :- format('~N*** Error: bad call: ~w~n', [default_extreme_time(Other, D)]), fail. extreme_time_in_list1([], _EarliestOrLatest, Datime-Datime). extreme_time_in_list1([F | R], EarliestOrLatest, InDatime-OutDatime) :- ( ( EarliestOrLatest = earliest, earlier_datime(F, InDatime) ) -> NextDatime = F ; ( EarliestOrLatest = latest, earlier_datime(InDatime, F) ) -> NextDatime = F ; NextDatime = InDatime ), !, extreme_time_in_list1(R, EarliestOrLatest, NextDatime-OutDatime). %------------------------------------------------------------------------------------ real_datime(T0) :- T0 = datime(Year0, Month0, Day0, Hour0, Minute0, Second0), all_numbers([Year0, Month0, Day0, Hour0, Minute0, Second0]). earlier_datime(T0, T1) :- real_datime(T0), real_datime(T1), T0 = datime(Year0, Month0, Day0, Hour0, Minute0, Second0), T1 = datime(Year1, Month1, Day1, Hour1, Minute1, Second1), ( Year0 < Year1 ; Year0 = Year1, Month0 < Month1 ; Year0 = Year1, Month0 = Month1, Day0 < Day1 ; Year0 = Year1, Month0 = Month1, Day0 = Day1, Hour0 < Hour1 ; Year0 = Year1, Month0 = Month1, Day0 = Day1, Hour0 = Hour1, Minute0 < Minute1 ; Year0 = Year1, Month0 = Month1, Day0 = Day1, Hour0 = Hour1, Minute0 = Minute1, Second0 < Second1 ). all_numbers([]). all_numbers([F | R]) :- number(F), !, all_numbers(R). %------------------------------------------------------------------------------------ timestamped_file(Prefix, Datime, Extension, File) :- datime_to_timestamp(Datime, Timestamp), ( Extension = '' -> format_to_atom('~w_~w', [Prefix, Timestamp], File) ; format_to_atom('~w_~w.~w', [Prefix, Timestamp, Extension], File) ), !. %------------------------------------------------------------------------------------ % Find the next unused file of the form _NN. next_numbered_file(Prefix, Extension, File) :- next_numbered_file(Prefix, Extension, File, 0), !. next_numbered_file(Prefix, Extension, File) :- format('~N*** Error: bad call: ~w~n', [next_numbered_file(Prefix, Extension, File)]), fail. next_numbered_file(Prefix, Extension, File, N) :- N < 100, coerce_int_to_two_digit_atom(N, NAtom), format_to_atom('~w_~w.~w', [Prefix, NAtom, Extension], NextFile), !, ( file_exists(NextFile) -> N1 is N + 1, next_numbered_file(Prefix, Extension, File, N1) ; File = NextFile ), !. %------------------------------------------------------------------------------------ current_datime_formatted_as_HMS(DatimeAtom) :- datime(Datime), Datime = datime(_Y, _M, _D, H, Min, S), coerce_int_to_two_digit_atom(H, Hours), coerce_int_to_two_digit_atom(Min, Minutes), coerce_int_to_two_digit_atom(S, Seconds), format_to_atom('~w:~w:~w', [Hours, Minutes, Seconds], DatimeAtom), !. current_datime_formatted_as_HMS(DatimeAtom) :- format('~N*** Error: bad call ~w~n', [current_datime_formatted_as_HMS(DatimeAtom)]), fail. %------------------------------------------------------------------------------------ % Parse datime in format YYYY-MM-DD_HH-MM-SS parse_datime(String, Datime) :- datime_string(Datime, String, []). datime_string(datime(Y, M, D, H, Min, S)) --> optional_whitespace_sequence, integer_word(Y), "-", integer_word(M), "-", integer_word(D), "_", integer_word(H), "-", integer_word(Min), "-", integer_word(S), optional_whitespace_sequence. %------------------------------------------------------------------------------------ :- dynamic notional_time/1. set_notional_time(Datime) :- retractall(notional_time(_)), assertz(notional_time(Datime)). unset_notional_time :- retractall(notional_time(_)). get_notional_time(Datime) :- notional_time(Datime), !. %------------------------------------------------------------------------------------ :- dynamic notional_speaker/1. set_notional_speaker(Name) :- retractall(notional_speaker(_)), assertz(notional_speaker(Name)). unset_notional_speaker :- retractall(notional_speaker(_)). get_notional_speaker(Name) :- notional_speaker(Name), !. %------------------------------------------------------------------------------------ datime_to_timestamp(Datime, Timestamp) :- Datime = datime(Y, M, D, H, Min, S), int_to_atom(Y, Year), coerce_int_to_two_digit_atom(M, Month), coerce_int_to_two_digit_atom(D, Day), coerce_int_to_two_digit_atom(H, Hours), coerce_int_to_two_digit_atom(Min, Minutes), coerce_int_to_two_digit_atom(S, Seconds), format_to_atom('~w-~w-~w_~w-~w-~w', [Year, Month, Day, Hours, Minutes, Seconds], Timestamp), !. %------------------------------------------------------------------------------------ coerce_int_to_three_digit_atom(Int, AppendedAtom) :- Int < 10, safe_number_codes(Int, Chars), atom_codes(AppendedAtom, [0'0, 0'0 | Chars]), !. coerce_int_to_three_digit_atom(Int, AppendedAtom) :- Int < 100, safe_number_codes(Int, Chars), atom_codes(AppendedAtom, [0'0 | Chars]), !. coerce_int_to_three_digit_atom(Int, AppendedAtom) :- Int < 1000, int_to_atom(Int, AppendedAtom), !. coerce_int_to_two_digit_atom(Int, AppendedAtom) :- Int < 10, safe_number_codes(Int, Chars), atom_codes(AppendedAtom, [0'0 | Chars]). coerce_int_to_two_digit_atom(Int, AppendedAtom) :- Int < 100, int_to_atom(Int, AppendedAtom), !. atom_to_int(Atom, Int) :- atom_codes(Atom, Chars), safe_number_codes(Int, Chars), integer(Int). coerce_atom_to_int(Atom, Int) :- ( integer(Atom) -> Atom = Int ; atom(Atom) -> atom_to_int(Atom, Int) ). int_to_atom(Int, Atom) :- integer(Int), safe_number_codes(Int, Chars), atom_codes(Atom, Chars). coerce_int_to_atom(Int, Atom) :- int_to_atom(Int, Atom), !. coerce_int_to_atom(Int, Int). is_number_atom(Atom) :- atom_to_int(Atom, _Int), !. %------------------------------------------------------------------------------------ /* Typical wavinfo output looks like this: Audio file information ---------------------- file name: wavfiles/countdown10_1.wav file size (B): 75862 format: riff encoding: mulaw samping rate: 8000 sample count: 75804 min sample: -12924 max sample: 14460 time (sec): 9.5 tags: 0 We get the length of the file in seconds if we divide the sample count by the sample rate. */ length_of_wavfile_in_seconds(Wavfile, NSeconds) :- %require_sicstus_version(3, length_of_wavfile_in_seconds/2), absolute_windows_file_name(Wavfile, AbsWavfile), system_on_list_to_result([wavinfo, AbsWavfile], List), member(SampleCountLine, List), parse_as_sample_count_line(SampleCountLine, SampleCount), member(SampleRateLine, List), parse_as_sample_rate_line(SampleRateLine, SampleRate), NSeconds is SampleCount / SampleRate, !. length_of_wavfile_in_seconds(Wavfile, NSeconds) :- format('~N*** Error: bad call: ~w~n', [length_of_wavfile_in_seconds(Wavfile, NSeconds)]), fail. parse_as_sample_count_line(SampleCountLine, SampleCount) :- split_atom_into_words(SampleCountLine, Atoms), member(sample, Atoms), member('count:', Atoms), last(Atoms, NumberAtom), atom_to_int(NumberAtom, SampleCount). parse_as_sample_rate_line(SampleRateLine, SampleRate) :- split_atom_into_words(SampleRateLine, Atoms), member(samping, Atoms), member( 'rate:', Atoms), last(Atoms, NumberAtom), atom_to_int(NumberAtom, SampleRate). %------------------------------------------------------------------------------------ wavfile_format_and_encoding(Wavfile, Format, Encoding) :- absolute_windows_file_name(Wavfile, AbsWavfile), system_on_list_to_result([wavinfo, AbsWavfile], List), member(FormatLine, List), parse_as_format_line(FormatLine, Format), member(EncodingLine, List), parse_as_encoding_line(EncodingLine, Encoding), !. wavfile_format_and_encoding(Wavfile, Format, Encoding) :- format('~N*** Error: bad call: ~w~n', [wavfile_format_and_encoding(Wavfile, Format, Encoding)]), fail. % format: riff parse_as_format_line(Line, Format) :- split_atom_into_words(Line, Atoms), member('format:', Atoms), last(Atoms, Format). % encoding: mulaw parse_as_encoding_line(Line, Encoding) :- split_atom_into_words(Line, Atoms), member('encoding:', Atoms), last(Atoms, Encoding). %------------------------------------------------------------------------------------ wavconvert_file(AbsLocalWavfile, AbsGlobalWavfile, Encoding, Format) :- format_to_atom('wavconvert ~w ~w ~w ~w', [AbsLocalWavfile, AbsGlobalWavfile, Encoding, Format], Command), format('~N--- Executing command: ~w~n', [Command]), ( safe_shell(Command) -> format('~N--- Converted ~w to ~w/~w, giving ~w~n', [AbsLocalWavfile, Encoding, Format, AbsGlobalWavfile]) ; otherwise -> format('Error~n', []), fail ), !. %------------------------------------------------------------------------------------ get_transcription_from_wavfile(Wavfile, WavfileTranscription) :- file_exists(Wavfile), open(Wavfile, read, S), get_transcription_from_wavfile_stream(S, WavfileTranscription), close(S), !, WavfileTranscription \== '*no_transcription*'. /* NIST_1A 1024 channel_count -i 1 sample_count -i 18240 sample_rate -i 8000 sample_n_bytes -i 2 sample_sig_bits -i 16 sample_coding -s3 pcm sample_byte_format -s2 01 recording_date -s11 09-Sep-2007 recording_time -s11 11:04:18.00 abs_safe_start -i 1760 rel_safe_start -i 0 rel_actual_start -i 4800 rel_actual_end -i 12880 rel_safe_end -i 18239 transcription -s22 is elisabeth attending end_head */ get_transcription_from_wavfile_stream(S, WavfileTranscription) :- read_line(S, Line), ( Line = end_of_file -> WavfileTranscription = '*no_transcription*' ; \+ is_prolog_string(Line) -> get_transcription_from_wavfile_stream(S, WavfileTranscription) ; otherwise -> split_string_into_words(Line, Words), !, ( Words = [end_head] -> WavfileTranscription = '*no_transcription*' ; Words = [transcription, _ | WavfileTranscription] -> true ; get_transcription_from_wavfile_stream(S, WavfileTranscription) ) ). %------------------------------------------------------------------------------------ add_transcription_to_wavfile(WavfileIn, TranscriptionAtom, WavfileOut) :- add_transcription_to_wavfile_binary(WavfileIn, TranscriptionAtom, WavfileOut). %add_transcription_to_wavfile(WavfileIn, TranscriptionAtom, WavfileOut) :- % file_exists(WavfileIn), % open(WavfileIn, read, SIn), % open(WavfileOut, write, SOut), % atom_codes(TranscriptionAtom, TranscriptionChars), % length(TranscriptionChars, NCharsInTranscription), % format_to_atom('transcription -s~d ~w', [NCharsInTranscription, TranscriptionAtom], TranscriptionLineAtom), % % add_transcription_to_wavfile_stream(SIn, TranscriptionLineAtom, SOut), % % close(SIn), % close(SOut), % !. % %add_transcription_to_wavfile_stream(SIn, TranscriptionLineAtom, SOut) :- % read_line(SIn, Line), % ( Line = end_of_file -> % format('~N*** Error: bad call to add_transcription_to_wavfile_stream/3: end of header not found~n', []), % close(SIn), % close(SOut), % fail % ; % \+ is_prolog_string(Line) -> % format('~N*** Error: bad call to add_transcription_to_wavfile_stream/3: end of header not found~n', []), % close(SIn), % close(SOut), % fail % ; % otherwise -> % split_string_into_words(Line, Words), % !, % ( Words = [end_head] -> % % No transcription line found; write out transcription line and end_head % format(SOut, '~N~w~nend_head~n', [TranscriptionLineAtom]), % copy_stream(SIn, SOut) % ; % % Transcription line found; just write out transcription line % Words = [transcription | _Rest] -> % format(SOut, '~N~w~n', [TranscriptionLineAtom]), % copy_stream(SIn, SOut) % ; % otherwise -> % format(SOut, '~N~s~n', [Line]), % add_transcription_to_wavfile_stream(SIn, TranscriptionLineAtom, SOut) % ) % ). %------------------------------------------------------------------------------------ add_transcription_to_wavfile_binary(WavfileIn, TranscriptionAtom, WavfileOut) :- file_exists(WavfileIn), atom_codes(TranscriptionAtom, TranscriptionChars), make_transcription_line(TranscriptionChars, TranscriptionLineChars), open(WavfileIn, read, SIn, [type(binary)]), open(WavfileOut, write, SOut, [type(binary)]), add_transcription_to_wavfile_stream_binary(SIn, TranscriptionLineChars, SOut), close(SIn), close(SOut), !. make_transcription_line(TranscriptionChars, TranscriptionLineChars) :- length(TranscriptionChars, NCharsInTranscription), format_to_chars('transcription -s~d ~s\n', [NCharsInTranscription, TranscriptionChars], TranscriptionLineChars0), ( string_has_even_number_of_chars(TranscriptionLineChars0) -> TranscriptionLineChars0 = TranscriptionLineChars ; otherwise -> append(TranscriptionChars, " ", TranscriptionCharsWithExtraTrailingSpace), make_transcription_line(TranscriptionCharsWithExtraTrailingSpace, TranscriptionLineChars) ). string_has_even_number_of_chars(Str) :- length(Str, N), 0 is N mod 2. add_transcription_to_wavfile_stream_binary(SIn, TranscriptionLineChars, SOut) :- add_transcription_to_wavfile_stream_binary1(SIn, TranscriptionLineChars, SOut), !, copy_stream_binary(SIn, SOut). add_transcription_to_wavfile_stream_binary1(SIn, TranscriptionLineChars, SOut) :- read_line_in_binary_mode(SIn, Line), ( Line = end_of_file -> format('~N*** Error: bad call to add_transcription_to_wavfile_stream/3: end of header not found~n', []), close(SIn), close(SOut), fail ; \+ is_prolog_string(Line) -> format('~N*** Error: bad call to add_transcription_to_wavfile_stream/3: end of header not found~n', []), close(SIn), close(SOut), fail ; otherwise -> split_string_into_words(Line, Words), !, ( Words = [end_head] -> % No transcription line found; write out transcription line and end_head write_string_binary(SOut, TranscriptionLineChars), write_string_binary(SOut, Line) ; % Transcription line found; just write out transcription line Words = [transcription | _Rest] -> write_string_binary(SOut, TranscriptionLineChars) ; otherwise -> write_string_binary(SOut, Line), add_transcription_to_wavfile_stream_binary1(SIn, TranscriptionLineChars, SOut) ) ). %------------------------------------------------------------------------------------ sort_file(InFile, OutFile) :- %require_sicstus_version(3, sort_file/2), absolute_file_name(InFile,AbsIn), absolute_file_name(OutFile,AbsOut), system_on_list([sort, '<', AbsIn, '>', AbsOut]). %------------------------------------------------------------------------------------ %get_pulist(PuList) :- % system_on_list_to_result([pulist], [_Header | RawPuList]), % parse_pulist(RawPuList, PuList). % %parse_pulist([], []). %parse_pulist([F | R], [F1 | R1]) :- % parse_pulist_line(F, F1), % parse_pulist(R, R1). % %parse_pulist_line(Atom, Line) :- % atom_codes(Atom, Chars), % parse_pulist_line_chars(Chars, Line). % %parse_pulist_line_chars(Chars, Line) :- % pulist_line(Line, Chars, []). % %pulist_line(process_and_pid(Process, Pid)) --> % non_whitespace_word(Process0), {lowercase_atom(Process0, Process)}, % white_spaces_including_tabs, % integer_word(Pid), % arbitrary_sequence. %------------------------------------------------------------------------------------ existing_absolute_file_name(File0, File) :- absolute_file_name(File0, File), file_exists(File), !. existing_absolute_file_name(File0, _File) :- format('~N*** Error: unable to interpret ~w as name of file~n', [File0]), fail. %------------------------------------------------------------------------------------ %files_in_directory(Directory, Files, LongOrShort) :- % system_on_list_to_result([ls, Directory], PlainFiles), % ( LongOrShort = long -> % add_directory_in_pathname_list(PlainFiles, Directory, Files) ; % Files = PlainFiles % ). % We can't do it this way, since for some reason Windows gives a different result % when we invoke 'dir' directly. Bizarre. %get_files_in_directory(Directory, AllFiles) :- % absolute_windows_file_name(Directory, Directory1), % system_on_list_to_result([dir, '/b', Directory1], AllFiles). % This always looked like a hack, and has now stopped working - Jul 30, 2005 % Should use directory_files/2 from library(system) %get_files_in_directory(Directory, AllFiles) :- % environ('OS', 'Windows_NT'), % absolute_windows_file_name(Directory, Directory1), % join_with_spaces([dir, '/b', Directory1], Command), % write_atom_list_to_file([Command], 'C:\\tmp_command.bat'), % system_on_list_to_result(['C:\\tmp_command.bat'], OutputLines), % remove_dummy_intro_if_necessary(OutputLines, AllFiles), % !. %get_files_in_directory(Directory, AllFiles) :- % \+ environ('OS', 'Windows_NT'), % system_on_list_to_result([ls, Directory], AllFiles), % !. % %remove_dummy_intro_if_necessary(OutputLines, AllFiles) :- % OutputLines = [_Dummy1, _Dummy2 | AllFiles], % !. %remove_dummy_intro_if_necessary(OutputLines, OutputLines) :- % !. add_directory_in_pathname_list([], _Directory, []). add_directory_in_pathname_list([F | R], Directory, [F1 | R1]) :- add_directory_in_pathname(F, Directory, F1), add_directory_in_pathname_list(R, Directory, R1). %------------------------------------------------------------------------------------ copy_file_between_directories(File, Dir1, Dir2) :- %require_sicstus_version(3, copy_file_between_directories/3), add_directory_in_pathname(File, Dir1, From), add_directory_in_pathname(File, Dir2, To), system_on_list([copy, From, To]). %------------------------------------------------------------------------------------ % Should be able to do it like this, but for some reason the /q switch % doesn't seem to work when we call it through the Prolog interface... %delete_all_files_in_directory(Directory) :- % add_directory_in_pathname('*.*', Directory, FullWildcardPathname), % system_on_list([del, '/q', FullWildcardPathname]). %delete_all_files_in_directory(Directory) :- % files_in_directory(Directory, Files, long), % delete_all_files_in_list(Files). delete_all_files_in_list([]). delete_all_files_in_list([F | R]) :- delete_file(F), delete_all_files_in_list(R). %------------------------------------------------------------------------------------ delete_file_with_status(FileString, Status) :- \+ is_prolog_string(FileString), !, format_to_chars('Error: ~w is not a string', [FileString], Status). delete_file_with_status(FileString, Status) :- atom_codes(File, FileString), ( \+ file_exists(File) -> format_to_chars('Warning: file ~w does not exist, no need to delete', [File], Status) ; otherwise -> ( delete_file(File) -> Status = "ok" ; otherwise -> format_to_chars('Error: unable to delete existing file ~w', [File], Status) ) ). %------------------------------------------------------------------------------------ pathname_has_extension(File, Extension) :- lowercase_atom(File, File1), lowercase_atom(Extension, Extension1), atom_codes(File1, File1Chars), atom_codes(Extension1, Extension1Chars), append(_Prefix, [0'. | Extension1Chars], File1Chars). %------------------------------------------------------------------------------------ split_off_extension_from_pathname(Pathname, WithoutExtension, Extension) :- atom_codes(Pathname, PathnameChars), split_off_extension_from_pathname_chars(PathnameChars, WithoutExtensionChars, ExtensionChars), atom_codes(WithoutExtension, WithoutExtensionChars), atom_codes(Extension, ExtensionChars), !. split_off_extension_from_pathname_chars([], [], []). split_off_extension_from_pathname_chars([0'. | R], [], R) :- \+ member(0'., R), !. split_off_extension_from_pathname_chars([F | R], [F | R1], ExtensionChars) :- !, split_off_extension_from_pathname_chars(R, R1, ExtensionChars). %------------------------------------------------------------------------------------ change_extension_in_file(File, NewExtension, NewFile) :- safe_absolute_file_name(File, AbsFile), split_off_extension_from_pathname(AbsFile, FileWithoutExtension, _OldExtension), format_to_atom('~w.~w', [FileWithoutExtension, NewExtension], NewFile), !. change_extension_in_file(File, NewExtension, NewFile) :- format('~N*** Error: bad call: ~w~n', [change_extension_in_file(File, NewExtension, NewFile)]), fail. %------------------------------------------------------------------------------------ derived_file_names(BaseFile, CommonLabel, Labels, Extensions, Files) :- check_args_for_derived_file_names(BaseFile, CommonLabel, Labels, Extensions, Files), safe_absolute_file_name(BaseFile, AbsBaseFile), split_off_extension_from_pathname(AbsBaseFile, AbsBaseFileWithoutExtension, _OldExtension), derived_file_names1(AbsBaseFileWithoutExtension, CommonLabel, Labels, Extensions, Files). check_args_for_derived_file_names(BaseFile, CommonLabel, Labels, Extensions, Files) :- check_args_for_derived_file_names1(BaseFile, CommonLabel, Labels, Extensions, Files), !. check_args_for_derived_file_names(BaseFile, CommonLabel, Labels, Extensions, Files) :- format('~N*** Error: bad call: ~w~n', [check_args_for_derived_file_names(BaseFile, CommonLabel, Labels, Extensions, Files)]), fail. check_args_for_derived_file_names1(BaseFile, CommonLabel, Labels, Extensions, Files) :- ( safe_absolute_file_name(BaseFile, _AbsBaseFile) -> true ; format('~NCannot interpret first arg as file~n', []), fail ), ( atomic(CommonLabel) -> true ; format('~NSecond arg is not atomic~n', []), fail ), length(Labels, NLabels), length(Extensions, NExtensions), length(Files, NFiles), sort([NLabels, NExtensions, NFiles], Ns), ( length(Ns, 1) -> true ; format('~NList args have different lengths~n', []), fail ). derived_file_names1(_Base, _CommonLabel, [], [], []). derived_file_names1(Base, CommonLabel, [Label | Labels], [Extension | Extensions], [File | Files]) :- derived_file_name(Base, CommonLabel, Label, Extension, File), !, derived_file_names1(Base, CommonLabel, Labels, Extensions, Files). derived_file_name(Base, CommonLabel, Label, Extension, File) :- ( CommonLabel = '' -> format_to_atom('~w_~w.~w', [Base, Label, Extension], File) ; otherwise -> format_to_atom('~w_~w_~w.~w', [Base, CommonLabel, Label, Extension], File) ). %------------------------------------------------------------------------------------ escape_spaces_in_atom(Atom, Atom1) :- atom_codes(Atom, Chars), escape_spaces_in_chars(Chars, Chars1), atom_codes(Atom1, Chars1). escape_spaces_in_chars([], []). % Don't escape already escaped spaces escape_spaces_in_chars([0'\\, 0' | R], [0'\\, 0' | R1]) :- !, escape_spaces_in_chars(R, R1). escape_spaces_in_chars([0' | R], [0'\\, 0' | R1]) :- !, escape_spaces_in_chars(R, R1). escape_spaces_in_chars([F | R], [F | R1]) :- !, escape_spaces_in_chars(R, R1). %------------------------------------------------------------------------------------ unescape_spaces_in_atom(Atom, Atom1) :- atom_codes(Atom, Chars), unescape_spaces_in_chars(Chars, Chars1), atom_codes(Atom1, Chars1). unescape_spaces_in_chars([], []). unescape_spaces_in_chars([0'\\, 0' | R], [0' | R1]) :- !, unescape_spaces_in_chars(R, R1). unescape_spaces_in_chars([F | R], [F | R1]) :- !, unescape_spaces_in_chars(R, R1). %------------------------------------------------------------------------------------ system_on_list(List) :- %require_sicstus_version(3, system_on_list/1), join_with_spaces(List, Command), safe_shell(Command, Status), ( Status \== 0 -> format('~N*** Warning: command ~w returned with status = ~d~n', [Command, Status]) ; true ). %------------------------------------------------------------------------------------ shell_writing_output_to_file_and_printing(Command, TraceFile1, TraceFile2, Label) :- ( running_under_windows -> format_to_atom('~w > ~w 2> ~w', [Command, TraceFile1, TraceFile2], FullCommand) ; otherwise -> format_to_atom('~w >& ~w', [Command, TraceFile1], FullCommand) ), format('~N~n--- Executing "~w"~n~n', [FullCommand]), safe_shell(FullCommand, Status), format('~N--- Output from ~w ---~n', [Label]), print_file(TraceFile1), ( running_under_windows -> print_file(TraceFile2) ; otherwise -> true ), format('~N--- End of output from ~w ---~n', [Label]), ( Status = 0 -> format('~N--- ~w completed', [Label]) ; otherwise -> format('~N--- ~w failed', [Label]) ). %------------------------------------------------------------------------------------ shell_sequence_operator(Op) :- ( running_under_windows -> Op1='&' ; Op1=';' ), Op = Op1, !. %------------------------------------------------------------------------------------ system_on_list_to_result(List, Result) :- %require_sicstus_version(3, system_on_list_to_result/2), absolute_windows_file_name('$REGULUS/Prolog/tmp_command_output_xxx', TmpOutputFile), append(List, ['>', TmpOutputFile], FullList), system_on_list(FullList), ( file_exists(TmpOutputFile) -> read_file_to_atom_list(TmpOutputFile, Result), delete_file(TmpOutputFile); Result = [] ). %------------------------------------------------------------------------------------ get_java_version(Version) :- on_exception( _Exception, get_java_version1(Version), fail ). get_java_version1(Version) :- safe_exec('java -version', [std, null, pipe(S)], _PID), read_line(S, FirstLine), close(S), extract_java_version_from_first_line_of_java_version(FirstLine, Version), !. % Line should look something like this: % java version "1.5.0_06" extract_java_version_from_first_line_of_java_version(Line, Version) :- split_string_into_words(Line, Components), last(Components, LastComponent), atom_codes(LastComponent, LastComponentChars), java_version(Version, LastComponentChars, []). java_version([First, Second, Third, Fourth]) --> [0'"], integer_word(First), [0'.], integer_word(Second), [0'.], integer_word(Third), [0'_], integer_word(Fourth), [0'"], any_chars, !. any_chars --> [_X], !, any_chars. any_chars --> []. %------------------------------------------------------------------------------------ last_wavfile_in_dir(Dir, Wavfile) :- safe_absolute_file_name(Dir, AbsDir), ( safe_directory_exists(AbsDir) -> true ; format('~N*** Error: can\'t find directory ~w~n', [AbsDir]), fail ), safe_directory_files(AbsDir, Wavfiles), tag_wavfiles_by_number(Wavfiles, TaggedWavfiles), ( TaggedWavfiles = [] -> format('~N*** Error: no wavfiles found in directory ~w~n', [AbsDir]), fail ; keysort(TaggedWavfiles, SortedTaggedWavfiles), unkey_list(SortedTaggedWavfiles, SortedWavfiles), reverse(SortedWavfiles, ReversedSortedWavfiles), ReversedSortedWavfiles = [Wavfile | _Rest] ), !. last_wavfile_in_dir(Dir, Wavfile) :- format('~N*** Error: bad call: ~w~n', [last_wavfile_in_dir(Dir, Wavfile)]). tag_wavfiles_by_number([], []). tag_wavfiles_by_number([F | R], [Key-F | R1]) :- wavfile_number(F, Key), !, tag_wavfiles_by_number(R, R1). tag_wavfiles_by_number([_F | R], R1) :- !, tag_wavfiles_by_number(R, R1). wavfile_number(Wavfile, Number) :- atom_codes(Wavfile, WavfileChars), append("utt", RestChars, WavfileChars), append(NumberChars, ".wav", RestChars), safe_number_codes(Number, NumberChars), !. %------------------------------------------------------------------------------------ add_directory_in_pathname(File, Directory, File1) :- append_atoms([Directory, File], 0'\\, File1). %------------------------------------------------------------------------------------ % wrap_file_names_with_search_paths(+Files, +SearchPath, -Files1) wrap_file_names_with_search_paths(Files, SearchPath, Files1) :- is_list(Files), atom(SearchPath), wrap_file_names_with_search_paths1(Files, SearchPath, Files1), !. wrap_file_names_with_search_paths(Files, SearchPath, Files1) :- format('~N*** Error: bad call: ~w~n', [wrap_file_names_with_search_paths(Files, SearchPath, Files1)]). wrap_file_names_with_search_paths1([], _, []). wrap_file_names_with_search_paths1([F | R], SearchPath, [F1 | R1]) :- F1 =.. [SearchPath, F], !, wrap_file_names_with_search_paths1(R, SearchPath, R1). %------------------------------------------------------------------------------------ absolute_windows_file_name(File, AbsoluteWindowsFile) :- absolute_file_name(File, AbsoluteFile), change_slash_to_backslash(AbsoluteFile, AbsoluteWindowsFile). %------------------------------------------------------------------------------------ directory_and_file_for_pathname(Pathname, Directory, File) :- atom_codes(Pathname, PathnameChars), portion_after_last_slash(PathnameChars, FileChars), append(DirectoryChars, [0'/ | FileChars], PathnameChars), atom_codes(Directory, DirectoryChars), atom_codes(File, FileChars), !. directory_and_file_for_pathname(Pathname, Directory, File) :- format('~N*** Error: bad call: ~w~n', [directory_and_file_for_pathname(Pathname, Directory, File)]), fail. portion_after_last_slash([0'/ | R], End) :- \+ member(0'/, R), !, R = End. portion_after_last_slash([0'/ | R], End) :- portion_after_last_slash(R, End). portion_after_last_slash([_F | R], End) :- portion_after_last_slash(R, End). %------------------------------------------------------------------------------------ create_directory_if_necessary(Directory) :- safe_absolute_file_name(Directory, AbsDirectory), ( safe_directory_exists(AbsDirectory) -> true ; otherwise -> format('~N--- Making directory ~w~n', [AbsDirectory]), make_directory(AbsDirectory) ). %------------------------------------------------------------------------------------ create_directory_above_if_necessary(Directory) :- safe_absolute_file_name(Directory, AbsDirectory), format_to_atom('~w/..', [AbsDirectory], DirectoryAbove), safe_absolute_file_name(DirectoryAbove, AbsDirectoryAbove), create_directory_if_necessary(AbsDirectoryAbove). %------------------------------------------------------------------------------------ create_directory_for_file_if_necessary(Pathname) :- create_directory_for_file_if_necessary(Pathname, _AbsDirectory). create_directory_for_file_if_necessary(Pathname, AbsDirectory) :- directory_and_file_for_pathname(Pathname, Directory, _File), safe_absolute_file_name(Directory, AbsDirectory), ( safe_directory_exists(Directory) -> true ; otherwise -> create_directory_for_file_if_necessary(Directory) ), !, create_directory_if_necessary(Directory). %------------------------------------------------------------------------------------ parent_directory(Dir, AbsParentDir) :- format_to_atom('~w/..', [Dir], ParentDir), safe_absolute_file_name(ParentDir, AbsParentDir). %------------------------------------------------------------------------------------ format_to_atom(FormatString, Args, Atom) :- format_to_chars(FormatString, Args, String), atom_codes(Atom, String). %------------------------------------------------------------------------------------ change_slash_to_backslash(N, N) :- number(N), !. change_slash_to_backslash(A, A1) :- atom(A), !, atom_codes(A, Chars), change_slash_to_backslash_in_string(Chars, Chars1), atom_codes(A1, Chars1). change_slash_to_backslash(T, T1) :- functor(T, F, N), functor(T1, F, N), change_slash_to_backslash_args(N, T, T1). change_slash_to_backslash_args(0, _T, _T1). change_slash_to_backslash_args(I, T, T1) :- I > 0, arg(I, T, Arg), arg(I, T1, Arg1), change_slash_to_backslash(Arg, Arg1), I1 is I - 1, !, change_slash_to_backslash_args(I1, T, T1). change_slash_to_backslash_in_string([], []). change_slash_to_backslash_in_string([F | R], [F1 | R1]) :- ( F = 0'/ -> F1 = 0'\\ ; F1 = F ), !, change_slash_to_backslash_in_string(R, R1). %------------------------------------------------------------------------------------ choose_from_text_menu(Question, Alist, Answer) :- format('~N~n', []), length(Alist, NChoices), display_menu_alist(Alist, 1), format('~N~n~w ', [Question]), read_line(user, Chars), split_string_into_words(Chars, Words), ( ( Words = [IntAtom], atom_to_int(IntAtom, N), integer(N), 0 < N, N =< NChoices ) -> safe_nth(N, Alist, Answer-_Text) ; otherwise -> format('~N~nPlease give a number from 1 to ~d~n', [NChoices]), choose_from_text_menu(Question, Alist, Answer) ). display_menu_alist([], _N). display_menu_alist([_Answer-Text | R], I) :- format('~N ~d~4|~w~n', [I, Text]), I1 is I + 1, !, display_menu_alist(R, I1). %------------------------------------------------------------------------------------ get_confirmation(FormatAtom, Args) :- format(FormatAtom, Args), read_line(user, Chars), split_string_into_words(Chars, Words), ( Words = [y] -> true ; Words = [n] -> fail ; format('~NPlease answer \'y\' or \'n\'~n', []), !, get_confirmation(FormatAtom, Args) ). %------------------------------------------------------------------------------------ % Read InFile, and represent the output as a string. read_unicode_file_to_string(InFile, String) :- open(InFile, read, SIn, [encoding('UTF-8')]), read_stream_to_string_list(SIn, List), append_list(List, String), close(SIn). %------------------------------------------------------------------------------------ read_lines_until_non_empty_line(Stream, String) :- read_line(Stream, String0), !, ( String0 = [] -> read_lines_until_non_empty_line(Stream, String) ; otherwise -> String = String0 ). %------------------------------------------------------------------------------------ % Read InFile, and represent the output as a string. read_file_to_string(InFile, String) :- open(InFile, read, SIn), read_stream_to_string_list(SIn, List), append_list(List, String), close(SIn). read_file_to_string(InFile, default_encoding, String) :- !, read_file_to_string(InFile, String). read_file_to_string(InFile, Encoding, String) :- open(InFile, read, SIn, [encoding(Encoding)]), read_stream_to_string_list(SIn, List), append_list(List, String), close(SIn). read_stream_to_string_list(SIn, List) :- read_line(SIn, Line), read_stream_to_string_list1(Line, SIn, List). read_stream_to_string_list1(Line, _SIn, List) :- Line = end_of_file, !, List = []. read_stream_to_string_list1(Line, SIn, [LineWithNL | R]) :- append(Line, "\n", LineWithNL), !, read_stream_to_string_list(SIn, R). %------------------------------------------------------------------------------------ unicode_file_to_normal_file(InFile, OutFile) :- read_unicode_file_to_atom_list(InFile, List), write_atom_list_to_file(List, OutFile). %------------------------------------------------------------------------------------ normal_file_to_unicode_file(InFile, OutFile) :- normal_file_to_unicode_file(InFile, OutFile, 'UTF-8'). normal_file_to_unicode_file(InFile, OutFile, Encoding) :- read_file_to_atom_list(InFile, List), write_atom_list_to_unicode_file(List, OutFile, Encoding). %------------------------------------------------------------------------------------ % Read InFile, and represent the output as a list of atoms, with each atom % representing a line. read_file_to_atom_list(InFile, List) :- read_file_to_atom_list(InFile, default_encoding, List). read_unicode_file_to_atom_list(InFile, List) :- read_file_to_atom_list(InFile, 'UTF-8', List). read_file_to_atom_list(InFile, Encoding, List) :- ( Encoding = default_encoding -> open(InFile, read, SIn) ; otherwise -> open(InFile, read, SIn, [encoding(Encoding)]) ), read_stream_to_atom_list(SIn, List, 1), close(SIn). read_stream_to_atom_list(SIn, List, I) :- read_line(SIn, Line), read_stream_to_atom_list1(Line, SIn, List, I). read_stream_to_atom_list1(Line, _SIn, List, _I) :- Line = end_of_file, !, List = []. read_stream_to_atom_list1(Line, SIn, [F | R], I) :- safe_atom_codes_for_reading_line_to_atom(F, Line, I), I1 is I + 1, read_stream_to_atom_list(SIn, R, I1). %------------------------------------------------------------------------------------ % Read InFile, and represent the output as a list of strings. read_unicode_file_to_string_list(InFile, List) :- open(InFile, read, SIn, [encoding('UTF-8')]), read_stream_to_simple_string_list(SIn, List), close(SIn). read_file_to_simple_string_list(InFile, List) :- open(InFile, read, SIn), read_stream_to_simple_string_list(SIn, List), close(SIn). read_stream_to_simple_string_list(SIn, List) :- read_line(SIn, Line), read_stream_to_simple_string_list1(Line, SIn , List). read_stream_to_simple_string_list1(Line, _SIn, List) :- Line = end_of_file, !, List = []. read_stream_to_simple_string_list1(Line, SIn, [Line | R]) :- read_stream_to_simple_string_list(SIn, R). %------------------------------------------------------------------------------------ % As in read_file_to_atom_list/2 above, but at most the first N lines. read_first_n_records_of_file_to_atom_list(InFile, List, N) :- open(InFile, read, SIn), read_first_n_records_of_stream_to_atom_list(SIn, List, 0, N), close(SIn), !. read_first_n_records_of_file_to_atom_list(InFile, List, N) :- format('~N*** Error: bad call: ~w~n', [read_first_n_records_of_file_to_atom_list(InFile, List, N)]), fail. read_first_n_records_of_stream_to_atom_list(_SIn, List, I, N) :- I >= N, List = [], !. read_first_n_records_of_stream_to_atom_list(SIn, List, I, N) :- I < N, read_line(SIn, Line), read_first_n_records_of_stream_to_atom_list1(Line, SIn, List, I, N). read_first_n_records_of_stream_to_atom_list1(Line, _SIn, List, _I, _N) :- Line = end_of_file, !, List = []. read_first_n_records_of_stream_to_atom_list1(Line, SIn, [F | R], I, N) :- safe_atom_codes_for_reading_line_to_atom(F, Line, I), I1 is I + 1, read_first_n_records_of_stream_to_atom_list(SIn, R, I1, N). %------------------------------------------------------------------------------------ safe_atom_codes_for_reading_line_to_atom(Atom, Line, _I) :- length(Line, LineLength), LineLength =< 50000, atom_codes(Atom, Line), !. safe_atom_codes_for_reading_line_to_atom(Atom, Line, I) :- length(Init, 200), append(Init, _, Line), atom_codes(Atom, Init), format('~N*** Warning: line ~d ("~s...") in file is longer than 50000 chars, truncating to 200~n', [I, Init]). %------------------------------------------------------------------------------------ % Count the number of Prolog terms in a file. number_of_prolog_records_in_file(InFile, N) :- open(InFile, read, SIn), number_of_prolog_records_in_stream(SIn, 0-N), close(SIn), !. number_of_prolog_records_in_file(InFile, N) :- format('~N*** Error: bad call: ~w~n', [number_of_prolog_records_in_file(InFile, N)]), fail. number_of_prolog_records_in_stream(SIn, CIn-COut) :- read(SIn, Term), number_of_prolog_records_in_stream1(Term, SIn, CIn-COut). number_of_prolog_records_in_stream1(Term, _SIn, CIn-CIn) :- Term = end_of_file, !. number_of_prolog_records_in_stream1(_Term, SIn, CIn-COut) :- CNext is CIn + 1, number_of_prolog_records_in_stream(SIn, CNext-COut). %------------------------------------------------------------------------------------ % Read a file of Prolog terms into a list, succeeds or fails safe_prolog_file_to_list(InFile, List) :- safe_prolog_file_to_list(InFile, List, default_encoding). safe_prolog_file_to_list(InFile, List, Encoding) :- on_exception(Exception, prolog_file_or_files_to_list(InFile, List, Encoding), safe_prolog_file_to_list_handle_exception(Exception, InFile, Encoding) ), !. safe_prolog_file_to_list_handle_exception(Exception, InFile, Encoding) :- format('~N*** Error: exception raised when trying to read ~w as a sequence of Prolog terms with encoding ~w~n', [InFile, Encoding]), print_message(error, Exception), fail. %------------------------------------------------------------------------------------ safe_prolog_file_to_list_printing_statistics(InFile, List) :- safe_prolog_file_to_list_printing_statistics(InFile, List, default_encoding). safe_prolog_file_to_list_printing_statistics(InFile, List, Encoding) :- safe_absolute_file_name(InFile, AbsInFile), safe_prolog_file_to_list(AbsInFile, List, Encoding), length(List, N), format('~N--- Read file (~d records) ~w~n', [N, AbsInFile]), !. %------------------------------------------------------------------------------------ % Read a file, or a list of files, of Prolog terms into a list prolog_file_or_files_to_list(FileOrFiles, List) :- prolog_file_or_files_to_list(FileOrFiles, List, default_encoding). prolog_file_or_files_to_list(FileOrFiles, List, Encoding) :- prolog_file_or_files_to_list1(FileOrFiles, List-[], Encoding). prolog_file_or_files_to_list1([], In-In, _Encoding) :- !. prolog_file_or_files_to_list1([F | R], In-Out, Encoding) :- ( Encoding = default_encoding -> open(F, read, SIn) ; otherwise -> open(F, read, SIn, [encoding(Encoding)]) ), ( prolog_file_to_list_stream(SIn, F, In-Next) -> true ; otherwise -> format('~N*** Warning: unable to read file ~w, treating as empty~n', [F]), In = Next ), close(SIn), !, prolog_file_or_files_to_list1(R, Next-Out, Encoding). prolog_file_or_files_to_list1(File, In-Out, Encoding) :- ( Encoding = default_encoding -> open(File, read, SIn) ; open(File, read, SIn, [encoding(Encoding)]) ), prolog_file_to_list_stream(SIn, File, In-Out), close(SIn), !. %------------------------------------------------------------------------------------ cat_prolog_files(InFiles, OutFile) :- prolog_file_or_files_to_list(InFiles, List), list_to_prolog_file(List, OutFile). cat_prolog_files(InFiles, OutFile, Encoding) :- prolog_file_or_files_to_list(InFiles, List, Encoding), list_to_prolog_file_with_encoding(List, OutFile, Encoding). %------------------------------------------------------------------------------------ % Read a file of Prolog terms into a list regulus_file_to_list(InFile, List) :- open_regulus_file(InFile, read, SIn), prolog_file_to_list_stream(SIn, InFile, List-[]), close(SIn), !. regulus_file_to_list_file(InFile, List) :- format('~N*** Error: bad call: ~w~n', [regulus_file_to_list_file(InFile, List)]), fail. %------------------------------------------------------------------------------------ % Read a file of Prolog terms into a list prolog_file_to_list_null_if_no_file(InFile, List) :- \+ safe_file_exists(InFile), !, List = []. prolog_file_to_list_null_if_no_file(InFile, List) :- prolog_file_to_list(InFile, List). prolog_file_to_list(InFile, List) :- open(InFile, read, SIn), prolog_file_to_list_stream(SIn, InFile, List-[]), close(SIn), !. prolog_file_to_list(InFile, List) :- format('~N*** Error: bad call: ~w~n', [prolog_file_to_list(InFile, List)]), fail. %------------------------------------------------------------------------------------ prolog_file_to_list_stream(SIn, ListIn-ListOut) :- prolog_file_to_list_stream(SIn, '(unknown file)', ListIn-ListOut). prolog_file_to_list_stream(SIn, InFile, ListIn-ListOut) :- max_exceptions_when_reading_prolog_file(MaxExceptions), prolog_file_to_list_stream(SIn, InFile, ListIn-ListOut, 0-_NExceptions, MaxExceptions). %prolog_file_to_list_stream(SIn, ListIn-ListOut) :- % safe_read(SIn, Term), % prolog_file_to_list_stream1(Term, SIn, ListIn-ListOut). prolog_file_to_list_stream(SIn, InFile, ListIn-ListOut, NExIn-NExOut, MaxEx) :- ( NExIn > MaxEx -> format('~N*** Error: more than ~d exceptions when reading file, giving up~n', [MaxEx]), close(SIn), fail ; safe_read_no_exceptions(SIn, InFile, Term) -> prolog_file_to_list_stream1(Term, SIn, InFile, ListIn-ListOut, NExIn-NExOut, MaxEx) ; otherwise -> NExNext is NExIn + 1, prolog_file_to_list_stream(SIn, InFile, ListIn-ListOut, NExNext-NExOut, MaxEx) ). prolog_file_to_list_stream1(Term, _SIn, _InFile, ListIn-ListIn, NExIn-NExIn, _MaxEx) :- Term = end_of_file, !. prolog_file_to_list_stream1(Term, SIn, InFile, ListIn-ListOut, NExIn-NExOut, MaxEx) :- ListIn = [Term | ListNext], prolog_file_to_list_stream(SIn, InFile, ListNext-ListOut, NExIn-NExOut, MaxEx). %------------------------------------------------------------------------------------ prolog_file_to_list_vars_as_consts(InFile, List, Encoding) :- ( Encoding = default_encoding -> open(InFile, read, SIn) ; open(InFile, read, SIn, [encoding(Encoding)]) ), prolog_file_to_list_stream_vars_as_consts(SIn, InFile, List-[]), close(SIn), !. prolog_file_to_list_vars_as_consts(InFile, List, Encoding) :- format('~N*** Error: bad call: ~w~n', [prolog_file_to_list_vars_as_consts(InFile, List, Encoding)]), fail. prolog_file_to_list_stream_vars_as_consts(SIn, ListIn-ListOut) :- prolog_file_to_list_stream_vars_as_consts(SIn, '(unknown file)', ListIn-ListOut). prolog_file_to_list_stream_vars_as_consts(SIn, InFile, ListIn-ListOut) :- max_exceptions_when_reading_prolog_file(MaxExceptions), prolog_file_to_list_stream_vars_as_consts(SIn, InFile, ListIn-ListOut, 0-_NExceptions, MaxExceptions). %prolog_file_to_list_stream(SIn, ListIn-ListOut) :- % safe_read(SIn, Term), % prolog_file_to_list_stream1(Term, SIn, ListIn-ListOut). prolog_file_to_list_stream_vars_as_consts(SIn, InFile, ListIn-ListOut, NExIn-NExOut, MaxEx) :- ( NExIn > MaxEx -> format('~N*** Error: more than ~d exceptions when reading file, giving up~n', [MaxEx]), close(SIn), fail ; safe_read_no_exceptions_vars_as_consts(SIn, InFile, Term) -> prolog_file_to_list_stream1_vars_as_consts(Term, SIn, InFile, ListIn-ListOut, NExIn-NExOut, MaxEx) ; otherwise -> NExNext is NExIn + 1, prolog_file_to_list_stream_vars_as_consts(SIn, InFile, ListIn-ListOut, NExNext-NExOut, MaxEx) ). prolog_file_to_list_stream1_vars_as_consts(Term, _SIn, _InFile, ListIn-ListIn, NExIn-NExIn, _MaxEx) :- Term = end_of_file, !. prolog_file_to_list_stream1_vars_as_consts(Term, SIn, InFile, ListIn-ListOut, NExIn-NExOut, MaxEx) :- ListIn = [Term | ListNext], prolog_file_to_list_stream_vars_as_consts(SIn, InFile, ListNext-ListOut, NExIn-NExOut, MaxEx). %------------------------------------------------------------------------------------ :- dynamic previously_loaded_prolog_include_file/1. prolog_file_or_files_to_list_including_line_info(File, List) :- \+ is_list(File), !, prolog_file_or_files_to_list_including_line_info([File], List). prolog_file_or_files_to_list_including_line_info(Files, List) :- is_list(Files), retractall(previously_loaded_prolog_include_file(_)), prolog_files_to_list_including_line_info(Files, List-[]). prolog_files_to_list_including_line_info([], ListIn-ListIn). prolog_files_to_list_including_line_info([F | R], ListIn-ListOut) :- prolog_file_to_list_including_line_info(F, ListIn-ListNext), !, prolog_files_to_list_including_line_info(R, ListNext-ListOut). prolog_file_to_list_including_line_info(File, ListIn-ListOut) :- safe_absolute_file_name(File, AbsoluteFile), open(AbsoluteFile, read, S), prolog_stream_to_list_including_line_info(S, ListIn-ListOut, 0-_LastItemNumber, 0, AbsoluteFile), close(S). prolog_stream_to_list_including_line_info(S, ListIn-ListOut, ItemNumber0-OutItemNumber, LastLine0, File) :- ItemNumber is ItemNumber0 + 1, LastLine is LastLine0 + 1, read(S, Term), line_count(S, CurrentLine), prolog_stream_to_list_including_line_info1(Term, S, ListIn-ListOut, ItemNumber-OutItemNumber, LastLine-CurrentLine, File). prolog_stream_to_list_including_line_info1(end_of_file, _S, ListIn-ListIn, ItemNumber-ItemNumber, _Lines, _File) :- !. prolog_stream_to_list_including_line_info1(include(IncludeFile), S, ListIn-ListOut, InItemNumber-OutItemNumber, _LastLine-CurrentLine, File) :- !, prolog_include_file_to_list_including_line_info(IncludeFile, File, ListIn-ListNext, InItemNumber-NextItemNumber), prolog_stream_to_list_including_line_info(S, ListNext-ListOut, NextItemNumber-OutItemNumber, CurrentLine, File). prolog_stream_to_list_including_line_info1(Term, S, ListIn-ListOut, InItemNumber-OutItemNumber, LastLine-CurrentLine, File) :- LineInfo = line_info(InItemNumber, LastLine-CurrentLine, File), ListIn = [term(Term, LineInfo) | ListNext], !, prolog_stream_to_list_including_line_info(S, ListNext-ListOut, InItemNumber-OutItemNumber, CurrentLine, File). prolog_include_file_to_list_including_line_info(IncludeFile, CurrentFile, ListIn-ListOut, InItemNumber-OutItemNumber) :- safe_absolute_file_relative_to_current(IncludeFile, CurrentFile, AbsoluteIncludeFile), prolog_include_file_to_list_including_line_info1(AbsoluteIncludeFile, ListIn-ListOut, InItemNumber-OutItemNumber). prolog_include_file_to_list_including_line_info1(AbsoluteIncludeFile, ListIn-ListIn, InItemNumber-InItemNumber) :- previously_loaded_prolog_include_file(AbsoluteIncludeFile), !. prolog_include_file_to_list_including_line_info1(AbsoluteIncludeFile, ListIn-ListOut, InItemNumber-OutItemNumber) :- format('~N [Including file ~w]~n', [AbsoluteIncludeFile]), % Do the assert before we start reading rather than after in case we get a recursive include. asserta(previously_loaded_prolog_include_file(AbsoluteIncludeFile)), open(AbsoluteIncludeFile, read, S), prolog_stream_to_list_including_line_info(S, ListIn-ListOut, InItemNumber-OutItemNumber, 0, AbsoluteIncludeFile), close(S), !. safe_absolute_file_relative_to_current(File, CurrentFile, AbsoluteFile) :- on_exception( _Exception, safe_absolute_file_for_reading_relative_to_current1(File, CurrentFile, AbsoluteFile), fail ), !. safe_absolute_file_relative_to_current(File, CurrentFile, _AbsoluteFile) :- format('~NError: *** Unable to interpret ~w (included in ~w) as the name of a readable file.~n', [File, CurrentFile]), fail. safe_absolute_file_for_reading_relative_to_current1(File, CurrentFile, AbsoluteFile) :- directory_and_file_for_pathname(CurrentFile, CurrentDirectory, _), safe_working_directory(LastDirectory, CurrentDirectory), safe_absolute_file_name(File, AbsoluteFile), safe_working_directory(_, LastDirectory). %------------------------------------------------------------------------------------ safe_list_to_prolog_file_printing_statistics(List, File) :- on_exception(Exception, list_to_prolog_file_printing_statistics(List, File), safe_list_to_prolog_file_handle_exception(Exception, File) ), !. safe_list_to_prolog_file_handle_exception(Exception, File) :- format('~N*** Error: exception raised when trying to create Prolog file~n', [File]), print_message(error, Exception), fail. list_to_prolog_file_printing_statistics(List, File) :- safe_absolute_file_name(File, AbsFile), list_to_prolog_file(List, File), length(List, N), format('~N--- Printed file (~d records) ~w~n', [N, AbsFile]), !. %------------------------------------------------------------------------------------ open_regulus_file(File, Mode, Stream) :- current_predicate(user:default_regulus_encoding/1), user:default_regulus_encoding(Encoding), !, open(File, Mode, Stream, [encoding(Encoding)]). open_regulus_file(File, Mode, Stream) :- open(File, Mode, Stream). %------------------------------------------------------------------------------------ divide_file_into_n_parts(File, NParts) :- safe_absolute_file_name(File, AbsFile), read_file_to_atom_list(AbsFile, List), length(List, N), format('~N--- Read file ~w (~d records)~n', [AbsFile, N]), divide_list_into_n_parts(List, NParts, SubLists), split_off_extension_from_pathname(AbsFile, BaseFile, Extension), write_parts_of_file(SubLists, 1, BaseFile, Extension), !. divide_file_into_n_parts(File, NParts) :- format('~N*** Error: bad call: ~w~n', [divide_file_into_n_parts(File, NParts)]), fail. divide_list_into_n_parts(List, N, SubLists) :- divide_list_into_n_parts1(List, 0, N, SubLists). divide_list_into_n_parts1(_List, I, N, []) :- I >= N, !. divide_list_into_n_parts1(List, I, N, [SubList | SubLists]) :- get_mod_n_elements_of_list(List, 1, I, N, SubList), I1 is I + 1, !, divide_list_into_n_parts1(List, I1, N, SubLists). get_mod_n_elements_of_list([], _I, _Mod, _N, []). get_mod_n_elements_of_list([F | R], I, Mod, N, Result) :- ( Mod is I mod N -> Result = [F | R1] ; otherwise -> Result = R1 ), I1 is I + 1, !, get_mod_n_elements_of_list(R, I1, Mod, N, R1). write_parts_of_file([], _I, _BaseFile, _Extension). write_parts_of_file([F | R], I, BaseFile, Extension) :- format_to_atom('~w_~d.~w', [BaseFile, I, Extension], File), length(F, N), write_atom_list_to_file(F, File), format('~N--- Written file (~d elements) ~w~n', [N, File]), I1 is I + 1, !, write_parts_of_file(R, I1, BaseFile, Extension). %------------------------------------------------------------------------------------ list_to_regulus_file(List, File) :- open_regulus_file(File, write, S), list_to_prolog_stream(List, S), close(S), !. %------------------------------------------------------------------------------------ % Write a list of terms to a Prolog-readable file. list_to_prolog_file_with_encoding(List, File, Encoding) :- open(File, write, S, [encoding(Encoding)]), list_to_prolog_stream(List, S), close(S), !. list_to_prolog_file_with_encoding(List, File, Encoding) :- format('~N*** Error: bad call: ~w~n', [list_to_prolog_file_with_encoding(List, File, Encoding)]), fail. list_to_prolog_file(List, File) :- open_regulus_file(File, write, S), list_to_prolog_stream(List, S), close(S), !. list_to_prolog_file(List, File) :- format('~N*** Error: bad call: ~w~n', [list_to_prolog_file(List, File)]), fail. list_to_prolog_stream([], _S). list_to_prolog_stream([F | R], S) :- %format(S, '~N~q.~n', [F]), portray_clause(S, F), %prettyprintq_to_stream(S, F, 0, 100), format(S, '.~n~n', []), !, list_to_prolog_stream(R, S). %------------------------------------------------------------------------------------ normal_prolog_file_to_prolog_file_with_encoding(InFile, OutFile, Encoding) :- prolog_file_to_list(InFile, List), list_to_prolog_file_with_encoding(List, OutFile, Encoding). %------------------------------------------------------------------------------------ % Write a list of terms to a Prolog-readable file. list_to_prolog_file_prettyprint_unicode(List, File) :- open(File, write, S, [encoding('UTF-8'), encoding_signature(true)]), list_to_prolog_stream_prettyprint(List, S), close(S), !. list_to_prolog_file_prettyprint_unicode(_List, File) :- format('~N*** Error: bad call: ~w~n', [list_to_prolog_file_prettyprint_unicode((...), File)]), fail. list_to_prolog_file_prettyprint(List, File) :- list_to_prolog_file_prettyprint_with_encoding(List, File, default_encoding). list_to_prolog_file_prettyprint_with_encoding(List, File, Encoding) :- ( Encoding = default_encoding -> open(File, write, S) ; otherwise -> open(File, write, S, [encoding(Encoding), encoding_signature(true)]) ), list_to_prolog_stream_prettyprint(List, S), close(S), !. list_to_prolog_file_prettyprint_with_encoding(List, File) :- format('~N*** Error: bad call: ~w~n', [list_to_prolog_file_prettyprint(List, File)]), fail. list_to_prolog_stream_prettyprint([], _S). list_to_prolog_stream_prettyprint([F | R], S) :- %portray_clause(S, F), prettyprintq_to_stream(S, F), format(S, '.~N~n', []), !, list_to_prolog_stream_prettyprint(R, S). %------------------------------------------------------------------------------------ % Read InFiles, and copy them to OutFile line by line cat_files(InFiles, OutFile) :- open(OutFile, write, SOut), copy_files_to_stream(InFiles, SOut), close(SOut). copy_files_to_stream([], _SOut). copy_files_to_stream([F | R], SOut) :- copy_file_to_stream(F, SOut), !, copy_files_to_stream(R, SOut). %------------------------------------------------------------------------------------ safe_rename_file_using_mv_if_possible(InFile, OutFile) :- safe_absolute_file_name(InFile, AbsInFile), safe_absolute_file_name(OutFile, AbsOutFile), safe_rename_file_using_mv_if_possible1(AbsInFile, AbsOutFile). safe_rename_file_using_mv_if_possible1(AbsInFile, AbsOutFile) :- on_cygwin_and_bin_dir_found, format_to_atom('mv ~w ~w', [AbsInFile, AbsOutFile], Command), safe_shell(Command, Status), Status = 0, !. safe_rename_file_using_mv_if_possible1(AbsInFile, AbsOutFile) :- safe_rename_file(AbsInFile, AbsOutFile). %------------------------------------------------------------------------------------ copy_files_to_dir([], _Dir). copy_files_to_dir([F | R], Dir) :- copy_file_to_dir(F, Dir), !, copy_files_to_dir(R, Dir). copy_file_to_dir(Pathname, NewDir) :- directory_and_file_for_pathname(Pathname, _Dir, File), format_to_atom('~w/~w', [NewDir, File], NewPathname), copy_file(Pathname, NewPathname), !. %------------------------------------------------------------------------------------ % Read InFile, and copy to OutFile line by line copy_file(InFile, OutFile) :- on_cygwin_and_bin_dir_found, safe_absolute_file_name(InFile, AbsInFile), safe_absolute_file_name(OutFile, AbsOutFile), format_to_atom('cp ~w ~w', [AbsInFile, AbsOutFile], Command), safe_shell(Command, Status), Status = 0, !. copy_file(InFile, OutFile) :- open(OutFile, write, SOut), copy_file_to_stream(InFile, SOut), close(SOut). copy_file_to_stream(InFile, SOut) :- open(InFile, read, SIn), copy_stream(SIn, SOut), close(SIn). copy_stream(SIn, SOut) :- read_line(SIn, Line), copy_stream1(Line, SIn, SOut). copy_stream1(Line, _SIn, _SOut) :- Line = end_of_file, !. copy_stream1(Line, SIn, SOut) :- format(SOut, '~N~s~n', [Line]), copy_stream(SIn, SOut). %------------------------------------------------------------------------------------ copy_file_binary(InFile, OutFile) :- open(InFile, read, SIn, [type(binary)]), open(OutFile, write, SOut, [type(binary)]), copy_stream_binary(SIn, SOut), close(SIn), close(SOut), !. %------------------------------------------------------------------------------------ copy_stream_binary(SIn, SOut) :- get_byte(SIn, Byte), !, copy_stream_binary1(Byte, SIn, SOut). copy_stream_binary1(Byte, _SIn, _SOut) :- Byte = -1, !. copy_stream_binary1(Byte, SIn, SOut) :- put_byte(SOut, Byte), !, copy_stream_binary(SIn, SOut). %------------------------------------------------------------------------------------ read_line_in_binary_mode(SIn, Line) :- get_byte(SIn, Byte), !, read_line_in_binary_mode1(Byte, SIn, Line). % Didn't find end-of-line. read_line_in_binary_mode1(Byte, _SIn, _Line) :- Byte = -1, !, fail. read_line_in_binary_mode1(Byte, SIn, Line) :- end_of_line_byte(Byte), !, consume_end_of_line_byte_if_possible(SIn, Rest), Line = [Byte | Rest]. read_line_in_binary_mode1(Byte, SIn, [Byte | Rest]) :- !, read_line_in_binary_mode(SIn, Rest). consume_end_of_line_byte_if_possible(SIn, Rest) :- peek_byte(SIn, Byte), ( end_of_line_byte(Byte) -> get_byte(SIn, EOLByte), Rest = [EOLByte] ; otherwise -> Rest = [] ). end_of_line_byte(0'\r). end_of_line_byte(0'\n). %------------------------------------------------------------------------------------ write_string_binary(_SOut, []). write_string_binary(SOut, [F | R]) :- put_byte(SOut, F), !, write_string_binary(SOut, R). %------------------------------------------------------------------------------------ :- dynamic line_to_subtract/1. subtract_files(InFile, FileToRemove, OutFile) :- subtract_files(InFile, FileToRemove, default_encoding, OutFile). subtract_files(InFile, FileToRemove, Encoding, OutFile) :- safe_absolute_file_name(InFile, AbsInFile), safe_absolute_file_name(FileToRemove, AbsFileToRemove), safe_absolute_file_name(OutFile, AbsOutFile), store_file_to_subtract(AbsFileToRemove, Encoding), ( Encoding = default_encoding -> open(AbsInFile, read, SIn) ; otherwise -> open(AbsInFile, read, SIn, [encoding(Encoding)]) ), ( Encoding = default_encoding -> open(AbsOutFile, write, SOut) ; otherwise -> open(AbsOutFile, write, SOut, [encoding(Encoding)]) ), copy_stream_subtracting(SIn, SOut), close(SIn), close(SOut). store_file_to_subtract(AbsFileToRemove, Encoding) :- retractall(line_to_subtract(_)), read_file_to_atom_list(AbsFileToRemove, Encoding, List), store_file_to_subtract1(List). store_file_to_subtract1([]). store_file_to_subtract1([F | R]) :- assertz(line_to_subtract(F)), !, store_file_to_subtract1(R). copy_stream_subtracting(SIn, SOut) :- read_line(SIn, Line), copy_stream_subtracting1(Line, SIn, SOut). copy_stream_subtracting1(Line, _SIn, _SOut) :- Line = end_of_file, !. copy_stream_subtracting1(Line, SIn, SOut) :- atom_codes(Atom, Line), ( line_to_subtract(Atom) -> true ; otherwise -> format(SOut, '~N~s~n', [Line]) ), !, copy_stream_subtracting(SIn, SOut). %------------------------------------------------------------------------------------ % Print lines Start to Finish of File print_lines_from_file(File, Start, Finish) :- open(File, read, S), print_lines_from_stream(S, 0, Start, Finish), close(S). print_lines_from_stream(_S, N, _Start, Finish) :- N > Finish, !. print_lines_from_stream(S, N, Start, Finish) :- N =< Finish, read_line(S, Line), N1 is N + 1, print_lines_from_stream1(Line, S, N1, Start, Finish). print_lines_from_stream1(Line, _S, _N, _Start, _Finish) :- Line = end_of_file, !. print_lines_from_stream1(Line, S, N, Start, Finish) :- ( ( Start =< N, N =< Finish ) -> format('~N~s~n', [Line]) ; true ), !, print_lines_from_stream(S, N, Start, Finish). %------------------------------------------------------------------------------------ % Create a timestamped copy of File, called BackupFile create_timestamped_copy(File, BackupFile) :- absolute_file_name(File, AbsFile), file_exists(AbsFile, [read, write]), ( split_atom_into_words(AbsFile, 0'., [MainAbsFile, Extension]) -> true ; MainAbsFile = AbsFile, Extension = '' ), datime(Datime), timestamped_file(MainAbsFile, Datime, Extension, BackupFile), copy_file(File, BackupFile), !. create_timestamped_copy(File, BackupFile) :- format('~N*** Error: bad call: ~w~n', [create_timestamped_copy(File, BackupFile)]), fail. %------------------------------------------------------------------------------------ % Read InFile, and print it out line by line. print_file(File) :- read_file_to_atom_list(File, List), print_list_line_by_line(List). print_list_line_by_line([]). print_list_line_by_line([F | R]) :- format('~N~w~n', [F]), print_list_line_by_line(R). %------------------------------------------------------------------------------------ % Read InFile. Each line is read as a string of characters Line. % Make the call ParsePred(Line, Output, Args) for each line, and % write Output to OutFile. parse_file(InFile, OutFile, ParsePred, Args) :- init_parse_file_counter, open(InFile, read, SIn), open(OutFile, write, SOut), parse_stream(SIn, SOut, ParsePred, Args), close(SIn), close(SOut). parse_stream(SIn, SOut, ParsePred, Args) :- repeat, read_line(SIn, Line), inc_and_notify_parse_file_counter(100), parse_stream1(Line, SOut, ParsePred, Args). parse_stream1(Line, _SOut, _ParsePred, _Args) :- Line = end_of_file, !. parse_stream1(Line, SOut, ParsePred, Args) :- Call =.. [ParsePred, Line, Output | Args], ( call(Call) -> ( functor(Output, discard, _) -> true ; format(SOut, "~N~q.~n", [Output]) ) ; format("~N*** Error: unable to process line ~s~n", [Line]) ), fail. %------------------------------------------------------------------------------------ % Keeping track of how many records have been processed, and notifying user. init_parse_file_counter :- retractall(parse_file_counter(_)), assert(parse_file_counter(0)). inc_and_notify_parse_file_counter(Interval) :- parse_file_counter(I), retract(parse_file_counter(I)), I1 is I + 1, assert(parse_file_counter(I1)), notify_number_if_divisible_by(I1, Interval), !. notify_number_if_divisible_by(I1, Interval) :- Mod is I1 mod Interval, Mod == 0, !, format("~d ", [I1]), flush_output(user). notify_number_if_divisible_by(_I1, _Interval). %------------------------------------------------------------------------------------ % Read a line from stream S and return Result as a list of characters. getline(S, Result) :- at_end_of_stream(S), !, Result = eof. getline(S, Result) :- getline1(S, Result). getline1(S, []) :- at_end_of_stream(S), !. getline1(S, Chars) :- get0(S, Char), getline2(Char, S, Chars). getline2(Char, _S, []) :- newline_char(Char), !. getline2(Char, S, [Char|Chars]) :- getline1(S, Chars). %------------------------------------------------------------------------------------ getline_as_words(S, Words) :- getline(S, Chars), split_string_into_words(Chars, Words). %------------------------------------------------------------------------------------ split_atom_into_words(Atom, Words) :- atom_codes(Atom, Chars), split_string_into_words(Chars, Words). split_atom_into_words(Atom, Char, Words) :- atom_codes(Atom, Chars), split_string_into_words(Chars, Char, Words). %------------------------------------------------------------------------------------ %split_string_into_words(String, Words) :- % split_string_into_words(String, 0' , Words). split_string_into_words(String, Words) :- split_string_into_words_at_whitespaces(String, Words). split_string_into_words_at_whitespaces([], Result) :- !, Result = []. split_string_into_words_at_whitespaces([F | R], Result) :- whitespace_char(F), !, split_string_into_words_at_whitespaces(R, Result). split_string_into_words_at_whitespaces(String, [FWord | RestWords]) :- split_off_non_whitespace_chars(String, FChars, RestString), atom_codes(FWord, FChars), !, split_string_into_words_at_whitespaces(RestString, RestWords). split_off_non_whitespace_chars([], [], []) :- !. split_off_non_whitespace_chars([F | R], [], [F | R]) :- whitespace_char(F), !. split_off_non_whitespace_chars([F | R], [F | RWordChars], RRest) :- !, split_off_non_whitespace_chars(R, RWordChars, RRest). %------------------------------------------------------------------------------------ split_string_into_words([], _Char, Result) :- !, Result = []. split_string_into_words(String, Char, [Word | Words]) :- split_off_first_word_from_string(String, Char, Word, RestString, EndedOnSeparatorP), ( ( EndedOnSeparatorP = ended_on_separator, RestString = [] ) -> Words = [''] ; RestString = [] -> Words = [] ; otherwise -> split_string_into_words(RestString, Char, Words) ). split_off_first_word_from_string(String, Char, Word, RestString, EndedOnSeparatorP) :- split_off_first_word_from_string1(String, Char, WordChars, RestString, EndedOnSeparatorP), atom_codes(Word, WordChars). split_off_first_word_from_string1([], _Char, [], [], didnt_end_on_separator) :- !. split_off_first_word_from_string1([Char | R], Char, [], R, ended_on_separator) :- !. split_off_first_word_from_string1([F | R], Char, [F | R1], RestString, EndedOnSeparatorP) :- split_off_first_word_from_string1(R, Char, R1, RestString, EndedOnSeparatorP). %------------------------------------------------------------------------------------ split_string_into_strings([], _Char, Result) :- !, Result = []. split_string_into_strings([Char, Char | String], Char, ["" | Strings]) :- !, split_string_into_strings([Char | String], Char, Strings). split_string_into_strings([Char | String], Char, Strings) :- !, split_string_into_strings(String, Char, Strings). split_string_into_strings(String, Char, [FirstString | Strings]) :- split_off_first_string_from_string(String, Char, FirstString, RestString), split_string_into_strings(RestString, Char, Strings). split_off_first_string_from_string([], _Char, [], []) :- !. split_off_first_string_from_string([Char | R], Char, [], [Char | R]) :- !. split_off_first_string_from_string([F | R], Char, [F | R1], RestString) :- split_off_first_string_from_string(R, Char, R1, RestString). %------------------------------------------------------------------------------------ atom_name_contains_string(Atom, SubAtom) :- atom_codes(Atom, String), atom_codes(SubAtom, SubString), is_contiguous_sublist(SubString, String), !. %------------------------------------------------------------------------------------ timed_call(Goal, TimeTaken) :- statistics(runtime, [StartTime, _]), call(Goal), statistics(runtime, [EndTime, _]), % Time returned is in milliseconds. TimeTaken is ( float(EndTime) - float(StartTime) ) / 1000.0. %------------------------------------------------------------------------------------ absolute_timed_call(Goal, TimeTaken) :- statistics(walltime, [StartTime, _]), call(Goal), statistics(walltime, [EndTime, _]), % Time returned is in milliseconds. TimeTaken is ( float(EndTime) - float(StartTime) ) / 1000.0. %------------------------------------------------------------------------------------ safe_call_saving_output(Goal, Status, OutputAtomList) :- on_exception(Exception, safe_call_saving_output1(Goal, Status, OutputAtomList), %( safe_call_saving_output1(Goal, Status), OutputAtomList = ['no output'] ), ( format('~N*** Internal error when performing: ~w', [safe_call_saving_output1(Goal, Status, OutputAtomList)]), print_message(error, Exception), format('~n', []), fail ) ), !. safe_call_saving_output(_Goal, error_saving_trace_output, []) :- !. safe_call_saving_output1(Goal, Status, OutputAtomList) :- get_tmp_trace_file(File), open(File, write, S), tell(S), safe_call_saving_output1(Goal, Status), told, read_file_to_atom_list(File, OutputAtomList), delete_file(File), length(OutputAtomList, NLines), format('--- Output (~d lines) saved to ~w~n', [NLines, File]), !. safe_call_saving_output1(Goal, Status) :- on_exception(Exception, ( call(Goal), Status = ok ), ( format('~N*** Error: ', []), print_message(error, Exception), format('~n', []), Status = error ) ), !. safe_call_saving_output1(_Goal, failed) :- !. /* For the above to work properly with output to stderr, you need to have this definition loaded somewhere. user:message_hook(Severity, _Message, Lines):- telling(MyStream), print_message_lines(MyStream, Severity, Lines). */ %------------------------------------------------------------------------------------ get_tmp_trace_file(File) :- random(1, 10000, N), format_to_atom('trace_~d.txt', [N], BaseFile), tmp_regulus_file(BaseFile, File). tmp_regulus_file(BaseFile, AbsFile) :- safe_absolute_file_name('$REGULUS/tmp', Dir), ( safe_directory_exists(Dir) -> true ; otherwise -> make_directory(Dir) ), format_to_atom('~w/~w', [Dir, BaseFile], AbsFile), !. tmp_regulus_file(BaseFile, AbsFile) :- format2error('~N*** Error: bad call: ~w~n', [tmp_regulus_file(BaseFile, AbsFile)]), fail. %------------------------------------------------------------------------------------ csv_fields_contain_word_ignoring_case(L, Keyword) :- member(Atom, L), atom(Atom), split_atom_into_words(Atom, Words), member(Word, Words), lowercase_atom(Word, Word1), Word1 = Keyword, !. %------------------------------------------------------------------------------------ %csv_file_to_list_of_lists(File, List) :- % read_file_to_atom_list(File, AtomList), % csv_atom_list_to_list_of_lists(AtomList, List). % %csv_atom_list_to_list_of_lists([], []). %csv_atom_list_to_list_of_lists([F | R], [F1 | R1]) :- % csv_atom_to_list(F, F1), % !, % csv_atom_list_to_list_of_lists(R, R1). % %csv_atom_to_list(Atom, List) :- % atom_codes(Atom, String), % csv_line(List, String, []), % !. %csv_atom_to_list(Atom, _List) :- % format('~N*** Error: bad line in CSV file: \'~w\'~n', [Atom]), % fail. csv_file_to_list_of_lists(File, List) :- csv_file_to_list_of_lists(File, 0'", 0',, List). %"' csv_file_to_list_of_lists(File, DelimiterChar, SeparatorChar, List) :- csv_file_to_list_of_lists(File, default_encoding, DelimiterChar, SeparatorChar, List). csv_file_to_list_of_lists(File, Encoding, DelimiterChar, SeparatorChar, List) :- check_csv_char(DelimiterChar, delimiter), check_csv_char(SeparatorChar, separator), csv_file_to_list_of_lists1(File, Encoding, DelimiterChar, SeparatorChar, List). check_csv_char(Char, Type) :- normal_csv_char(Char, Type), !. check_csv_char(Char, Type) :- integer(Char), format('~N*** Warning: unusual ~w char "~c" in call to csv_file_to_list_of_lists', [Type, Char]), !. check_csv_char(Char, Type) :- format('~N*** Error: bad ~w char "~w" in call to csv_file_to_list_of_lists', [Type, Char]), fail. normal_csv_char(0'", delimiter). %" normal_csv_char(0'\', delimiter). normal_csv_char(0',, separator). normal_csv_char(0';, separator). normal_csv_char(0' , separator). normal_csv_char(0'\t , separator). csv_file_to_list_of_lists1(File, Encoding, DelimiterChar, SeparatorChar, List) :- csv_file_to_string_list(File, Encoding, DelimiterChar, StringList), !, csv_string_list_to_list_of_lists(StringList, DelimiterChar, SeparatorChar, List). csv_file_to_string_list(File, Encoding, DelimiterChar, StringList) :- read_file_to_string(File, Encoding, String), csv_string_to_lines(String, DelimiterChar, StringList). csv_string_to_lines([], _DelimiterChar, []). csv_string_to_lines(String, DelimiterChar, [FirstLine | RestLines]) :- get_line_from_csv_string(String-StringNext, DelimiterChar, FirstLine), !, csv_string_to_lines(StringNext, DelimiterChar, RestLines). get_line_from_csv_string(StringIn-StringOut, DelimiterChar, Line) :- get_line_from_csv_string1(StringIn-StringOut, Line, DelimiterChar, not_inside_quotes), !. get_line_from_csv_string(StringIn-_StringOut, _DelimiterChar, _Line) :- format('~N*** Error: malformed line in CSV file: "~s"~n', [StringIn]), fail. get_line_from_csv_string1([]-[], [], _DelimiterChar, not_inside_quotes) :- !. get_line_from_csv_string1([NewlineChar | StringOut]-StringOut, [], _DelimiterChar, not_inside_quotes) :- newline_char(NewlineChar), !. get_line_from_csv_string1([DelimiterChar, DelimiterChar | StringNext]-StringOut, [DelimiterChar, DelimiterChar | LineRest], DelimiterChar, inside_quotes) :- !, get_line_from_csv_string1(StringNext-StringOut, LineRest, DelimiterChar, inside_quotes). get_line_from_csv_string1([DelimiterChar | StringNext]-StringOut, [DelimiterChar | LineRest], DelimiterChar, InsideQuotesIn) :- ( InsideQuotesIn = not_inside_quotes -> InsideQuotesNext = inside_quotes ; otherwise -> InsideQuotesNext = not_inside_quotes ), !, get_line_from_csv_string1(StringNext-StringOut, LineRest, DelimiterChar, InsideQuotesNext). get_line_from_csv_string1([F | StringNext]-StringOut, [F | LineRest], DelimiterChar, InsideQuotes) :- !, get_line_from_csv_string1(StringNext-StringOut, LineRest, DelimiterChar, InsideQuotes). get_line_from_csv_string1([]-[], [], _DelimiterChar, not_inside_quotes). csv_string_list_to_list_of_lists([], _DelimiterChar, _SeparatorChar, []). csv_string_list_to_list_of_lists([F | R], DelimiterChar, SeparatorChar, [F1 | R1]) :- csv_string_to_list(F, DelimiterChar, SeparatorChar, F1), !, csv_string_list_to_list_of_lists(R, DelimiterChar, SeparatorChar, R1). csv_string_to_list(String, DelimiterChar, SeparatorChar, List) :- csv_line(List, DelimiterChar, SeparatorChar, String, []), !. csv_string_to_list(String, _DelimiterChar, _SeparatorChar, _List) :- format('~N*** Error: bad line in CSV file: \'~s\'~n', [String]), fail. csv_line([F | R], DelimiterChar, SeparatorChar) --> csv_field(F, DelimiterChar, SeparatorChar), !, csv_line_rest(R, DelimiterChar, SeparatorChar). csv_line_rest(List, DelimiterChar, SeparatorChar) --> [SeparatorChar], !, csv_line(List, DelimiterChar, SeparatorChar). csv_line_rest([], _DelimiterChar, _SeparatorChar) --> []. csv_field(Atom, DelimiterChar, SeparatorChar) --> [DelimiterChar], !, non_double_quote_char_string(Chars, DelimiterChar, SeparatorChar), [DelimiterChar], {atom_codes(Atom, Chars)}. csv_field(Atom, DelimiterChar, SeparatorChar) --> non_comma_char_string(Chars, DelimiterChar, SeparatorChar), {atom_codes(Atom, Chars)}. non_double_quote_char_string([DelimiterChar | R], DelimiterChar, SeparatorChar) --> [DelimiterChar, DelimiterChar], !, non_double_quote_char_string(R, DelimiterChar, SeparatorChar). non_double_quote_char_string([F | R], DelimiterChar, SeparatorChar) --> [F], {F \== DelimiterChar}, !, non_double_quote_char_string(R, DelimiterChar, SeparatorChar). non_double_quote_char_string([], _DelimiterChar, _SeparatorChar) --> []. non_comma_char_string([F | R], _DelimiterChar, SeparatorChar) --> [F], {F \== SeparatorChar}, !, non_comma_char_string(R, _DelimiterChar, SeparatorChar). non_comma_char_string([], _DelimiterChar, _SeparatorChar) --> []. %csv_atom_to_list(Atom, List) :- % atom_codes(Atom, String), % remove_quotes_in_string(String, String1), % split_string_into_words(String1, 0',, List). % %remove_quotes_in_string([], []). %remove_quotes_in_string([0'" | R], R1) :- %" To keep Emacs happy % !, % remove_quotes_in_string(R, R1). %remove_quotes_in_string([F | R], [F | R1]) :- % !, % remove_quotes_in_string(R, R1). %------------------------------------------------------- concatenate_headed_csv_files(Files, OutFile) :- concatenate_headed_csv_files(Files, default_encoding, OutFile). concatenate_headed_csv_files(Files, Encoding, OutFile) :- safe_absolute_file_name(OutFile, AbsOutFile), read_headed_csv_files(Files, Encoding, Lists, Headers), sort(Headers, SortedHeaders), ( SortedHeaders = [Header] -> true ; format('~N*** Error in concatenate_headed_csv_files: different headers: ~w~n', [SortedHeaders]), fail ), append_list(Lists, List), length(List, N), list_of_lists_to_csv_file([Header | List], AbsOutFile, Encoding), format('~N--- Written concatenated CSV file (~d lines excluding header) ~w~n', [N, AbsOutFile]). read_headed_csv_files([], _Encoding, [], []). read_headed_csv_files([File | Files], Encoding, [List | Lists], [Header | Headers]) :- read_headed_csv_file(File, Encoding, List, Header), !, read_headed_csv_files(Files, Encoding, Lists, Headers). read_headed_csv_file(File, Encoding, List, Header) :- safe_absolute_file_name(File, AbsFile), csv_file_to_list_of_lists(AbsFile, Encoding, 0'", 0',, FullList), %"' ( FullList = [Header | List] -> length(List, N), format('~N--- Read headed CSV file (~d lines excluding header) ~w~n', [N, AbsFile]) ; format('~N*** Error in read_headed_csv_file: empty file: ~w~n', [AbsFile]), fail ). %------------------------------------------------------- remove_null_lines_from_csv_file(InFile, OutFile) :- remove_null_lines_from_csv_file(InFile, default_encoding, OutFile). remove_null_lines_from_csv_file(InFile, Encoding, OutFile) :- safe_absolute_file_name(InFile, AbsInFile), safe_absolute_file_name(OutFile, AbsOutFile), csv_file_to_list_of_lists(AbsInFile, Encoding, 0'", 0',, InList), %"' length(InList, InN), format('~N--- Read headed CSV file (~d lines) ~w~n', [InN, AbsInFile]), remove_null_lines_from_csv_list(InList, OutList), length(OutList, OutN), list_of_lists_to_csv_file(OutList, AbsOutFile, Encoding), format('~N--- Written headed CSV file (~d lines) ~w~n', [OutN, AbsOutFile]). remove_null_lines_from_csv_list([], []). remove_null_lines_from_csv_list([F | R], R1) :- null_csv_line(F), !, remove_null_lines_from_csv_list(R, R1). remove_null_lines_from_csv_list([F | R], [F | R1]) :- !, remove_null_lines_from_csv_list(R, R1). null_csv_line([]). null_csv_line(['' | R]) :- !, null_csv_line(R). %------------------------------------------------------- combine_columns_from_csv_files(InCSV1, InColumns1, InCSV2, InColumns2, OutCSV) :- safe_absolute_file_name(InCSV1, AbsInCSV1), safe_absolute_file_name(InCSV2, AbsInCSV2), safe_absolute_file_name(OutCSV, AbsOutCSV), csv_file_to_list_of_lists(AbsInCSV1, InList1), csv_file_to_list_of_lists(AbsInCSV2, InList2), length(InList1, InN1), length(InList2, InN2), ( InN1 = InN2 -> true ; otherwise -> format('~N*** Error in combine_columns_from_csvs/5: different numbers of records in input files.~n', []), fail ), combine_columns_from_csvs1(InList1, InColumns1, InList2, InColumns2, OutList), list_of_lists_to_csv_file(OutList, AbsOutCSV), !. combine_columns_from_csv_files(InCSV1, InColumns1, InCSV2, InColumns2, OutCSV) :- format('~N*** Error: bad call: ~w~n', [combine_columns_from_csv_files(InCSV1, InColumns1, InCSV2, InColumns2, OutCSV)]), fail. combine_columns_from_csvs1([], _InColumns1, [], _InColumns2, []). combine_columns_from_csvs1([F | R], InColumns1, [F1 | R1], InColumns2, [F2 | R2]) :- combine_columns_from_csvs_records(F, InColumns1, F1, InColumns2, F2), !, combine_columns_from_csvs1(R, InColumns1, R1, InColumns2, R2). combine_columns_from_csvs_records(F, InColumns1, F1, InColumns2, OutColumns) :- extract_columns_from_csv_record(F, InColumns1, Columns1), extract_columns_from_csv_record(F1, InColumns2, Columns2), append(Columns1, Columns2, OutColumns), !. combine_columns_from_csvs_records(F, InColumns1, F1, InColumns2, F2) :- format('~N*** Error: bad call: ~w~n', [combine_columns_from_csvs_records(F, InColumns1, F1, InColumns2, F2)]), fail. extract_columns_from_csv_record([], _AllColumns, []). extract_columns_from_csv_record([F | R], AllColumns, [F1 | R1]) :- safe_nth(F, AllColumns, F1), !, extract_columns_from_csv_record(R, AllColumns, R1). %------------------------------------------------------------------------------------ list_of_lists_to_csv_file(List, File) :- list_of_lists_to_csv_file(List, File, default_encoding), !. list_of_lists_to_csv_file(List, File, Encoding) :- list_of_lists_to_csv_file(List, File, 0',, Encoding). list_of_lists_to_csv_file(List, File, SeparatorChar, Encoding) :- list_of_atom_lists_to_csv_atom_list(List, SeparatorChar, AtomList), write_atom_list_to_unicode_file(AtomList, File, Encoding), !. list_of_lists_to_csv_file(List, File, SeparatorChar, Encoding) :- format('~N*** Error: bad call: ~w~n', [list_of_lists_to_csv_file(List, File, SeparatorChar, Encoding)]), fail. list_of_atom_lists_to_csv_atom_list([], _SeparatorChar, []). list_of_atom_lists_to_csv_atom_list([F | R], SeparatorChar, [F1 | R1]) :- atom_list_to_csv_atom(F, SeparatorChar, F1), !, list_of_atom_lists_to_csv_atom_list(R, SeparatorChar, R1). atom_list_to_csv_atom(List, SeparatorChar, Atom) :- ( is_atom_list(List) -> put_quotes_around_atoms(List, List1), append_atoms(List1, SeparatorChar, Atom) ; otherwise -> format('~N*** Error: bad item in list in call to list_of_lists_to_csv_file/2: ~w~n', [List]), fail ). is_atom_list(List) :- is_list(List), is_atom_list1(List). is_atom_list1([]). is_atom_list1([F | R]) :- atom(F), !, is_atom_list1(R). put_quotes_around_atoms([], []). put_quotes_around_atoms([F | R], [F1 | R1]) :- put_quotes_around_atom(F, F1), !, put_quotes_around_atoms(R, R1). put_quotes_around_atom(Atom, AtomWithQuotes) :- atom_codes(Atom, Str), double_any_quotes(Str, Str1), format_to_atom('"~s"', [Str1], AtomWithQuotes). double_any_quotes([], []). double_any_quotes([0'" | R], [0'", 0'" | R1]) :- %" !, double_any_quotes(R, R1). double_any_quotes([F | R], [F | R1]) :- !, double_any_quotes(R, R1). %------------------------------------------------------------------------------------ write_atom_list_to_file(AtomsList, File) :- open(File, write, S), write_atom_list_to_file1(AtomsList, S), close(S). write_atom_list_to_unicode_file(AtomsList, File) :- write_atom_list_to_unicode_file(AtomsList, File, 'UTF-8'). write_atom_list_to_unicode_file(AtomsList, File, default_encoding) :- !, write_atom_list_to_file(AtomsList, File). write_atom_list_to_unicode_file(AtomsList, File, Encoding) :- open(File, write, S, [encoding(Encoding)]), write_atom_list_to_file1(AtomsList, S), close(S). write_atom_list_to_file1([], _S). write_atom_list_to_file1([F | R], S) :- format(S, '~N~w~n', [F]), !, write_atom_list_to_file1(R, S). %------------------------------------------------------------------------------------ write_string_list_to_unicode_file(StringsList, File) :- write_string_list_to_unicode_file(StringsList, File, 'UTF-8'). write_string_list_to_unicode_file(StringsList, File, Encoding) :- open(File, write, S, [encoding(Encoding)]), write_string_list_to_file1(StringsList, S), close(S). write_string_list_to_file1([], _S). write_string_list_to_file1([F | R], S) :- format(S, '~N~s~n', [F]), !, write_string_list_to_file1(R, S). %------------------------------------------------------------------------------------ write_atom_list_to_stream(S, List) :- write_atom_list_to_stream(S, List, ' '). write_atom_list_to_stream(_S, [], _Separator) :- !. write_atom_list_to_stream(S, [F], _Separator) :- !, format(S, '~w', [F]). write_atom_list_to_stream(S, [F|R], Separator) :- format(S, '~w~w', [F, Separator]), write_atom_list_to_stream(S, R, Separator). %------------------------------------------------------------------------------------ html_table_file_to_list(File, List) :- html_table_file_to_list(File, List, default_encoding). html_table_file_to_list(File, List, Encoding) :- read_file_to_string(File, Encoding, String), xml_parse(String, Doc), ( xml_subterm(Doc, element(tbody, _, TableBody)) ; xml_subterm(Doc, element(table, _, TableBody)) ), resolve_pcdata_attribs_tr_and_td_in_xml(TableBody, List). resolve_pcdata_attribs_tr_and_td_in_xml(Atom, Atom) :- atomic(Atom), !. resolve_pcdata_attribs_tr_and_td_in_xml(pcdata(Str), Atom) :- atom_codes(Atom, Str), !. resolve_pcdata_attribs_tr_and_td_in_xml(Key=Str, Key=Atom) :- atom_codes(Atom, Str), !. resolve_pcdata_attribs_tr_and_td_in_xml(Term, TermOut) :- functor(Term, F, N), functor(Term1, F, N), resolve_pcdata_attribs_tr_and_td_in_xml_args(N, Term, Term1), resolve_tr_and_td(Term1, TermOut). resolve_pcdata_attribs_tr_and_td_in_xml_args(I, _Term, _Term1) :- I < 1, !. resolve_pcdata_attribs_tr_and_td_in_xml_args(I, Term, Term1) :- arg(I, Term, Arg), arg(I, Term1, Arg1), resolve_pcdata_attribs_tr_and_td_in_xml(Arg, Arg1), I1 is I - 1, !, resolve_pcdata_attribs_tr_and_td_in_xml_args(I1, Term, Term1). resolve_tr_and_td(element(tr, _, Body), Body) :- !. resolve_tr_and_td(element(td, _, []), []) :- !. resolve_tr_and_td(element(td, _, [Body]), Body) :- !. resolve_tr_and_td(Other, Other). %------------------------------------------------------------------------------------ append_n_copies(N, L, L1) :- integer(N), N >= 0, is_list(L), append_n_copies1(N, [], L, L1). append_n_copies1(0, In, _L, In) :- !. append_n_copies1(I, In, L, Out) :- I >= 0, append(In, L, Next), I1 is I - 1, !, append_n_copies1(I1, Next, L, Out). %------------------------------------------------------------------------------------ join_with_spaces(Atoms, Result) :- append_atoms(Atoms, 0' , Result). join_with_underscore(Atoms, Result) :- append_atoms(Atoms, 0'_, Result). append_atoms([Atom], _Separator, Atom) :- !. append_atoms([F | R], Separator, Atom) :- append_atoms(R, Separator, RAtom), atom_or_number_codes(F, FChars), atom_or_number_codes(RAtom, RChars), append(FChars, [Separator | RChars], AllChars), atom_codes(Atom, AllChars). append_atoms([], _Separator, ''). append_atoms([Atom], Atom) :- !. append_atoms([F | R], Atom) :- append_atoms(R, RAtom), atom_or_number_codes(F, FChars), atom_or_number_codes(RAtom, RChars), append(FChars, RChars, AllChars), atom_codes(Atom, AllChars). append_atoms([], ''). atom_or_number_codes(Atom, Chars) :- atom(Atom), !, atom_codes(Atom, Chars). atom_or_number_codes(Number, Chars) :- number(Number), !, safe_number_codes(Number, Chars). %------------------------------------------------------------------------------------ append_strings_with_char([], _Separator, "") :- !. append_strings_with_char([String], _Separator, String) :- !. append_strings_with_char([F | R], Separator, String) :- append_strings_with_char(R, Separator, RString), append(F, [Separator | RString], String), !. %------------------------------------------------------------------------------------ term_contains_functor(T, F/N) :- nonvar(T), functor(T, F, N), !. term_contains_functor(T, F/N) :- nonvar(T), functor(T, _F1, N1), term_contains_functor_args(N1, T, F/N), !. term_contains_functor_args(I, T, F/N) :- I > 0, arg(I, T, Arg), term_contains_functor(Arg, F/N), !. term_contains_functor_args(I, T, F/N) :- I > 1, I1 is I - 1, !, term_contains_functor_args(I1, T, F/N). %------------------------------------------------------------------------------------ term_contains_subterm(T, Subterm) :- safe_subsumes_chk(Subterm, T), !. term_contains_subterm(T, Subterm) :- nonvar(T), functor(T, _F1, N1), term_contains_subterm_args(N1, T, Subterm), !. term_contains_subterm_args(I, T, Subterm) :- I > 0, arg(I, T, Arg), term_contains_subterm(Arg, Subterm), !. term_contains_subterm_args(I, T, Subterm) :- I > 1, I1 is I - 1, !, term_contains_subterm_args(I1, T, Subterm). %------------------------------------------------------------------------------------ identical_up_to_variable_renaming(X, Y) :- safe_subsumes_chk(X, Y), safe_subsumes_chk(Y, X), !. %------------------------------------------------------------------------------------ substitute_in_term(T, From, To, T1) :- T == From, !, T1 = To. substitute_in_term(T, _From, _To, T) :- ( var(T) ; atomic(T) ), !. substitute_in_term(T, From, To, T1) :- compound(T), functor(T, F, N), functor(T1, F, N), substitute_in_term_args(N, T, From, To, T1). substitute_in_term_args(0, _T, _From, _To, _T1) :- !. substitute_in_term_args(I, T, From, To, T1) :- I > 0, arg(I, T, Arg), arg(I, T1, Arg1), substitute_in_term(Arg, From, To, Arg1), I1 is I - 1, !, substitute_in_term_args(I1, T, From, To, T1). %------------------------------------------------------------------------------------ read_prolog_file_and_assert_goals(File, Package) :- safe_prolog_file_to_list_printing_statistics(File, List), assert_list_of_goals(List, Package), !. %------------------------------------------------------------------------------------ assert_list_of_goals(List, Package) :- ( ( atom(Package), is_list_of_compounds_or_atoms(List) ) -> assert_list_of_goals1(List, Package) ; otherwise -> format('~N*** Error: bad call: ~w~n', [assert_list_of_goals(List, Package)]) ). assert_list_of_goals1([], _Package). assert_list_of_goals1([F | R], Package) :- assertz(Package:F), !, assert_list_of_goals1(R, Package). is_list_of_compounds_or_atoms(List) :- is_list(List), is_list_of_compounds_or_atoms1(List). is_list_of_compounds_or_atoms1([]). is_list_of_compounds_or_atoms1([F | R]) :- ( compound(F) ; atom(F) ), is_list_of_compounds_or_atoms1(R). %------------------------------------------------------------------------------------ append_list([], []). append_list([F | R], Result) :- append_list(R, Result1), append(F, Result1, Result). %------------------------------------------------------------------------------------ is_substring(Substring, String) :- safe_prefix(Substring, String), !. is_substring(Substring, [_F | R]) :- !, is_substring(Substring, R). %------------------------------------------------------------------------------------ remove_dups_preserving_order([], _AlreadySeen, []). remove_dups_preserving_order([F | R], AlreadySeen, R1) :- id_member(F, AlreadySeen), !, remove_dups_preserving_order(R, AlreadySeen, R1). remove_dups_preserving_order([F | R], AlreadySeen, [F | R1]) :- !, remove_dups_preserving_order(R, [F | AlreadySeen], R1). %------------------------------------------------------------------------------------ flatten(X, [X]) :- var(X), !. flatten([], []) :- !. flatten([F | R], Out) :- flatten(F, F1), flatten(R, R1), append(F1, R1, Out), !. flatten(A, [A]). %--------------------------------------------------------------- firstn_or_all([], _MaxN, []) :- !. firstn_or_all(_List, 0, []) :- !. firstn_or_all([F | R], MaxN, [F | R1]) :- MaxN > 0, MaxN1 is MaxN - 1, !, firstn_or_all(R, MaxN1, R1). %--------------------------------------------------------------- split_off_firstn([], _N, [], []) :- !. split_off_firstn(List, N, [], List) :- N =< 0, !. split_off_firstn([F | R], N, [F | R1], Remaining) :- N > 0, N1 is N - 1, !, split_off_firstn(R, N1, R1, Remaining). %--------------------------------------------------------------- length_of_curly_bracket_list({}, Length) :- !, Length = 0. length_of_curly_bracket_list('{}'(CommaList), Length) :- length_of_comma_list(CommaList, 0-Length1), !, Length = Length1. length_of_curly_bracket_list(X, Y) :- format('~N*** Error: bad call: ~w.~n', [length_of_curly_bracket_list(X, Y)]), fail. length_of_comma_list((_F, R), In-Out) :- !, Next is In + 1, length_of_comma_list(R, Next-Out). length_of_comma_list(_Other, In-Out) :- Out is In + 1. %--------------------------------------------------------------- curly_bracket_list_to_list('{}', []). curly_bracket_list_to_list('{}'(L), L1) :- comma_list_to_list(L, L1). %------------------------------------------------------------------------------------ comma_list_to_list(V, [V]) :- var(V), !. comma_list_to_list((F, R), [F | R1]) :- !, comma_list_to_list(R, R1). comma_list_to_list(LastElt, [LastElt]). %------------------------------------------------------------------------------------ flatten_comma_list(CommaListIn, CommaListOut) :- comma_list_to_list_recursive(CommaListIn, List), flatten(List, ListOut), list_to_comma_list(ListOut, CommaListOut). comma_list_to_list_recursive(V, [V]) :- var(V), !. comma_list_to_list_recursive((F, R), [F1 | R1]) :- !, comma_list_to_list_recursive(F, F1), comma_list_to_list(R, R1). comma_list_to_list_recursive(LastElt, [LastElt]). %------------------------------------------------------------------------------------ is_comma_list(List) :- compound(List), functor(List, ',', 2). %------------------------------------------------------------------------------------ is_curly_bracket_list(List) :- compound(List), functor(List, '{}', 1). %------------------------------------------------------------------------------------ list_to_curly_bracket_list([], '{}') :- !. list_to_curly_bracket_list(List, '{}'(CommaList)) :- list_to_comma_list(List, CommaList). %------------------------------------------------------------------------------------ list_to_comma_list([], _) :- raise_exception('Attempt to convert empty list to comma list'). list_to_comma_list([X], X) :- !. list_to_comma_list([F | R], (F, R1)) :- list_to_comma_list(R, R1). %------------------------------------------------------------------------------------ unkey_list([], []). unkey_list([_Key-F | R], [F | R1]) :- unkey_list(R, R1). %------------------------------------------------------------------------------------ first_elements_of_pairs([], []). first_elements_of_pairs([[X, _Y] | R], [X | R1]) :- !, first_elements_of_pairs(R, R1). second_elements_of_pairs([], []). second_elements_of_pairs([[_X, Y] | R], [Y | R1]) :- !, second_elements_of_pairs(R, R1). %------------------------------------------------------------------------------------ normalise_prolog_dcg_clause_to_c_version((H :- B), (H1 :- B1)) :- H1 = H, normalise_prolog_dcg_clause_body_to_c_version(B, B1), !. normalise_prolog_dcg_clause_to_c_version(X, Y) :- regulus_error('~NBad call: ~w~n', [normalise_prolog_dcg_clause_to_c_version(X, Y)]). normalise_prolog_dcg_clause_body_to_c_version(Var, Var) :- var(Var), !. normalise_prolog_dcg_clause_body_to_c_version((P, Q), (P1, Q1)) :- !, normalise_prolog_dcg_clause_body_to_c_version(P, P1), normalise_prolog_dcg_clause_body_to_c_version(Q, Q1). normalise_prolog_dcg_clause_body_to_c_version((P ; Q), (P1 ; Q1)) :- !, normalise_prolog_dcg_clause_body_to_c_version(P, P1), normalise_prolog_dcg_clause_body_to_c_version(Q, Q1). normalise_prolog_dcg_clause_body_to_c_version((In = Out), Result) :- var(In), compound(Out), Out = [Word | Rest], atom(Word), var(Rest), !, Result = 'C'(In, Word, Rest). normalise_prolog_dcg_clause_body_to_c_version(Other, Other). %------------------------------------------------------------------------------------ remove_duplicates_from_sorted_file(InFile, OutFile) :- open(InFile, read, SIn), open(OutFile, write, SOut), remove_duplicates_from_sorted_file1(SIn, SOut, '*dummy*'), close(SIn), close(SOut). remove_duplicates_from_sorted_file1(SIn, SOut, LastTerm) :- read(SIn, Term), remove_duplicates_from_sorted_file2(Term, SIn, SOut, LastTerm). remove_duplicates_from_sorted_file2(end_of_file, _SIn, _SOut, _LastTerm) :- !. remove_duplicates_from_sorted_file2(Term, SIn, SOut, LastTerm) :- Term = LastTerm, !, remove_duplicates_from_sorted_file1(SIn, SOut, Term). remove_duplicates_from_sorted_file2(Term, SIn, SOut, _LastTerm) :- format(SOut, '~N~q.~n', [Term]), !, remove_duplicates_from_sorted_file1(SIn, SOut, Term). %------------------------------------------------------------------------------------ id_member(X, [F | _R]) :- X == F, !. id_member(X, [_F | R]) :- id_member(X, R). %---------------------------------------------------------------------- pick_n_random_members_from_list(N, List, List1) :- length(List, Length), ( N =< Length -> true ; otherwise -> format('~N*** Error: bad call to pick_n_random_members_from_list/3: list contains ~d members, trying to find ~d random members~n', [Length, N]), fail ), random_permutation(List, RandomisedList), prefix_length(RandomisedList, List1, N), !. pick_n_random_members_from_list(N, List, List1) :- format('~N*** Error: bad call: ~w~n', [pick_n_random_members_from_list(N, List, List1)]), fail. pick_n_random_members_from_list(N, List, List1, Rest) :- length(List, Length), ( N =< Length -> true ; otherwise -> format('~N*** Error: bad call to pick_n_random_members_from_list/3: list contains ~d members, trying to find ~d random members~n', [Length, N]), fail ), random_permutation(List, RandomisedList), prefix_length(RandomisedList, List1, N), append(List1, Rest, RandomisedList), !. pick_n_random_members_from_list(N, List, List1, Rest) :- format('~N*** Error: bad call: ~w~n', [pick_n_random_members_from_list(N, List, List1, Rest)]), fail. %---------------------------------------------------------------------- assoc_generics_to_lists_in_term(Var, Var) :- var(Var), !. assoc_generics_to_lists_in_term(X, X) :- atomic(X), !. assoc_generics_to_lists_in_term(Assoc, List) :- is_assoc_generic(Assoc), !, assoc_generic_to_list(Assoc, List). assoc_generics_to_lists_in_term(T, T1) :- compound(T), functor(T, F, N), functor(T1, F, N), assoc_generics_to_lists_in_term_args(N, T, T1). assoc_generics_to_lists_in_term_args(I, _T, _T1) :- I < 1. assoc_generics_to_lists_in_term_args(I, T, T1) :- I >= 1, arg(I, T, Arg), arg(I, T1, Arg1), assoc_generics_to_lists_in_term(Arg, Arg1), I1 is I - 1, !, assoc_generics_to_lists_in_term_args(I1, T, T1). %---------------------------------------------------------------------- inc_assoc_generic(AssocIn, Key, AssocOut) :- get_assoc_generic_or_zero(Key, AssocIn, OldVal), number(OldVal), NewVal is OldVal + 1, put_assoc_generic(Key, AssocIn, NewVal, AssocOut), !. inc_assoc_generic(AssocIn, Key, AssocOut) :- format('~N*** Error: bad call: ~w~n', [inc_assoc_generic(AssocIn, Key, AssocOut)]), fail. %---------------------------------------------------------------------- inc_assoc_generic(AssocIn, Key, Increment, AssocOut) :- get_assoc_generic_or_zero(Key, AssocIn, OldVal), number(OldVal), NewVal is OldVal + Increment, put_assoc_generic(Key, AssocIn, NewVal, AssocOut), !. inc_assoc_generic(AssocIn, Key, Increment, AssocOut) :- format('~N*** Error: bad call: ~w~n', [inc_assoc_generic(AssocIn, Key, Increment, AssocOut)]), fail. %---------------------------------------------------------------------- get_assoc_generic_or_zero(Key, Assoc, Val) :- get_assoc_generic(Key, Assoc, Val), !. get_assoc_generic_or_zero(_Key, _Assoc, Val) :- Val = 0, !. %--------------------------------------------------------------- list_to_ordered_multiset([], []) :- !. list_to_ordered_multiset(List, MultiSet) :- add_unique_tags_to_list(List, TaggedList, 0), sort(TaggedList, SortedList), SortedList = [tag(SortedListFirst, _) | SortedListRest], sorted_list_to_multiset(SortedListRest, MultiSet0, 1-SortedListFirst), keysort(MultiSet0, MultiSet1), reverse(MultiSet1, MultiSet). add_unique_tags_to_list([], [], _N) :- !. add_unique_tags_to_list([F | R], [tag(F, I) | R1], I) :- I1 is I + 1, !, add_unique_tags_to_list(R, R1, I1). sorted_list_to_multiset([], [N-LastItem], N-LastItem) :- !. sorted_list_to_multiset([tag(F, _) | R], MultiSet, N-CurrentItem) :- F == CurrentItem, N1 is N + 1, !, sorted_list_to_multiset(R, MultiSet, N1-CurrentItem). sorted_list_to_multiset([tag(F, _) | R], [(N-CurrentItem) | MultiSet], N-CurrentItem) :- !, sorted_list_to_multiset(R, MultiSet, 1-F). %------------------------------------------------------------------------------------ % L1 and L2 are lists. Returns the number of insertions, deletions and substitutions % needed to turn L2 into L1. Also works for atoms representing lists of words. % i_d_s_tmp(Pos1, Pos2, Total, I, D, S, MatchList) % % The best match between L1 up to Pos1 and L2 up to Pos2 % involves Total (I, D, S) insertions, deletions and substitutions, encoded as MatchList :- dynamic i_d_s_tmp/7. insertions_deletions_substitutions(A1, A2, Total, I, D, S) :- insertions_deletions_substitutions(A1, A2, Total, I, D, S, no_matches, _Matches). insertions_deletions_substitutions_and_matches(A1, A2, Total, I, D, S, Matches) :- insertions_deletions_substitutions(A1, A2, Total, I, D, S, matches, Matches). insertions_deletions_substitutions(A1, A2, Total, I, D, S, MatchesP, Matches) :- atom(A1), atom(A2), split_atom_into_words(A1, L1), split_atom_into_words(A2, L2), insertions_deletions_substitutions(L1, L2, Total, I, D, S, MatchesP, Matches), !. insertions_deletions_substitutions(L1, L2, Total, I, D, S, MatchesP, Matches) :- is_list(L1), is_list(L2), init_insertions_deletions_substitutions, length(L1, LastPos1), length(L2, LastPos2), N is LastPos1 + LastPos2, insertions_deletions_substitutions1(1, N, LastPos1, LastPos2, L1, L2, MatchesP), i_d_s_tmp(LastPos1, LastPos2, Total, I, D, S, Matches0), reverse(Matches0, Matches), !. insertions_deletions_substitutions(L1, L2, Total, I, D, S, Matches) :- format('~N*** Error: bad call: ~w.~n', [insertions_deletions_substitutions(L1, L2, Total, I, D, S, Matches)]), fail. init_insertions_deletions_substitutions :- retractall(i_d_s_tmp(_Pos1, _Pos2, _Total, _I, _D, _S, _M)), assertz(i_d_s_tmp(0, 0, 0, 0, 0, 0, [])), !. insertions_deletions_substitutions1(I, N, _LastPos1, _LastPos2, _L1, _L2, _MatchesP) :- I > N, !. insertions_deletions_substitutions1(I, N, LastPos1, LastPos2, L1, L2, MatchesP) :- I =< N, insertions_deletions_substitutions2(0, I, LastPos1, LastPos2, L1, L2, MatchesP), I1 is I + 1, !, insertions_deletions_substitutions1(I1, N, LastPos1, LastPos2, L1, L2, MatchesP). insertions_deletions_substitutions2(Pos1, I, _LastPos1, _LastPos2, _L1, _L2, _MatchesP) :- Pos1 > I, !. insertions_deletions_substitutions2(Pos1, I, LastPos1, LastPos2, L1, L2, MatchesP) :- Pos1 =< I, Pos2 is I - Pos1, insertions_deletions_substitutions3(Pos1, Pos2, LastPos1, LastPos2, L1, L2, MatchesP), Pos1Next is Pos1 + 1, !, insertions_deletions_substitutions2(Pos1Next, I, LastPos1, LastPos2, L1, L2, MatchesP). insertions_deletions_substitutions3(Pos1, Pos2, LastPos1, LastPos2, _L1, _L2, _MatchesP) :- ( Pos1 > LastPos1 ; Pos2 > LastPos2 ), !. insertions_deletions_substitutions3(Pos1, Pos2, _LastPos1, _LastPos2, L1, L2, MatchesP) :- insertion_score(Pos1, Pos2, L1, L2, InsTotal-[InsI, InsD, InsS, InsMatches], MatchesP), deletion_score(Pos1, Pos2, L1, L2, DelTotal-[DelI, DelD, DelS, DelMatches], MatchesP), substitution_score(Pos1, Pos2, L1, L2, SubTotal-[SubI, SubD, SubS, SubMatches], MatchesP), best_i_d_s_score(InsTotal-[InsI, InsD, InsS, InsMatches], DelTotal-[DelI, DelD, DelS, DelMatches], SubTotal-[SubI, SubD, SubS, SubMatches], BestTotal-[BestI, BestD, BestS, BestMatches]), assertz(i_d_s_tmp(Pos1, Pos2, BestTotal, BestI, BestD, BestS, BestMatches)). best_i_d_s_score(InsTotal-InsInfo, DelTotal-DelInfo, SubTotal-SubInfo, BestTotal-BestInfo) :- keysort([InsTotal-InsInfo, DelTotal-DelInfo, SubTotal-SubInfo], SortedList), SortedList = [BestTotal-BestInfo | _Rest], !. % We can't insert to reach position 0 insertion_score(Pos1, _Pos2, _L1, _L2, Total-[I, D, S, M], _MatchP) :- Pos1 = 0, impossible_score(Total-[I, D, S, M]), !. insertion_score(Pos1, Pos2, L1, _L2, Total-[I, D, S, M], MatchesP) :- Pos1Minus1 is Pos1 - 1, i_d_s_tmp(Pos1Minus1, Pos2, _NextTotal, NextI, NextD, NextS, NextM), I is NextI + 1, D is NextD, S is NextS, Total is I + D + S, ( MatchesP = matches -> safe_nth(Pos1, L1, Word1), M = [ins(Word1) | NextM] ; otherwise -> M = [] ), !. % We can't delete from position 0 deletion_score(_Pos1, Pos2, _L1, _L2, Total-[I, D, S, M], _MatchesP) :- Pos2 = 0, impossible_score(Total-[I, D, S, M]), !. deletion_score(Pos1, Pos2, _L1, L2, Total-[I, D, S, M], MatchesP) :- Pos2Minus1 is Pos2 - 1, i_d_s_tmp(Pos1, Pos2Minus1, _NextTotal, NextI, NextD, NextS, NextM), I is NextI, D is NextD + 1, S is NextS, Total is I + D + S, ( MatchesP = matches -> safe_nth(Pos2, L2, Word2), M = [del(Word2) | NextM] ; otherwise -> M = [] ), !. % We can't substitute if either string is at position 0 substitution_score(Pos1, Pos2, _L1, _L2, Total-[I, D, S, M], _MatchesP) :- ( Pos1 = 0 ; Pos2 = 0 ), impossible_score(Total-[I, D, S, M]), !. substitution_score(Pos1, Pos2, L1, L2, Total-[I, D, S, M], MatchesP) :- Pos1Minus1 is Pos1 - 1, Pos2Minus1 is Pos2 - 1, safe_nth(Pos1, L1, Word1), safe_nth(Pos2, L2, Word2), i_d_s_tmp(Pos1Minus1, Pos2Minus1, _NextTotal, NextI, NextD, NextS, NextM), I is NextI, D is NextD, ( Word1 = Word2 -> S is NextS, ( MatchesP = matches -> M = [same(Word1) | NextM] ; otherwise -> M = [] ) ; otherwise -> S is NextS + 1, ( MatchesP = matches -> M = [sub(Word1, Word2) | NextM] ; otherwise -> M = [] ) ), Total is I + D + S, !. impossible_score(3000-[1000, 1000, 1000, []]). %--------------------------------------------------------------- make_ground(Term) :- numbervars(Term, 0, _). %--------------------------------------------------------------- var_or_grounded_var(X) :- var(X), !. var_or_grounded_var(X) :- compound(X), functor(X, '$VAR', 1). %------------------------------------------------------------------------------------ no_vars_or_grounded_vars_in_term(X) :- var_or_grounded_var(X), !, fail. no_vars_or_grounded_vars_in_term(Atom) :- atomic(Atom), !. no_vars_or_grounded_vars_in_term(Term) :- compound(Term), functor(Term, _F, N), no_vars_or_grounded_vars_in_term_args(N, Term). no_vars_or_grounded_vars_in_term_args(I, _Term) :- I < 1, !. no_vars_or_grounded_vars_in_term_args(I, Term) :- I >= 1, arg(I, Term, Arg), no_vars_or_grounded_vars_in_term(Arg), I1 is I - 1, !, no_vars_or_grounded_vars_in_term_args(I1, Term). %------------------------------------------------------------------------------------ % Assume we'll never have more than 255 distinct variables % in something we need to make unground... would be better % in principle to use an assoc, but this code needs to be % fast. unground(T, T1) :- %empty_assoc(Assoc), functor(Assoc, table, 255), unground1(T, T1, Assoc). unground1(V, V, _Assoc) :- var(V), !. unground1(A, A, _Assoc) :- atomic(A), !. unground1('$VAR'(N), V, Assoc) :- !, %( ( N < 0 ; N > 499 ) -> ( ( N < 0 ; N > 254 ) -> raise_exception(internal_error_in_make_unground(N)) ; N1 is N + 1, arg(N1, Assoc, V) ). unground1(T, T1, Assoc) :- functor(T, F, N), functor(T1, F, N), unground1_args(N, T, T1, Assoc). unground1_args(0, _T, _T1, _Assoc). unground1_args(I, T, T1, Assoc) :- I > 0, arg(I, T, Arg), arg(I, T1, Arg1), unground1(Arg, Arg1, Assoc), I1 is I - 1, unground1_args(I1, T, T1, Assoc). %------------------------------------------------------------------------------------ % Stuff from Stanford parser try(A) :- A, !. try(_). /* assert_general(A) :- \+ A, !, assert(A). assert_general(A) :- numbervars(A, 0, _), A, !, fail. assert_general(A) :- copy_term(A,A1), clause(A1,true,Ref), clause(A2,true,Ref), numbervars(A2,0,_), A = A2, erase_safe(clause(A2,true,Ref),Ref), fail. assert_general(A) :- assert(A). */ numbervars(Term, _Marker, In, Out):- numbervars(Term, In, Out). %------------------------------------------------------------------------------------ is_list_of_atoms(List) :- nonvar(List), is_list_of_atoms1(List). is_list_of_atoms1([]). is_list_of_atoms1([F | R]) :- atomic(F), !, is_list_of_atoms1(R). %------------------------------------------------------------------------------------ align_word_atoms_for_printing(Atoms, Method, Atoms1) :- ( member(Method, [tabs, spaces]) -> on_exception(_Exception, align_word_atoms_for_printing1(Atoms, Method, Atoms1), fail ) ; otherwise -> format('~N*** Error: bad call: ~w~n', [align_word_atoms_for_printing(Atoms, Method, Atoms1)]), format('~N*** second arg must be one of [tabs, spaces]~n', []), fail ). align_word_atoms_for_printing1(Atoms, Method, Atoms1) :- split_atoms_in_list(Atoms, SplitAtoms), align_atom_lists_for_printing(SplitAtoms, Method, SplitAtoms1), join_atoms_in_list(SplitAtoms1, Atoms1). split_atoms_in_list([], []). split_atoms_in_list([F | R], [F1 | R1]) :- split_atom_into_words(F, F1), !, split_atoms_in_list(R, R1). align_atom_lists_for_printing(List, _Method, List) :- all_empty_lists(List), !. align_atom_lists_for_printing(List, Method, List1) :- first_and_rest_on_list(List, Firsts, Rests), align_atoms_for_printing(Firsts, Method, Firsts1), align_atom_lists_for_printing(Rests, Method, Rests1), first_and_rest_on_list(List1, Firsts1, Rests1). all_empty_lists([]). all_empty_lists([[] | R]) :- all_empty_lists(R). first_and_rest_on_list([], [], []). first_and_rest_on_list([[F | R] | Lists], [F | FLists], [R | RLists]) :- first_and_rest_on_list(Lists, FLists, RLists). align_atoms_for_printing(Atoms, Method, Atoms1) :- max_length_of_atoms(Atoms, 0, Max), fill_atoms_to_max_length(Atoms, Max, Method, Atoms1). max_length_of_atoms([], Max, Max). max_length_of_atoms([F | R], MaxIn, MaxOut) :- atom_codes(F, FStr), length(FStr, N), ( N > MaxIn -> MaxNext is N ; MaxNext is MaxIn ), !, max_length_of_atoms(R, MaxNext, MaxOut). fill_atoms_to_max_length([], _Max, _Method, []). fill_atoms_to_max_length([F | R], Max, Method, [F1 | R1]) :- fill_atom_to_length(F, Max, Method, F1), !, fill_atoms_to_max_length(R, Max, Method, R1). fill_atom_to_length(Atom, Max, Method, Atom1) :- atom_codes(Atom, Str), length(Str, N), Missing is Max - N, Missing >= 0, ( Method = spaces -> n_copies_of_char(Missing, 0' , Filler) ; otherwise -> NTabs is 1 + Missing // 10, n_copies_of_char(NTabs, 0'\t, Filler) ), append(Str, Filler, Str1), atom_codes(Atom1, Str1), !. n_copies_of_char(0, _Char, []). n_copies_of_char(N, Char, [Char | R]) :- N1 is N - 1, n_copies_of_char(N1, Char, R). join_atoms_in_list([], []). join_atoms_in_list([F | R], [F1 | R1]) :- join_with_spaces(F, F1), !, join_atoms_in_list(R, R1). %------------------------------------------------------------------------------------ quote_layout_chars_in_string_for_json(InS, OutS) :- with_output_to_chars(print_string_with_layout_chars_for_json(InS), OutS), !. quote_layout_chars_in_string_for_json(InS, OutS) :- is_list_of_non_negative_integers(InS), format('~N*** Error: bad call: print_string_with_layout_chars_for_json("~s", ~q)~n', [InS, OutS]), !, fail. quote_layout_chars_in_string_for_json(InS, OutS) :- format('~N*** Error: bad call: ~w~n', [quote_layout_chars_in_string_for_json(InS, OutS)]), fail. print_string_with_layout_chars_for_json([]) :- !. print_string_with_layout_chars_for_json([NonAsciiChar | R]) :- NonAsciiChar > 255, format('\\u~16r\\', [NonAsciiChar]), !, print_string_with_layout_chars_for_json(R). % Escape newline, tab, " and \ print_string_with_layout_chars_for_json([LayoutChar | R]) :- json_layout_char_representation(LayoutChar, LayoutChar1), format('\\~c', [LayoutChar1]), !, print_string_with_layout_chars_for_json(R). print_string_with_layout_chars_for_json([F | R]) :- format('~c', [F]), !, print_string_with_layout_chars_for_json(R). print_string_with_layout_chars_for_json(X) :- format('~N*** Error: bad call: ~w~n', [print_string_with_layout_chars_for_json(X)]), fail. json_layout_char_representation(0'\n, 0'n). json_layout_char_representation(0'\t, 0't). json_layout_char_representation(0'", 0'"). json_layout_char_representation(0'\\, 0'\\). %------------------------------------------------------------------------------------ quote_layout_chars_in_string(InS, OutS) :- with_output_to_chars(print_string_with_layout_chars(InS), OutS), !. quote_layout_chars_in_string(InS, OutS) :- is_list_of_non_negative_integers(InS), format('~N*** Error: bad call: print_string_with_layout_chars("~s", ~q)~n', [InS, OutS]), !, fail. quote_layout_chars_in_string(InS, OutS) :- format('~N*** Error: bad call: ~w~n', [quote_layout_chars_in_string(InS, OutS)]), fail. print_string_with_layout_chars([]) :- !. print_string_with_layout_chars([NonAsciiChar | R]) :- NonAsciiChar > 255, format('\\x~16r\\', [NonAsciiChar]), !, print_string_with_layout_chars(R). % Don't escape a \x escape sequence print_string_with_layout_chars([0'\\, 0'x | R]) :- member(0'\\, R), format('\\x', []), print_chars_up_to_backslash(R, R1), !, print_string_with_layout_chars(R1). % Otherwise, escape newline, tab, " and \ print_string_with_layout_chars([LayoutChar | R]) :- layout_char_representation(LayoutChar, LayoutChar1), format('\\~c', [LayoutChar1]), !, print_string_with_layout_chars(R). print_string_with_layout_chars([F | R]) :- format('~c', [F]), !, print_string_with_layout_chars(R). print_string_with_layout_chars(X) :- format('~N*** Error: bad call: ~w~n', [print_string_with_layout_chars(X)]), fail. print_chars_up_to_backslash([0'\\ | R], R) :- format('\\', []), !. print_chars_up_to_backslash([F | R], Rest) :- format('~c', [F]), !, print_chars_up_to_backslash(R, Rest). layout_char_representation(0'\n, 0'n). layout_char_representation(0'\t, 0't). layout_char_representation(0'", 0'"). layout_char_representation(0'\\, 0'\\). %------------------------------------------------------------------------------------ string_to_unicode_string(InS, OutS) :- string_to_unicode_string1(InS, prolog, OutS). string_to_json_unicode_string(InS, OutS) :- string_to_unicode_string1(InS, json, OutS). string_to_unicode_string1(InS, Mode, OutS) :- with_output_to_chars(print_string_to_unicode_string(InS, Mode), OutS), !. string_to_unicode_string1(InS, Mode, OutS) :- is_list_of_non_negative_integers(InS), format('~N*** Error: bad call: string_to_unicode_string1("~s", ~q)~n', [InS, Mode, OutS]), !, fail. string_to_unicode_string1(InS, Mode, OutS) :- format('~N*** Error: bad call: ~w~n', [string_to_unicode_string1(InS, Mode, OutS)]), fail. print_string_to_unicode_string([], _Mode) :- !. print_string_to_unicode_string([Char | R], prolog) :- format('\\x~16r\\', [Char]), !, print_string_to_unicode_string(R, prolog). print_string_to_unicode_string([Code | R], json) :- format('\\u', []), print_number_as_four_digit_hex(Code), !, print_string_to_unicode_string(R, json). print_string_to_unicode_string(X, Mode) :- format('~N*** Error: bad call: ~w~n', [print_string_to_unicode_string(X, Mode)]), fail. print_number_as_four_digit_hex(N) :- integer(N), 0 =< N, N < ( 16 * 16 * 16 * 16 ), ( N < 16 -> format('000', []) ; N < 16 * 16 -> format('00', []) ; N < 16 * 16 * 16 -> format('0', []) ; otherwise -> true ), format('~16r', [N]), !. print_number_as_four_digit_hex(N) :- format('~N*** Error: bad call: ~w~n', [print_number_as_four_digit_hex(N)]), fail. %------------------------------------------------------------------------------------ is_list_of_non_negative_integers([]). is_list_of_non_negative_integers([F | R]) :- non_negative_integer(F), !, is_list_of_non_negative_integers(R). non_negative_integer(I) :- integer(I), I >= 0. %------------------------------------------------------------------------------------ is_prolog_string(X) :- is_list(X), is_prolog_string1(X). is_prolog_string1([]). is_prolog_string1([F | R]) :- is_prolog_char(F), is_prolog_string1(R). is_prolog_char(X) :- integer(X), 1 =< X, X =< 255. %------------------------------------------------------------------------------------ convert_strings_to_quoted_atoms(Var, Var) :- var(Var), !. convert_strings_to_quoted_atoms(Atom, Atom) :- atomic(Atom), !. convert_strings_to_quoted_atoms(String, Atom) :- is_prolog_string(String), atom_codes(Atom1, String), format_to_atom('"~w"', [Atom1], Atom), !. convert_strings_to_quoted_atoms(Term, Term1) :- compound(Term), functor(Term, F, N), functor(Term1, F, N), convert_strings_to_quoted_atoms_args(N, Term, Term1), !. convert_strings_to_quoted_atoms(Term, Term1) :- format('~N*** Error: bad call: ~w~n', [convert_strings_to_quoted_atoms(Term, Term1)]), fail. convert_strings_to_quoted_atoms_args(0, _Term1, _Term2) :- !. convert_strings_to_quoted_atoms_args(I, Term1, Term2) :- I > 0, arg(I, Term1, Arg1), arg(I, Term2, Arg2), convert_strings_to_quoted_atoms(Arg1, Arg2), I1 is I - 1, !, convert_strings_to_quoted_atoms_args(I1, Term1, Term2). %------------------------------------------------------------------------------------ optional_whitespace_sequence --> [F], {whitespace_char(F)}, !, optional_whitespace_sequence. optional_whitespace_sequence --> []. %------------------------------------------------------------------------------------ non_whitespace_word(Word) --> non_whitespace_list(L), {L \== [], atom_codes(Word, L)}. non_whitespace_list([F | R]) --> [F], {\+ whitespace_char(F)}, !, non_whitespace_list(R). non_whitespace_list([]) --> []. %------------------------------------------------------------------------------------ any_chars_word(Word) --> any_chars_list(L), {L \== [], atom_codes(Word, L)}. any_chars_list([F | R]) --> [F], !, any_chars_list(R). any_chars_list([]) --> []. %------------------------------------------------------------------------------------ integer_word(Word) --> digit_char_list(L), {L \== [], safe_number_codes(Word, L)}. digit_char_list_word(Word) --> digit_char_list(L), {L \== [], atom_codes(Word, L)}. digit_char_list([F | R]) --> [F], {digit_char(F)}, !, digit_char_list(R). digit_char_list([]) --> []. %------------------------------------------------------------------------------------ lowercase_atom_list([], []). lowercase_atom_list([F|R], [F1|R1]) :- lowercase_atom(F, F1), !, lowercase_atom_list(R, R1). uppercase_atom(A, A1) :- atom_codes(A, S), uppercase_string(S, S1), atom_codes(A1, S1). initial_uppercase_atom(A, A1) :- atom_codes(A, S), initial_uppercase_string(S, S1), atom_codes(A1, S1). initial_uppercase_string([],[]). initial_uppercase_string([F | R], [F1 | R]) :- uppercase_char(F, F1), !. uppercase_string([],[]). uppercase_string([F|R], [F1|R1]) :- uppercase_char(F, F1), !, uppercase_string(R, R1). uppercase_char(C, C1) :- lowercase_uppercase(C, C1), !. uppercase_char(C, C). lowercase_atom(A, A1) :- atom_codes(A, S), lowercase_string(S, S1), atom_codes(A1, S1). lowercase_string([],[]). lowercase_string([F|R], [F1|R1]) :- lowercase_char(F, F1), !, lowercase_string(R, R1). lowercase_char(C, C1) :- lowercase_uppercase(C1, C), !. lowercase_char(C, C). deaccent_atom(A, A1) :- atom_codes(A, S), deaccent_string(S, S1), atom_codes(A1, S1). deaccent_string([F | R], [F1 | R1]) :- deaccent_char(F, F1), !, deaccent_string(R, R1). deaccent_string([F | R], [F | R1]) :- !, deaccent_string(R, R1). strings_same_modulo_casing(X, Y) :- ( var(X) ; var(Y) ), !, fail. strings_same_modulo_casing([], []) :- !. strings_same_modulo_casing([F | R], [F1 | R1]) :- chars_same_modulo_casing(F, F1), !, strings_same_modulo_casing(R, R1). chars_same_modulo_casing(F, F) :- !. chars_same_modulo_casing(F, F1) :- lowercase_uppercase(F, F1), !. chars_same_modulo_casing(F, F1) :- lowercase_uppercase(F1, F), !. whitespace_atom(Atom) :- atom_codes(Atom, Str), whitespace_string(Str). whitespace_string([]). whitespace_string([F | R]) :- whitespace_char(F), !, whitespace_string(R). lowercase_string([]). lowercase_string([F | R]) :- lowercase_char(F), !, lowercase_string(R). uppercase_string([]). uppercase_string([F | R]) :- uppercase_char(F), !, uppercase_string(R). lowercase_uppercase(0'a, 0'A). lowercase_uppercase(0'b, 0'B). lowercase_uppercase(0'c, 0'C). lowercase_uppercase(0'd, 0'D). lowercase_uppercase(0'e, 0'E). lowercase_uppercase(0'f, 0'F). lowercase_uppercase(0'g, 0'G). lowercase_uppercase(0'h, 0'H). lowercase_uppercase(0'i, 0'I). lowercase_uppercase(0'j, 0'J). lowercase_uppercase(0'k, 0'K). lowercase_uppercase(0'l, 0'L). lowercase_uppercase(0'm, 0'M). lowercase_uppercase(0'n, 0'N). lowercase_uppercase(0'o, 0'O). lowercase_uppercase(0'p, 0'P). lowercase_uppercase(0'q, 0'Q). lowercase_uppercase(0'r, 0'R). lowercase_uppercase(0's, 0'S). lowercase_uppercase(0't, 0'T). lowercase_uppercase(0'u, 0'U). lowercase_uppercase(0'v, 0'V). lowercase_uppercase(0'w, 0'W). lowercase_uppercase(0'x, 0'X). lowercase_uppercase(0'y, 0'Y). lowercase_uppercase(0'z, 0'Z). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). lowercase_uppercase(0'�, 0'�). newline_char(0'\n). whitespace_char(0' ). whitespace_char(0'\n). whitespace_char(0'\t). punctuation_char(0'.). punctuation_char(0',). punctuation_char(0'!). punctuation_char(0'?). punctuation_char(0'(). punctuation_char(0')). digit_char(0'1). digit_char(0'2). digit_char(0'3). digit_char(0'4). digit_char(0'5). digit_char(0'6). digit_char(0'7). digit_char(0'8). digit_char(0'9). digit_char(0'0). lowercase_char(0'a). lowercase_char(0'b). lowercase_char(0'c). lowercase_char(0'd). lowercase_char(0'e). lowercase_char(0'f). lowercase_char(0'g). lowercase_char(0'h). lowercase_char(0'i). lowercase_char(0'j). lowercase_char(0'k). lowercase_char(0'l). lowercase_char(0'm). lowercase_char(0'n). lowercase_char(0'o). lowercase_char(0'p). lowercase_char(0'q). lowercase_char(0'r). lowercase_char(0's). lowercase_char(0't). lowercase_char(0'u). lowercase_char(0'v). lowercase_char(0'w). lowercase_char(0'x). lowercase_char(0'y). lowercase_char(0'z). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). lowercase_char(0'�). uppercase_char(0'A). uppercase_char(0'B). uppercase_char(0'C). uppercase_char(0'D). uppercase_char(0'E). uppercase_char(0'F). uppercase_char(0'G). uppercase_char(0'H). uppercase_char(0'I). uppercase_char(0'J). uppercase_char(0'K). uppercase_char(0'L). uppercase_char(0'M). uppercase_char(0'N). uppercase_char(0'O). uppercase_char(0'P). uppercase_char(0'Q). uppercase_char(0'R). uppercase_char(0'S). uppercase_char(0'T). uppercase_char(0'U). uppercase_char(0'V). uppercase_char(0'W). uppercase_char(0'X). uppercase_char(0'Y). uppercase_char(0'Z). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). uppercase_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). accented_char(0'�). deaccent_char(0'�, 0'a). deaccent_char(0'�, 0'a). deaccent_char(0'�, 0'a). deaccent_char(0'�, 0'a). deaccent_char(0'�, 0'e). deaccent_char(0'�, 0'a). deaccent_char(0'�, 0'c). deaccent_char(0'�, 0'e). deaccent_char(0'�, 0'e). deaccent_char(0'�, 0'e). deaccent_char(0'�, 0'e). deaccent_char(0'�, 0'i). deaccent_char(0'�, 0'i). deaccent_char(0'�, 0'i). deaccent_char(0'�, 0'i). deaccent_char(0'�, 0'o). deaccent_char(0'�, 0'o). deaccent_char(0'�, 0'o). deaccent_char(0'�, 0'o). deaccent_char(0'�, 0'u). deaccent_char(0'�, 0'u). deaccent_char(0'�, 0'u). deaccent_char(0'�, 0'u). deaccent_char(0'�, 0'A). deaccent_char(0'�, 0'A). deaccent_char(0'�, 0'A). deaccent_char(0'�, 0'A). deaccent_char(0'�, 0'E). deaccent_char(0'�, 0'A). deaccent_char(0'�, 0'C). deaccent_char(0'�, 0'E). deaccent_char(0'�, 0'E). deaccent_char(0'�, 0'E). deaccent_char(0'�, 0'E). deaccent_char(0'�, 0'I). deaccent_char(0'�, 0'I). deaccent_char(0'�, 0'I). deaccent_char(0'�, 0'I). deaccent_char(0'�, 0'O). deaccent_char(0'�, 0'O). deaccent_char(0'�, 0'O). deaccent_char(0'�, 0'O). deaccent_char(0'�, 0'U). deaccent_char(0'�, 0'U). deaccent_char(0'�, 0'U). deaccent_char(0'�, 0'U). %------------------------------------------------------------------------------------ /* Prettyprinting predicates. You can specify the desired maximum line length and print depth. Lines longer than the maximum length are broken if possible by inserting newlines, and terms nested more deeply than the maximum depth are replaced by an ellipsis (...). If the term you are prettyprinting starts in the middle of a line, you can also supply an "indent" value. There are several different versions of the predicate, depending on how much information you wish to supply explicitly: prettyprint(Term, Indent, DesiredMaxLineLength, MaxDepth) Supply all arguments explicitly. prettyprint(Term, Indent, DesiredMaxLineLength) Use default value of MaxDepth prettyprint(Term, Indent) Use default values of DesiredMaxLineLength and MaxDepth prettyprint(Term) Use default values of DesiredMaxLineLength and MaxDepth and a zero value of Indent You can set the default values of MaxDepth and DesiredMaxLineLength using the predicates set_pp_depth/1 and set_pp_width/1. For example, set_pp_width(80) sets the default value of DesiredMaxLineLength to 80. You can also use the prettyprinter to print trace output when debugging. You can switch this functionality on and off using the predicates pp_debug/0 and no_pp_debug/0. */ prettyprint(Term) :- get_pp_width(Width), get_pp_depth(Depth), prettyprint(Term, 0, Width, Depth). prettyprint(Term, Indent) :- get_pp_width(Width), get_pp_depth(Depth), prettyprint(Term, Indent, Width, Depth). prettyprint(Term, Indent, Width) :- get_pp_depth(Depth), prettyprint(Term, Indent, Width, Depth). prettyprintq(Term) :- get_pp_width(Width), get_pp_depth(Depth), prettyprintq(Term, 0, Width, Depth). prettyprintq(Term, Indent) :- get_pp_width(Width), get_pp_depth(Depth), prettyprintq(Term, Indent, Width, Depth). prettyprintq(Term, Indent, Width) :- get_pp_depth(Depth), prettyprintq(Term, Indent, Width, Depth). %------------------------------------------------------------------------------------ prettyprint_to_stream(S, Term) :- get_pp_width(Width), get_pp_depth(Depth), prettyprint_to_stream(S, Term, 0, Width, Depth). prettyprint_to_stream(S, Term, Indent) :- get_pp_width(Width), get_pp_depth(Depth), prettyprint_to_stream(S, Term, Indent, Width, Depth). prettyprint_to_stream(S, Term, Indent, Width) :- get_pp_depth(Depth), prettyprint_to_stream(S, Term, Indent, Width, Depth). prettyprint_to_stream(S, Term, Indent, Width, Depth) :- with_output_to_chars(prettyprint(Term, Indent, Width, Depth), Chars), format(S, '~s', [Chars]). prettyprintq_to_stream_unlimited_depth(S, Term) :- prettyprintq_to_stream(S, Term, 0, 100, 10000000). prettyprintq_to_stream(S, Term) :- get_pp_width(Width), get_pp_depth(Depth), prettyprintq_to_stream(S, Term, 0, Width, Depth). prettyprintq_to_stream(S, Term, Indent) :- get_pp_width(Width), get_pp_depth(Depth), prettyprintq_to_stream(S, Term, Indent, Width, Depth). prettyprintq_to_stream(S, Term, Indent, Width) :- get_pp_depth(Depth), prettyprintq_to_stream(S, Term, Indent, Width, Depth). prettyprintq_to_stream(S, Term, Indent, Width, Depth) :- with_output_to_chars(prettyprintq(Term, Indent, Width, Depth), Chars), format(S, '~s', [Chars]). %------------------------------------------------------------------------------------ prettyprint_term_with_intro_grounded(Intro, Term) :- copy_term(Term, Term1), make_ground(Term1), prettyprint_term_with_intro(user, Intro, Term1). prettyprint_term_with_intro(Intro, Term) :- prettyprint_term_with_intro(user, Intro, Term). prettyprint_term_with_intro_grounded(S, Intro, Term) :- copy_term(Term, Term1), make_ground(Term1), prettyprint_term_with_intro(S, Intro, Term1). prettyprint_term_with_intro(S, Intro, Term) :- format_to_chars('~w', Intro, IntroChars), format(S, '~N~s: ', [IntroChars]), length(IntroChars, Len), Indent is Len + 2, prettyprint_to_stream(S, Term, Indent), format(S, '~n', []), !. %------------------------------------------------------------------------------------ :- dynamic pp_width/1, pp_depth/1. set_pp_width(X) :- retractall(pp_width(_)), assertz(pp_width(X)), !. get_pp_width(X) :- pp_width(X), !. get_pp_width(X) :- default_pp_width(X), !. default_pp_width(100). set_pp_depth(X) :- retractall(pp_depth(_)), assertz(pp_depth(X)), !. get_pp_depth(X) :- pp_depth(X), !. get_pp_depth(X) :- default_pp_depth(X), !. default_pp_depth(1000). %------------------------------------------------------------------------------------ % Print, trying to make sure that no line is more than DesiredMaxLineLength long - so % if a line looks like it will be longer than this, insert a newline. The list is indented % by Indent spaces. prettyprint(Term, Indent, DesiredMaxLineLength, MaxDepth) :- DesiredMaxLineLength1 is DesiredMaxLineLength - 5, prettyprint1(Term, Indent-_PosOut, Indent, DesiredMaxLineLength1, 0-MaxDepth, start_of_line-_, w, _), !. prettyprint(Term, Indent, DesiredMaxLineLength, MaxDepth) :- format('~N*** Error: bad call: ~q~n', [prettyprint(Term, Indent, DesiredMaxLineLength, MaxDepth)]). prettyprintq(Term, Indent, DesiredMaxLineLength, MaxDepth) :- DesiredMaxLineLength1 is DesiredMaxLineLength - 5, prettyprint1(Term, Indent-_PosOut, Indent, DesiredMaxLineLength1, 0-MaxDepth, start_of_line-_, q, _), !. prettyprintq(Term, Indent, DesiredMaxLineLength, MaxDepth) :- format('~N*** Error: bad call: ~q~n', [prettyprintq(Term, Indent, DesiredMaxLineLength, MaxDepth)]). %------------------------------------------------------------------------------------ % If we can just print the term normally without reaching the end of the line, do that. % Alternately, see if we do a normal print on the next line. prettyprint1(Term0, PosIn-PosOut, Indent, DesiredMaxLineLength, Depth-MaxDepth, Start-not_start_of_line, WQ, no_prettyprint) :- ( Depth =< MaxDepth -> Term = Term0 ; Term = '...' ), ( term_requiring_enclosing_parentheses(Term) -> ( WQ = w -> format_to_chars('(~w)', [Term], Chars) ; format_to_chars('(~q)', [Term], Chars) ) ; ( WQ = w -> format_to_chars('~w', [Term], Chars) ; format_to_chars('~q', [Term], Chars) ) ), length(Chars, NChars), ( PosIn + NChars =< DesiredMaxLineLength -> format('~s', [Chars]), PosOut is PosIn + NChars ; ( Start = not_start_of_line, Indent + NChars =< DesiredMaxLineLength ) -> % Newline, Indent spaces and Term format('~n~*c~s', [Indent, 0' ,Chars]), PosOut is Indent + NChars ), !. % We're prettyprinting some kind of list. Move to start of next line if necessary. % Print an appropriate opening bracket, increment position and indent, % and print the rest of the list, ending with an appropraite closing bracket. prettyprint1(List, _PosIn-PosOut, Indent, DesiredMaxLineLength, Depth-MaxDepth, StartIn-start_of_line, WQ, prettyprint) :- is_generalised_list(List, List1, OpeningBracket, ClosingBracket), !, ( StartIn = not_start_of_line -> % Newline and then Indent spaces format('~n~*c', [Indent, 0' ]) ; true ), format('~w', [OpeningBracket]), PosNext is Indent + 1, Indent1 is Indent + 1, Depth1 is Depth + 1, prettyprint2(List1, PosNext-PosOut, Indent1, DesiredMaxLineLength, Depth1-MaxDepth, WQ, ClosingBracket, start_of_line). % We're printing a non-list, non-operator compound term. % Similar to list, but print functor and opening ( at start and ) at end. prettyprint1(Term, PosIn-PosOut, Indent, DesiredMaxLineLength, Depth-MaxDepth, StartIn-start_of_line, WQ, prettyprint) :- compound(Term), Term =.. [Functor | Args], % It's not a binary operator on exactly 2 args... ( \+ binary_operator(Functor) ; \+ length(Args, 2) ), Args \== [], !, ( StartIn = not_start_of_line -> % Newline and then Indent spaces format('~n~*c', [Indent, 0' ]) ; true ), %atom_codes(Functor, FunctorChars), ( WQ = w -> format_to_chars('~w', Functor, FunctorChars) ; format_to_chars('~q', Functor, FunctorChars) ), length(FunctorChars, NFunctorChars), format('~s(', [FunctorChars]), PosNext is PosIn + NFunctorChars + 1, Indent1 is Indent + NFunctorChars + 1, Depth1 is Depth + 1, prettyprint2(Args, PosNext-PosOut, Indent1, DesiredMaxLineLength, Depth1-MaxDepth, WQ, ')', start_of_line), !. % We're printing a term with a binary operator. Print left paren, first arg on new line, try to print operator % on same line, try to print second arg on same line if first one wasn't prettyprinted, right paren. prettyprint1(Term, PosIn-PosOut, Indent, DesiredMaxLineLength, Depth-MaxDepth, StartIn-StartOut, WQ, prettyprint) :- compound(Term), Term =.. [Op, Arg1, Arg2], binary_operator(Op), !, ( StartIn = not_start_of_line -> % Newline and then Indent spaces format('~n~*c', [Indent, 0' ]) ; true ), Depth1 is Depth + 1, format('(', []), PosIn1 is PosIn + 1, Indent1 is Indent + 1, prettyprint1(Arg1, PosIn1-PosNext1, Indent1, DesiredMaxLineLength, Depth1-MaxDepth, start_of_line-_StartNext, WQ, Prettyprint1), atom_codes(Op, OpChars), length(OpChars, NOpChars), ( PosNext1 + NOpChars + 2 =< DesiredMaxLineLength -> format(' ~w ', [Op]), PosNext2 is PosNext1 + NOpChars + 2 ; % Newline, Indent1 spaces, Op, space format('~n~*c~w ', [Indent1, 0' ,Op]), PosNext2 is Indent + NOpChars + 2 ), ( Prettyprint1 = no_prettyprint -> StartNext = not_start_of_line, PosNext3 = PosNext2 ; % Newline, Indent1 spaces format('~n~*c', [Indent1, 0' ]), StartNext = start_of_line, PosNext3 = Indent1 ), prettyprint1(Arg2, PosNext3-PosNext4, Indent1, DesiredMaxLineLength, Depth1-MaxDepth, StartNext-StartOut, WQ, _Prettyprint2), format(')', []), PosOut is PosNext4 + 1, !. % Worst case: atom, and too long for line, so no solution. If not at start of line, go to new line, % and just print it out. prettyprint1(Atom, _PosIn-PosOut, Indent, _DesiredMaxLineLength, _Depth, StartIn-not_start_of_line, WQ, no_prettyprint) :- ( atomic(Atom) ; var(Atom) ), !, ( StartIn = not_start_of_line -> % Newline and then Indent spaces format('~n~*c', [Indent, 0' ]) ; true ), ( WQ = w -> format_to_chars('~w', [Atom], Chars) ; format_to_chars('~q', [Atom], Chars) ), length(Chars, NChars), format('~s', [Chars]), PosOut is Indent + NChars, !. % We've reached the end of the list or term. % Print the closing bracket, and add a newline + indent first if line is long. prettyprint2([], PosIn-PosOut, Indent, DesiredMaxLineLength, _Depth, _WQ, ClosingBracket, _Start) :- ( PosIn < DesiredMaxLineLength -> format('~w', [ClosingBracket]), PosOut is PosIn + 1; % Newline, Indent spaces and right bracket format('~n~*c~w', [Indent, 0' , ClosingBracket]), PosOut is Indent + 1 ), !. prettyprint2(_List, PosIn-PosOut, Indent, DesiredMaxLineLength, Depth-MaxDepth, WQ, ClosingBracket, StartIn) :- Depth >= MaxDepth, prettyprint2(['...'], PosIn-PosOut, Indent, DesiredMaxLineLength, 0-1000, WQ, ClosingBracket, StartIn), !. prettyprint2([F | R], PosIn-PosOut, Indent, DesiredMaxLineLength, Depth-MaxDepth, WQ, ClosingBracket, StartIn) :- Depth1 is Depth + 1, prettyprint1(F, PosIn-PosNext1, Indent, DesiredMaxLineLength, Depth1-MaxDepth, StartIn-StartNext, WQ, Prettyprint), ( % No more items in list. Print a closing bracket. ( R = [] ) -> format('~w', [ClosingBracket]), PosOut is PosNext1 + 1 ; % First element was prettyprinted and we know there are more elements. % Print comma, newline and then Indent spaces, then continue. ( Prettyprint = prettyprint ) -> format(',~n~*c', [Indent, 0' ]), PosNext2 = Indent, prettyprint2(R, PosNext2-PosOut, Indent, DesiredMaxLineLength, Depth1-MaxDepth, WQ, ClosingBracket, start_of_line) ; % Not at start of line, and room to print a comma and a space. Do that and continue on same line. ( StartNext = not_start_of_line, PosNext1 + 2 =< DesiredMaxLineLength ) -> format(', ', []), PosNext is PosNext1 + 2, prettyprint2(R, PosNext-PosOut, Indent, DesiredMaxLineLength, Depth1-MaxDepth, WQ, ClosingBracket, not_start_of_line) ; % No room to print comma and space. Just print a comma and move to next line. format(',~n~*c', [Indent, 0' ]), PosNext is Indent, prettyprint2(R, PosNext-PosOut, Indent, DesiredMaxLineLength, Depth1-MaxDepth, WQ, ClosingBracket, start_of_line) ), !. prettyprint2(List, Pos, Indent, DesiredMaxLineLength, Depth, WQ, EndChar, Start) :- format('~N*** Error: bad call: ~q~n', [prettyprint2(List, Pos, Indent, DesiredMaxLineLength, Depth, WQ, EndChar, Start)]). %------------------------------------------------------------------------------------ prettyprint_key_val_pair(Key, Val) :- format_to_chars('~w = ', [Key], KeyChars), length(KeyChars, NKeyChars), format('~N~s', [KeyChars]), prettyprint(Val, NKeyChars), format('~n', []). prettyprintq_key_val_pair(Key, Val) :- format_to_chars('~q = ', [Key], KeyChars), length(KeyChars, NKeyChars), format('~N~s', [KeyChars]), prettyprintq(Val, NKeyChars), format('~n', []). prettyprintq_to_stream_key_val_pair(S, Key, Val) :- format_to_chars('~q = ', [Key], KeyChars), length(KeyChars, NKeyChars), format(S, '~N~s', [KeyChars]), prettyprintq_to_stream(S, Val, NKeyChars). %------------------------------------------------------------------------------------ is_generalised_list(List, List, '[', ']') :- is_list(List), !. is_generalised_list(List, List1, '(', ')') :- is_comma_list(List), comma_list_to_list(List, List1), !. is_generalised_list(List, List1, '{', '}') :- is_curly_bracket_list(List), curly_bracket_list_to_list(List, List1), !. binary_operator(Op) :- current_op(_Precedence, Type, Op), member(Type, [xfx, yfx, xfy]), !. term_requiring_enclosing_parentheses(Term) :- compound(Term), functor(Term, F, N), functor_requiring_enclosing_parentheses(F/N). functor_requiring_enclosing_parentheses(Op/2) :- binary_operator(Op). functor_requiring_enclosing_parentheses(','/2). functor_requiring_enclosing_parentheses('-->'/2). functor_requiring_enclosing_parentheses(':-'/2). %------------------------------------------------------------------------------------ pp_debug :- asserta((user:portray(X) :- prettyprintq(X))). no_pp_debug :- retractall((user:portray(_))).