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:- 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 * DIRECTIVES * 294 *********************************/ 295 296%! mode(+ModeDecl) is det. 297% 298% Ignore a DEC10/Quintus `:- mode(Head)` declaration. Typically 299% these declarations are written in operator form. The operator 300% declaration is not part of the Quintus emulation library. The 301% following declaration is compatible with Quintus: 302% 303% == 304% :- op(1150, fx, [(mode)]). 305% == 306 307mode(_). 308 309 310 /******************************* 311 * TYPES * 312 *******************************/ 313 314%! simple(@Term) is semidet. 315% 316% Term is atomic or a variable. 317 318simple(X) :- 319 ( atomic(X) 320 -> true 321 ; var(X) 322 ). 323 324 325 /******************************* 326 * STREAMS * 327 *******************************/ 328 329%! current_stream(?Object, ?Mode, ?Stream) 330% 331% SICStus/Quintus and backward compatible predicate. New code should 332% be using the ISO compatible stream_property/2. 333 334current_stream(Object, Mode, Stream) :- 335 stream_property(Stream, mode(FullMode)), 336 stream_mode(FullMode, Mode), 337 ( stream_property(Stream, file_name(Object0)) 338 -> true 339 ; stream_property(Stream, file_no(Object0)) 340 -> true 341 ; Object0 = [] 342 ), 343 Object = Object0. 344 345stream_mode(read, read). 346stream_mode(write, write). 347stream_mode(append, write). 348stream_mode(update, write). 349 350%! stream_position(+Stream, -Old, +New) 351% 352% True when Old is the current position in Stream and the stream 353% has been repositioned to New. 354% 355% @deprecated New code should use the ISO predicates 356% stream_property/2 and set_stream_position/2. 357 358stream_position(Stream, Old, New) :- 359 stream_property(Stream, position(Old)), 360 set_stream_position(Stream, New). 361 362 363%! skip_line is det. 364%! skip_line(Stream) is det. 365% 366% Skip the rest of the current line (on Stream). Same as 367% =|skip(0'\n)|=. 368 369skip_line :- 370 skip(10). 371skip_line(Stream) :- 372 skip(Stream, 10). 373 374 375 /******************************* 376 * COMPILATION * 377 *******************************/ 378 379%! compile(+Files) is det. 380% 381% Compile files. SWI-Prolog doesn't distinguish between 382% compilation and consult. 383% 384% @see load_files/2. 385 386:- meta_predicate 387 compile(). 388 389compile(Files) :- 390 consult(Files). 391 392 /******************************* 393 * ATOM-HANDLING * 394 *******************************/ 395 396%! atom_char(+Char, -Code) is det. 397%! atom_char(-Char, +Code) is det. 398% 399% Same as ISO char_code/2. 400 401atom_char(Char, Code) :- 402 char_code(Char, Code). 403 404%! midstring(?ABC, ?B, ?AC) is nondet. 405%! midstring(?ABC, ?B, ?AC, LenA) is nondet. 406%! midstring(?ABC, ?B, ?AC, LenA, LenB) is nondet. 407%! midstring(?ABC, ?B, ?AC, LenA, LenB, LenC) is nondet. 408% 409% Too difficult to explain. See the Quintus docs. As far as I 410% understand them the code below emulates this function just fine. 411 412midstring(ABC, B, AC) :- 413 midstring(ABC, B, AC, _, _, _). 414midstring(ABC, B, AC, LenA) :- 415 midstring(ABC, B, AC, LenA, _, _). 416midstring(ABC, B, AC, LenA, LenB) :- 417 midstring(ABC, B, AC, LenA, LenB, _). 418midstring(ABC, B, AC, LenA, LenB, LenC) :- % -ABC, +B, +AC 419 var(ABC), 420 !, 421 atom_length(AC, LenAC), 422 ( nonvar(LenA) ; nonvar(LenC) 423 -> plus(LenA, LenC, LenAC) 424 ; true 425 ), 426 sub_atom(AC, 0, LenA, _, A), 427 LenC is LenAC - LenA, 428 sub_atom(AC, _, LenC, 0, C), 429 atom_length(B, LenB), 430 atomic_list_concat([A,B,C], ABC). 431midstring(ABC, B, AC, LenA, LenB, LenC) :- 432 sub_atom(ABC, LenA, LenB, LenC, B), 433 sub_atom(ABC, 0, LenA, _, A), 434 sub_atom(ABC, _, LenC, 0, C), 435 atom_concat(A, C, AC). 436 437 438 /******************************* 439 * EXCEPTIONS * 440 *******************************/ 441 442%! raise_exception(+Term) 443% 444% Quintus compatible exception handling 445 446raise_exception(Term) :- 447 throw(Term). 448 449%! on_exception(+Template, :Goal, :Recover) 450 451:- meta_predicate 452 on_exception(, , ). 453 454on_exception(Except, Goal, Recover) :- 455 catch(Goal, Except, Recover)