1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 1985-2025, University of Amsterdam 7 VU University Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(quintus, 38 [ unix/1, 39% file_exists/1, 40 41 abs/2, 42 sin/2, 43 cos/2, 44 tan/2, 45 log/2, 46 log10/2, 47 pow/3, 48 ceiling/2, 49 floor/2, 50 round/2, 51 acos/2, 52 asin/2, 53 atan/2, 54 atan2/3, 55 sign/2, 56 sqrt/2, 57 58 genarg/3, 59 60 no_style_check/1, 61 otherwise/0, 62 simple/1, 63% statistics/2, % Please access as quintus:statistics/2 64 prolog_flag/2, 65 66 date/1, % -date(Year, Month, Day) 67 68 current_stream/3, % ?File, ?Mode, ?Stream 69 stream_position/3, % +Stream, -Old, +New 70 skip_line/0, 71 skip_line/1, % +Stream 72 73 compile/1, % +File(s) 74 75 atom_char/2, 76 midstring/3, % ABC, B, AC 77 midstring/4, % ABC, B, AC, LenA 78 midstring/5, % ABC, B, AC, LenA, LenB 79 midstring/6, % ABC, B, AC, LenA, LenB, LenC 80 81 raise_exception/1, % +Exception 82 on_exception/3 % +Ball, :Goal, :Recover 83 ]). 84:- autoload(library(apply),[maplist/3]). 85:- autoload(library(date),[date_time_value/3]). 86:- autoload(library(shell),[shell/0]). 87 88 89/** <module> Quintus compatibility 90 91This module defines several predicates from the Quintus Prolog 92libraries. Note that our library structure is totally different. If this 93library were complete, Prolog code could be ported by removing the 94use_module/1 declarations, relying on the SWI-Prolog autoloader. 95 96Bluffers guide to porting: 97 98 * Remove =|use_module(library(...))|= 99 * Run =|?- list_undefined.|= 100 * Fix problems 101 102Of course, this library is incomplete ... 103*/ 104 105 /******************************** 106 * SYSTEM INTERACTION * 107 *********************************/ 108 109%! unix(+Action) 110% 111% This predicate provides a partial emulation of the corresponding 112% Quintus predicate. It provides access to some operating system 113% features and unlike the name suggests, is not operating system 114% specific. Defined actions are below. 115% 116% - system(+Command) 117% Equivalent to shell(Command) 118% - shell(+Command) 119% Equivalent to shell(Command) 120% - access(File, 0) 121% Equivalent to access_file(File, read) 122% - cd(Dir) 123% Equivalent to working_directory(_, Dir) 124% - args(List) 125% Equivalent to current_prolog_flag(os_argv, List). 126% - argv(List) 127% Equivalent to args(List), but arguments that are syntactically 128% valid numbers are passed as a number. 129 130unix(system(Command)) :- 131 shell(Command). 132unix(shell(Command)) :- 133 shell(Command). 134unix(shell) :- 135 shell. 136unix(access(File, 0)) :- 137 access_file(File, read). 138unix(cd) :- 139 expand_file_name(~, [Home]), 140 working_directory(_, Home). 141unix(cd(Dir)) :- 142 working_directory(_, Dir). 143unix(args(L)) :- 144 current_prolog_flag(os_argv, L). 145unix(argv(L)) :- 146 current_prolog_flag(os_argv, S), 147 maplist(to_prolog, S, L). 148 149to_prolog(S, A) :- 150 name(S, L), 151 name(A, L). 152 153 154 /******************************** 155 * META PREDICATES * 156 *********************************/ 157 158%! otherwise 159% 160% For (A -> B ; otherwise -> C) 161 162otherwise. 163 164 165 /******************************** 166 * ARITHMETIC * 167 *********************************/ 168 169%! abs(+Number, -Absolute) 170% Unify `Absolute' with the absolute value of `Number'. 171 172abs(Number, Absolute) :- 173 Absolute is abs(Number). 174 175%! sin(+Angle, -Sine) is det. 176%! cos(+Angle, -Cosine) is det. 177%! tan(+Angle, -Tangent) is det. 178%! log(+X, -NatLog) is det. 179%! log10(+X, -Log) is det. 180%! pow(+X, +Y, -Pow) is det. 181%! ceiling(+X, -Value) is det. 182%! floor(+X, -Value) is det. 183%! round(+X, -Value) is det. 184%! sqrt(+X, -Value) is det. 185%! acos(+X, -Value) is det. 186%! asin(+X, -Value) is det. 187%! atan(+X, -Value) is det. 188%! atan2(+Y, +X, -Value) is det. 189%! sign(+X, -Value) is det. 190% 191% Math library predicates. SWI-Prolog (and ISO) support these as 192% functions under is/2, etc. 193% 194% @compat Quintus Prolog. 195% @deprecated Do not use these predicates except for compatibility 196% reasons. 197 198sin(A, V) :- V is sin(A). 199cos(A, V) :- V is cos(A). 200tan(A, V) :- V is tan(A). 201log(A, V) :- V is log(A). 202log10(X, V) :- V is log10(X). 203pow(X,Y,V) :- V is X**Y. 204ceiling(X, V) :- V is ceil(X). 205floor(X, V) :- V is floor(X). 206round(X, V) :- V is round(X). 207sqrt(X, V) :- V is sqrt(X). 208acos(X, V) :- V is acos(X). 209asin(X, V) :- V is asin(X). 210atan(X, V) :- V is atan(X). 211atan2(Y, X, V) :- V is atan(Y, X). 212sign(X, V) :- V is sign(X). 213 214 215 /******************************* 216 * TERM MANIPULATION * 217 *******************************/ 218 219%! genarg(?Index, +Term, ?Arg) is nondet. 220% 221% Generalised version of ISO arg/3. SWI-Prolog's arg/3 is already 222% genarg/3. 223 224genarg(N, T, A) :- 225 arg(N, T, A). 226 227 228 /******************************* 229 * FLAGS * 230 *******************************/ 231 232%! prolog_flag(?Flag, ?Value) is nondet. 233% 234% Same as ISO current_prolog_flag/2. Maps =version=. 235% 236% @bug Should map relevant Quintus flag identifiers. 237 238prolog_flag(version, Version) :- 239 !, 240 current_prolog_flag(version_data, swi(Major, Minor, Patch, _)), 241 current_prolog_flag(arch, Arch), 242 current_prolog_flag(compiled_at, Compiled), 243 atomic_list_concat(['SWI-Prolog ', 244 Major, '.', Minor, '.', Patch, 245 ' (', Arch, '): ', Compiled], Version). 246prolog_flag(Flag, Value) :- 247 current_prolog_flag(Flag, Value). 248 249 250 /******************************* 251 * STATISTICS * 252 *******************************/ 253 254% Here used to be a definition of Quintus statistics/2 in traditional 255% SWI-Prolog statistics/2. The current built-in emulates Quintus 256% almost completely. 257 258 259 /******************************* 260 * DATE/TIME * 261 *******************************/ 262 263%! date(-Date) is det. 264% 265% Get current date as date(Y,M,D) 266 267date(Date) :- 268 get_time(T), 269 stamp_date_time(T, DaTime, local), 270 date_time_value(date, DaTime, Date). 271 272 273 /******************************** 274 * STYLE CHECK * 275 *********************************/ 276 277%! no_style_check(Style) is det. 278% 279% Same as SWI-Prolog =|style_check(-Style)|=. The Quintus option 280% =single_var= is mapped to =singleton=. 281% 282% @see style_check/1. 283 284q_style_option(single_var, singleton) :- !. 285q_style_option(Option, Option). 286 287no_style_check(QOption) :- 288 q_style_option(QOption, SWIOption), 289 style_check(-SWIOption). 290 291 292 /******************************* 293 * TYPES * 294 *******************************/ 295 296%! simple(@Term) is semidet. 297% 298% Term is atomic or a variable. 299 300simple(X) :- 301 ( atomic(X) 302 -> true 303 ; var(X) 304 ). 305 306 307 /******************************* 308 * STREAMS * 309 *******************************/ 310 311%! current_stream(?Object, ?Mode, ?Stream) 312% 313% SICStus/Quintus and backward compatible predicate. New code should 314% be using the ISO compatible stream_property/2. 315 316current_stream(Object, Mode, Stream) :- 317 stream_property(Stream, mode(FullMode)), 318 stream_mode(FullMode, Mode), 319 ( stream_property(Stream, file_name(Object0)) 320 -> true 321 ; stream_property(Stream, file_no(Object0)) 322 -> true 323 ; Object0 = [] 324 ), 325 Object = Object0. 326 327stream_mode(read, read). 328stream_mode(write, write). 329stream_mode(append, write). 330stream_mode(update, write). 331 332%! stream_position(+Stream, -Old, +New) 333% 334% True when Old is the current position in Stream and the stream 335% has been repositioned to New. 336% 337% @deprecated New code should use the ISO predicates 338% stream_property/2 and set_stream_position/2. 339 340stream_position(Stream, Old, New) :- 341 stream_property(Stream, position(Old)), 342 set_stream_position(Stream, New). 343 344 345%! skip_line is det. 346%! skip_line(Stream) is det. 347% 348% Skip the rest of the current line (on Stream). Same as 349% =|skip(0'\n)|=. 350 351skip_line :- 352 skip(10). 353skip_line(Stream) :- 354 skip(Stream, 10). 355 356 357 /******************************* 358 * COMPILATION * 359 *******************************/ 360 361%! compile(+Files) is det. 362% 363% Compile files. SWI-Prolog doesn't distinguish between 364% compilation and consult. 365% 366% @see load_files/2. 367 368:- meta_predicate 369 compile( ). 370 371compile(Files) :- 372 consult(Files). 373 374 /******************************* 375 * ATOM-HANDLING * 376 *******************************/ 377 378%! atom_char(+Char, -Code) is det. 379%! atom_char(-Char, +Code) is det. 380% 381% Same as ISO char_code/2. 382 383atom_char(Char, Code) :- 384 char_code(Char, Code). 385 386%! midstring(?ABC, ?B, ?AC) is nondet. 387%! midstring(?ABC, ?B, ?AC, LenA) is nondet. 388%! midstring(?ABC, ?B, ?AC, LenA, LenB) is nondet. 389%! midstring(?ABC, ?B, ?AC, LenA, LenB, LenC) is nondet. 390% 391% Too difficult to explain. See the Quintus docs. As far as I 392% understand them the code below emulates this function just fine. 393 394midstring(ABC, B, AC) :- 395 midstring(ABC, B, AC, _, _, _). 396midstring(ABC, B, AC, LenA) :- 397 midstring(ABC, B, AC, LenA, _, _). 398midstring(ABC, B, AC, LenA, LenB) :- 399 midstring(ABC, B, AC, LenA, LenB, _). 400midstring(ABC, B, AC, LenA, LenB, LenC) :- % -ABC, +B, +AC 401 var(ABC), 402 !, 403 atom_length(AC, LenAC), 404 ( nonvar(LenA) ; nonvar(LenC) 405 -> plus(LenA, LenC, LenAC) 406 ; true 407 ), 408 sub_atom(AC, 0, LenA, _, A), 409 LenC is LenAC - LenA, 410 sub_atom(AC, _, LenC, 0, C), 411 atom_length(B, LenB), 412 atomic_list_concat([A,B,C], ABC). 413midstring(ABC, B, AC, LenA, LenB, LenC) :- 414 sub_atom(ABC, LenA, LenB, LenC, B), 415 sub_atom(ABC, 0, LenA, _, A), 416 sub_atom(ABC, _, LenC, 0, C), 417 atom_concat(A, C, AC). 418 419 420 /******************************* 421 * EXCEPTIONS * 422 *******************************/ 423 424%! raise_exception(+Term) 425% 426% Quintus compatible exception handling 427 428raise_exception(Term) :- 429 throw(Term). 430 431%! on_exception(+Template, :Goal, :Recover) 432 433:- meta_predicate 434 on_exception( , , ). 435 436on_exception(Except, Goal, Recover) :- 437 catch(Goal, Except, Recover)