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%! pow(+X, +Y, -Pow) is det. 160%! ceiling(+X, -Value) is det. 161%! floor(+X, -Value) is det. 162%! round(+X, -Value) is det. 163%! sqrt(+X, -Value) is det. 164%! acos(+X, -Value) is det. 165%! asin(+X, -Value) is det. 166%! atan(+X, -Value) is det. 167%! atan2(+Y, +X, -Value) is det. 168%! sign(+X, -Value) is det. 169% 170% Math library predicates. SWI-Prolog (and ISO) support these as 171% functions under is/2, etc. 172% 173% @compat Quintus Prolog. 174% @deprecated Do not use these predicates except for compatibility 175% reasons. 176 177sin(A, V) :- V is sin(A). 178cos(A, V) :- V is cos(A). 179tan(A, V) :- V is tan(A). 180log(A, V) :- V is log(A). 181log10(X, V) :- V is log10(X). 182pow(X,Y,V) :- V is X**Y. 183ceiling(X, V) :- V is ceil(X). 184floor(X, V) :- V is floor(X). 185round(X, V) :- V is round(X). 186sqrt(X, V) :- V is sqrt(X). 187acos(X, V) :- V is acos(X). 188asin(X, V) :- V is asin(X). 189atan(X, V) :- V is atan(X). 190atan2(Y, X, V) :- V is atan(Y, X). 191sign(X, V) :- V is sign(X). 192 193 194 /******************************* 195 * TERM MANIPULATION * 196 *******************************/ 197 198%! genarg(?Index, +Term, ?Arg) is nondet. 199% 200% Generalised version of ISO arg/3. SWI-Prolog's arg/3 is already 201% genarg/3. 202 203genarg(N, T, A) :- 204 arg(N, T, A). 205 206 207 /******************************* 208 * FLAGS * 209 *******************************/ 210 211%! prolog_flag(?Flag, ?Value) is nondet. 212% 213% Same as ISO current_prolog_flag/2. Maps =version=. 214% 215% @bug Should map relevant Quintus flag identifiers. 216 217prolog_flag(version, Version) :- 218 !, 219 current_prolog_flag(version_data, swi(Major, Minor, Patch, _)), 220 current_prolog_flag(arch, Arch), 221 current_prolog_flag(compiled_at, Compiled), 222 atomic_list_concat(['SWI-Prolog ', 223 Major, '.', Minor, '.', Patch, 224 ' (', Arch, '): ', Compiled], Version). 225prolog_flag(Flag, Value) :- 226 current_prolog_flag(Flag, Value). 227 228 229 /******************************* 230 * STATISTICS * 231 *******************************/ 232 233% Here used to be a definition of Quintus statistics/2 in traditional 234% SWI-Prolog statistics/2. The current built-in emulates Quintus 235% almost completely. 236 237 238 /******************************* 239 * DATE/TIME * 240 *******************************/ 241 242%! date(-Date) is det. 243% 244% Get current date as date(Y,M,D) 245 246date(Date) :- 247 get_time(T), 248 stamp_date_time(T, DaTime, local), 249 date_time_value(date, DaTime, Date). 250 251 252 /******************************** 253 * STYLE CHECK * 254 *********************************/ 255 256%! no_style_check(Style) is det. 257% 258% Same as SWI-Prolog =|style_check(-Style)|=. The Quintus option 259% =single_var= is mapped to =singleton=. 260% 261% @see style_check/1. 262 263q_style_option(single_var, singleton) :- !. 264q_style_option(Option, Option). 265 266no_style_check(QOption) :- 267 q_style_option(QOption, SWIOption), 268 style_check(-SWIOption). 269 270 271 /******************************** 272 * DIRECTIVES * 273 *********************************/ 274 275%! mode(+ModeDecl) is det. 276% 277% Ignore a DEC10/Quintus `:- mode(Head)` declaration. Typically 278% these declarations are written in operator form. The operator 279% declaration is not part of the Quintus emulation library. The 280% following declaration is compatible with Quintus: 281% 282% == 283% :- op(1150, fx, [(mode)]). 284% == 285 286mode(_). 287 288 289 /******************************* 290 * TYPES * 291 *******************************/ 292 293%! simple(@Term) is semidet. 294% 295% Term is atomic or a variable. 296 297simple(X) :- 298 ( atomic(X) 299 -> true 300 ; var(X) 301 ). 302 303 304 /******************************* 305 * STREAMS * 306 *******************************/ 307 308%! current_stream(?Object, ?Mode, ?Stream) 309% 310% SICStus/Quintus and backward compatible predicate. New code should 311% be using the ISO compatible stream_property/2. 312 313current_stream(Object, Mode, Stream) :- 314 stream_property(Stream, mode(FullMode)), 315 stream_mode(FullMode, Mode), 316 ( stream_property(Stream, file_name(Object0)) 317 -> true 318 ; stream_property(Stream, file_no(Object0)) 319 -> true 320 ; Object0 = [] 321 ), 322 Object = Object0. 323 324stream_mode(read, read). 325stream_mode(write, write). 326stream_mode(append, write). 327stream_mode(update, write). 328 329%! stream_position(+Stream, -Old, +New) 330% 331% True when Old is the current position in Stream and the stream 332% has been repositioned to New. 333% 334% @deprecated New code should use the ISO predicates 335% stream_property/2 and set_stream_position/2. 336 337stream_position(Stream, Old, New) :- 338 stream_property(Stream, position(Old)), 339 set_stream_position(Stream, New). 340 341 342%! skip_line is det. 343%! skip_line(Stream) is det. 344% 345% Skip the rest of the current line (on Stream). Same as 346% =|skip(0'\n)|=. 347 348skip_line :- 349 skip(10). 350skip_line(Stream) :- 351 skip(Stream, 10). 352 353 354 /******************************* 355 * COMPILATION * 356 *******************************/ 357 358%! compile(+Files) is det. 359% 360% Compile files. SWI-Prolog doesn't distinguish between 361% compilation and consult. 362% 363% @see load_files/2. 364 365:- meta_predicate 366 compile(). 367 368compile(Files) :- 369 consult(Files). 370 371 /******************************* 372 * ATOM-HANDLING * 373 *******************************/ 374 375%! atom_char(+Char, -Code) is det. 376%! atom_char(-Char, +Code) is det. 377% 378% Same as ISO char_code/2. 379 380atom_char(Char, Code) :- 381 char_code(Char, Code). 382 383%! midstring(?ABC, ?B, ?AC) is nondet. 384%! midstring(?ABC, ?B, ?AC, LenA) is nondet. 385%! midstring(?ABC, ?B, ?AC, LenA, LenB) is nondet. 386%! midstring(?ABC, ?B, ?AC, LenA, LenB, LenC) is nondet. 387% 388% Too difficult to explain. See the Quintus docs. As far as I 389% understand them the code below emulates this function just fine. 390 391midstring(ABC, B, AC) :- 392 midstring(ABC, B, AC, _, _, _). 393midstring(ABC, B, AC, LenA) :- 394 midstring(ABC, B, AC, LenA, _, _). 395midstring(ABC, B, AC, LenA, LenB) :- 396 midstring(ABC, B, AC, LenA, LenB, _). 397midstring(ABC, B, AC, LenA, LenB, LenC) :- % -ABC, +B, +AC 398 var(ABC), 399 !, 400 atom_length(AC, LenAC), 401 ( nonvar(LenA) ; nonvar(LenC) 402 -> plus(LenA, LenC, LenAC) 403 ; true 404 ), 405 sub_atom(AC, 0, LenA, _, A), 406 LenC is LenAC - LenA, 407 sub_atom(AC, _, LenC, 0, C), 408 atom_length(B, LenB), 409 atomic_list_concat([A,B,C], ABC). 410midstring(ABC, B, AC, LenA, LenB, LenC) :- 411 sub_atom(ABC, LenA, LenB, LenC, B), 412 sub_atom(ABC, 0, LenA, _, A), 413 sub_atom(ABC, _, LenC, 0, C), 414 atom_concat(A, C, AC). 415 416 417 /******************************* 418 * EXCEPTIONS * 419 *******************************/ 420 421%! raise_exception(+Term) 422% 423% Quintus compatible exception handling 424 425raise_exception(Term) :- 426 throw(Term). 427 428%! on_exception(+Template, :Goal, :Recover) 429 430:- meta_predicate 431 on_exception(, , ). 432 433on_exception(Except, Goal, Recover) :- 434 catch(Goal, Except, Recover)