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