1% ---------------------------------------------------------------------- 2% BEGIN LICENSE BLOCK 3% Version: CMPL 1.1 4% 5% The contents of this file are subject to the Cisco-style Mozilla Public 6% License Version 1.1 (the "License"); you may not use this file except 7% in compliance with the License. You may obtain a copy of the License 8% at www.eclipse-clp.org/license. 9% 10% Software distributed under the License is distributed on an "AS IS" 11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 12% the License for the specific language governing rights and limitations 13% under the License. 14% 15% The Original Code is The ECLiPSe Constraint Logic Programming System. 16% The Initial Developer of the Original Code is Cisco Systems, Inc. 17% Portions created by the Initial Developer are 18% Copyright (C) 1992-2006 Cisco Systems, Inc. All Rights Reserved. 19% 20% Contributor(s): ECRC GmbH 21% 22% END LICENSE BLOCK 23% 24% System: ECLiPSe Constraint Logic Programming System 25% Version: $Id: megalog.pl,v 1.3 2011/04/01 07:12:07 jschimpf Exp $ 26% ---------------------------------------------------------------------- 27 28 29/* 30** File : megalog.pl 31** Author : Michael Dahmen 32** Content: MegaLog compatibility package for Sepia 33** 34** This package provides compatibility to MegaLog in Sepia. 35** It is intended that a user who moves his/her programs from 36** MegaLog to Sepia will use this package, if (s)he wants to 37** prevent changes in his/her sources. Please note that only 38** a partial compatibility is achieved, however the missing parts 39** are really minor. Look for %% to find predicates with incomplete 40** compatibility. Also note that at some points (e.g. retract/1) 41** compatibility effectively means reduced functionality. 42** We therefore recommend to remove those parts of this file 43** that are unwanted. 44** 45** If the user wants to ignore the module system of Sepia it 46** is sufficient to load this file, change to module megalog, 47** and never leave that module. If the module system is used 48** one must take care of tool predicates and visibility of 49** predicates. 50*/ 51 52:- module(megalog). 53 54/* 55 -------------------------------- 56 | Import the MegaLog Libraries | 57 -------------------------------- 58*/ 59 60:- import database_kernel. 61 62:- (use_module(library(kb)) -> true). % ptags... 63 64:- use_module(library(oldio)). 65 66:- import knowledge_base. 67 68/* simpler syntax for predicate overwriting (ala common-lisp) */ 69/* This syntax is removed at the end of this file */ 70 71:- set_flag(macro_expansion, on). 72:- op(800,xfx,::). 73 74transform_module_qualifier(Module::Goal,call_explicit(Goal,Module)). 75:- define_macro((::)/2,transform_module_qualifier/2,[]). 76 77% 78% Megalog operators, called here before op/3 is redefined. 79% 80:- op(950, fx, foreach). 81:- op(955, xfx, do). 82:- op(1000, fy, (ls)). 83:- op(0, xfx, from). 84 85:- local 86 op/3, 87 compound/1. 88 89 90/* 91 ---------------------------------------- 92 | Section 9 -- MegaLog Window Debugger | 93 ---------------------------------------- 94*/ 95 96/* 97There are several differences in the predicate interface to the 98debugger (e.g. nospy, debug_parameter). Also the functionality 99of the debuggers are different. Some of the very useful MegaLog 100functionalities (e.g. source display, zoom) are only available via 101KEGI or Opium. 102*/ 103 104 105/* 106 ------------------------------ 107 | Section 13.1 -- Arithmetic | 108 ------------------------------ 109*/ 110 111/* 112MegaLog : X is Expression 113Sepia : same 114 115Note : %% hyperbolic radial functions are missing in Sepia because 116 of limited portability 117 %% X is cputime refers to absolute value in Sepia (delta in MegaLog) 118*/ 119 120/* 121MegaLog : extra random/3, different name 122*/ 123 124random(Min,Max,Value) :- 125 Min > Max, 126 !, 127 error(6,random(Min,Max,Value)). % error 6 = out_of_range 128random(Min,Max,Value) :- 129 random(R), 130 Value is (R mod (Max - Min + 1)) + Min. 131 132srandom(Seed) :- seed(Seed). 133 134/* 135 ------------------------------------- 136 | Section 13.1 -- Internal Database | 137 ------------------------------------- 138*/ 139 140/* 141MegaLog : abolish, dynamic -- takes bracket list as argument [a,b,c] 142 retract -- succeed only once 143Sepia : abolish, dynamic -- takes comma list as argument a,b,c 144 retract -- succeed many times 145 146Note : The interpretation of :- dynamic f/1, assert(f(1)) 147 is different. In MegaLog the first is a declaration, the 148 second a goal. In Sepia it is seen as a single declaration 149 which then generates an error. 150*/ 151 152abolish [] :- !. 153abolish [H|T] :- !, abolish H, abolish T. 154abolish P :- is_predicate(P), !, sepia_kernel::abolish(P). 155abolish _. % succeed if it doesn't exist 156 157clauses(Name/Arity,Clauses) :- 158 length(List,Arity), 159 Head =.. [Name|List], 160 findall((Head :- Body),clause((Head :- Body)),Clauses). 161 162dynamic [] :- !. 163dynamic [H|T] :- !, sepia_kernel::dynamic(H), dynamic T. 164dynamic P :- sepia_kernel::dynamic(P). 165 166listing [] :- !. 167listing [H|T] :- !, sepia_kernel::listing(H), listing T. 168listing P :- sepia_kernel::listing(P). 169 170 171ls X :- listing X. 172 173retract(Clause) :- sepia_kernel::retract(Clause),!. 174% Note : This compatibility is probably unwanted 175 176/* 177MegaLog : If assert, retract etc. is applied to a compiled procedure 178 the procedure is abolished and an empty dynamic procedure 179 is created 180Sepia : Error 63 is raised in such a situation 181 182MegaLog : If a procedure is compiled the asserted clauses are removed 183Sepia : Asserted and compiled clauses coexist 184 185Note : The error handler defined below solves some of these problems 186 but not all. We recomment to review your program wrt. use 187 of asserted clauses. 188 %% 189*/ 190 191error_handler_63(63,Culprit) :- 192 sepia_kernel::compound(Culprit), 193 Culprit =.. [Functor,Clause], 194 member(Functor,[assert, asserta, assertz, retract]), 195 (Clause = (Head :- _) ; Clause = Head), 196 functor(Head,F,Arity), 197 ((sepia_kernel::is_predicate(F/Arity), abolish(F/Arity));true), 198 dynamic(F/Arity), 199 !, 200 call(Culprit). 201 202error_handler_63(63,retract_all(Head)) :- 203 Head =.. [F|Args], 204 length(Args,Arity), 205 abolish(F/Arity), 206 dynamic(F/Arity), 207 !. 208error_handler_63(63,Culprit) :- 209 sepia_kernel::error_handler(63,Culprit). 210 211:- sepia_kernel::set_error_handler(63,error_handler_63/2). 212 213 214/* 215 -------------------------- 216 | Section 13.3 -- Arrays | 217 -------------------------- 218*/ 219 220/* 221MegaLog : Arity two 222Sepia : Arity three 223*/ 224 225is_array(Name,Arity) :- 226 functor(Array, Name, Arity), 227 current_array(Array, _). 228 229/* 230MegaLog : erase_array/1 succeeds silently if array does not exist 231Sepia : raise error 41 232 233Note : This has a global effect in all modules 234%% 235*/ 236 237error_handler_41(41,erase_array(_),_) :- 238 !. 239error_handler_41(41,getval(_,_),_) :- 240 % This clause achieves that non existing global variables 241 % are initialized with an unbound variable as value 242 % such an error is defined by EKS 243 !. 244error_handler_41(41,Goal,Module) :- 245 sepia_kernel::undef_array_handler(41,Goal,Module). 246 247:- sepia_kernel::set_error_handler(41,error_handler_41/3). 248 249/* 250MegaLog : make_array/1 /2 succeeds silently if array already exists 251 exists with same boundaries 252 error and failure if array exists with different boundaries 253Sepia : raise warning and succeed in any case 254%% 255*/ 256 257 258/* 259 260 ---------------------------------- 261 | Section 13.4 -- Error Handling | 262 ---------------------------------- 263*/ 264 265/* 266MegaLog : return highest valid error code 267%% The error codes are completely different. 268%% Any usage of set_error_handler/2 in user program need a revision. 269%% The condition under which builtins raise errors are different. 270*/ 271 272max_error(340). % 340 is first user defined error 273 274set_error_handler(Code,Goal) :- 275 writeln("Warning : Error Code and Handler are different in MegaLog"), 276 writeln("Handler not installed"), 277 writeln(set_error_handler(Code,Goal)). 278 279/* 280 -------------------------- 281 | Section 13.5 -- Blocks | 282 -------------------------- 283*/ 284 285/* 286MegaLog : block/3 is deterministic 287Sepia : block/3 backtracks 288*/ 289 290block(Goal,Tag,Recover) :- sepia_kernel::block((Goal,!),Tag,Recover). 291 292/* 293MegaLog : unwind protect operations (defined in pred0.pl) 294*/ 295 296/* <event>_protect(Goal,Action) 297** 298** will protect the Action in the context of <event> i.e. Action is 299** executed when Goal is left with <event> 300** Action may be any Prolog goal, however there will be no backtracking 301** back into Action later on. There will also be no backtracking into 302** <event>_protect. 303** 304** <event> is one of 305** exit 306** exit_fail 307** exit_success 308** exit_fail_success 309** and selects against which events there is a protection (one of). 310** Protection against exit refers to the use of exit_block/1 in 311** context of block/3 312** 313** %% Note that protection against cut and cut_fail is not supported 314** in Sepia. This feature was marked non-portable in the MegaLog 315** manual. 316*/ 317 318exit_protect(Goal,Action) :- 319 block(Goal,Tag,(once_not_fail(Action),exit_block(Tag))). 320 321exit_fail_protect(Goal,Action) :- 322 block(Goal,Tag,(once_not_fail(Action),exit_block(Tag))), 323 !. 324exit_fail_protect(_Goal,Action) :- 325 once(Action), 326 fail. 327 328exit_success_protect(Goal,Action) :- 329 block(Goal,Tag,(once_not_fail(Action),exit_block(Tag))), 330 once_not_fail(Action). 331 332exit_fail_success_protect(Goal,Action) :- 333 block(Goal,Tag,(once_not_fail(Action),exit_block(Tag))), 334 once_not_fail(Action), 335 !. 336exit_fail_success_protect(_Goal,Action) :- 337 once(Action), 338 fail. 339 340 341/* 342 ----------------------- 343 | Section 13.6 -- I/O | 344 ----------------------- 345*/ 346 347/* 348** %% Handling of cyclic terms is different 349** MegaLog : cyclic terms are detected and printed with <-> #n# 350** Sepia : default printing is with depth limitation 351*/ 352 353/* 354** Argument order is different 355** MegaLog : Data, Stream 356** Sepia : Stream, Data 357** 358** Note : This is solved by an 'lib(oldio), import(oldio)' *before* 359** calling 'lib(megalog), import(megalog)' 360** The two warnings about name clashes on get/2 / get0/2 can be 361** ignored, they only reflect that these two predicates are 362** redefined for MegaLog compatibility. 363*/ 364 365/* 366** %% Flush handling is different 367** MegaLog : flushs after each term output 368** Sepia : extra flush predicate, flush before terminal input, flush at 369** top level 370** Note : in effect there is no real difference for 'normal' users 371*/ 372 373/* 374MegaLog : get ignores blanks, get0 takes all, skip over input 375Sepia : get takes all 376*/ 377 378get(X) :- repeat,sepia_kernel::get(X),X > 32,!. 379get(X,S) :- repeat,sepia_kernel::get(S,X),X > 32,!. 380% since get/1 /2 is originally Prolog defined this definition must be 381% compiled before any client code is compiled 382 383get0(X) :- sepia_kernel::get(X). 384get0(X,S) :- sepia_kernel::get(S,X). 385skip(C) :- repeat,sepia_kernel::get_char(C),!. 386skip(C,S) :- repeat,sepia_kernel::get_char(S,C),!. 387 388/* 389MegaLog : buffered I/O level (stream_id = 'C' pointer) 390Sepia : raw I/O level (stream_id = 0,1,2,...) 391 392Note : get_stream/2 is identical 393*/ 394 395%% set_io(A,B). % difficult to achieve, questionable wether used 396 397/* 398MegaLog : accept string as second argument 399Sepia : must be an atom 400*/ 401 402open(File,Mode,Stream) :- 403 string(Mode), 404 !, 405 atom_string(ModeA,Mode), 406 open(File,ModeA,Stream). 407open(File,Mode,Stream) :- 408 sepia_kernel::open(File,Mode,Stream). 409 410 411/* 412MegaLog : exists in arity two and three 413Sepia : arity three only 414*/ 415 416readvar(Term,VarList) :- sepia_kernel::readvar(input,Term,VarList). 417 418/* 419MegaLog : used in PCE connection only (no flush), not in manual 420*/ 421 422%% writeq_nf(Term). 423%% writeq_nf(Term,Stream). 424 425/* 426MegaLog : allows to replace variable names during output 427 while all others are written in a read back style 428Note : questionable, one feature is pretty-print like, one is read 429 back (i.e. internal use) like 430*/ 431 432%% writeqvar(Term,VariableList). 433%% writeqvar(Term,VariableList,Stream). 434 435/* 436 --------------------------- 437 | Section 13.7 -- Control | 438 --------------------------- 439*/ 440 441abort :- exit_block(abort). 442 443once_not_fail(Goal) :- once(Goal),!. 444once_not_fail(_). 445 446/* 447MegaLog : debugger related, mentioned in manual therefore may be used 448*/ 449 450object_call(Goal) :- call(Goal). 451%% call_with_cutpt(Goal,CutPt). % not needed, not in manual 452%% object_call_with_cutpt(Goal,CutPt). % not needed, not in manual 453 454/* 455 -------------------------------- 456 | Section 13.8 -- Object Files | 457 -------------------------------- 458*/ 459 460/* 461MegaLog : capability to generate and load object files 462Sepia : use either saved states or Prolog term files 463Note : program development environment only 464*/ 465 466silent_compile(F) :- compile(F). 467 468%% clear_directives. 469%% load_object(File). 470%% save_object(Object,Source). 471 472/* 473MegaLog : capability to compile on a clause base, compare and execute 474 these clauses, remove clauses compiled 475 476Note : not needed if no compiled code in external KB, 477 code in ml_ecc.pl / ml_bang_builtins.pl is modified accordingly 478 not in manual 479*/ 480 481%% '$execute'(Code,Argument). 482%% '$execute_with_cutpt'(Code,Argument,CutPt). 483%% compile_clause(Clause,Code). 484%% emulator_register(register,Value). 485%% eq_clauses(Code1, Code2). 486%% install_proc(Name,Arity,Code). 487%% remove_clause(Code). 488 489/* 490 ------------------------------------------------ 491 | Section 13.9, 13.10, 13.11 -- Knowledge Base | 492 ------------------------------------------------ 493*/ 494 495/* This is copied completely from MegaLog into Sepia-MegaLog integration */ 496 497 498/* 499 ---------------------------------- 500 | Section 13.12 -- All Solutions | 501 ---------------------------------- 502*/ 503 504/* Identical !!! ??? */ 505 506/* 507 --------------------------------------- 508 | Section 13.13 -- String & Coversion | 509 --------------------------------------- 510*/ 511 512/* 513MegaLog : accept atoms, string, integers, reals 514 result is string, atom given fails 515*/ 516 517concat(A,B,C) :- atom(A), !, atom_string(A,A1), concat(A1,B,C). 518concat(A,B,C) :- atom(B), !, atom_string(B,B1), concat(A,B1,C). 519concat(A,B,C) :- number(A), !, term_string(A,A1), concat(A1,B,C). 520concat(A,B,C) :- number(B), !, term_string(B,B1), concat(A,B1,C). 521concat(A,B,C) :- sepia_kernel::concat_strings(A,B,C). 522 523/* 524MegaLog : only different name, rsp. differnt arity 525*/ 526 527strlength(String,Length) :- string_length(String,Length). 528substring(String1,String2) :- substring(String1,String2,_Position). 529 530/* 531MegaLog : Substring search for upper/lower case are considered equal 532 533Note : Defined in ml_builtins.c, global in Sepia-MegaLog integration 534 in manual, however only used for demo (libdb) by Michel Kuntz) 535 536 substring_ignore_case(String1,String2). 537 substring_ignore_case(String1,String2,Position). 538*/ 539 540:- external(substring_ignore_case/2, 'SBIsubstring_ignore_case2'). 541:- external(substring_ignore_case/3, 'SBIsubstring_ignore_case3'). 542 543/* 544MegaLog : allow to use a variable list during conversion (both ways) 545 546Note : Requires MegaLog parser/printer and can therefore not be ported 547 to Sepia. 548*/ 549 550%% term_string(Term,String,VariableList). 551 552/* 553 -------------------------------- 554 | Section 13.14 -- Environment | 555 -------------------------------- 556*/ 557 558/* 559MegaLog : access to a number of internal variable (database & Prolog) 560 561Note : Defined in ml_builtins.c, global in Sepia-MegaLog integration 562 mentioned in manual 563 Prolog machine related parameter will raise a warning in 564 Sepia-MegaLog integration 565 566 prolog_parameter(Name,Value). 567*/ 568 569:- external(prolog_parameter/2, 'SBIprolog_parameter'). 570 571/* 572MegaLog : Garbage Collector interface 573*/ 574 575force_stack_gc :- garbage_collect. 576 577%% force_code_gc. % No need for a code GC in Sepia 578%% force_did_gc. % No DID GC yet in Sepia 579 580/* 581MegaLog : histoy handling 582Sepia : lib(history) 583*/ 584 585history :- history::h. 586history_length(_). %% What is the length of the Sepia history ? 587 588/* 589MegaLog : Invocation of editor on source code 590Note : Debugger related functionality (implementation wise) 591 therefore dropped 592*/ 593 594%% editC PredSpec. 595%% edit PredSpec. 596 597/* 598MegaLog : Operators global visible, must be abolished before redefinition 599Sepia : Operators either local or global, direct overwrite possible, 600 local abolish impossible if not local defined 601Note : All operator definitions are done only locally in module megalog 602 operator are not removed 603*/ 604 605op(0,Assoc,Name) :- !, 606 writeln("Warning : Operators are module sensitive in Sepia"), 607 write(op(0,Assoc,Name)), 608 writeln("-- operator not abolished"). 609op(Prec,Assoc,Name) :- 610 writeln("Warning : Operators are module sensitive in Sepia"), 611 write(op(Prec,Assoc,Name)), 612 writeln("-- defined locally in module megalog only"), 613 sepia_kernel::op(Prec,Assoc,Name). 614 615 616current_symbol(Name / 0) :- 617 current_atom(Name). 618current_symbol(Name / Arity) :- 619 current_functor(Name / Arity). 620 621 622/* 623MegaLog : returns builtin, prolog, dynamic 624*/ 625 626defined_procedure(Name,Arity,builtin) :- is_built_in(Name/Arity),!. 627defined_procedure(Name,Arity,dynamic) :- is_dynamic(Name/Arity),!. 628defined_procedure(Name,Arity,prolog ) :- is_predicate(Name/Arity). 629 630/* 631MegaLog : get source file and line of definition 632Sepia : information available with get_flag/3 633 634Note : menitoned in manual, used by debugger/editor only 635*/ 636 637procedure_table(Name,Arity,File,Line) :- 638 get_flag(Name/Arity,source_file,File), 639 get_flag(Name/Arity,source_line,Line). 640 641/* 642 ------------------------------- 643 | Section 13.15 -- Statistics | 644 ------------------------------- 645*/ 646 647/* 648MegaLog : implicit difference computation 649Sepia : absolute values and only cputime/1 exists 650 651Note : one should use current_time/2 and delta_time/2 instead 652*/ 653 654:- setval(memory_cpu,0), setval(memory_elapsed,0). 655:- setval(memory_system,0), setval(memory_user,0). 656 657cputime(Delta) :- 658 current_time(cpu,Now), 659 getval(memory_cpu,Last), 660 Delta is Now - Last, 661 setval(memory_cpu,Now). 662 663elapsed_time(Delta) :- 664 current_time(elapsed,Now), 665 getval(memory_elapsed,Last), 666 Delta is Now - Last, 667 setval(memory_elapsed,Now). 668 669system_cpu_time(Delta) :- 670 current_time(system_cpu,Now), 671 getval(memory_system,Last), 672 Delta is Now - Last, 673 setval(memory_system_,Now). 674 675user_cpu_time(Delta) :- 676 current_time(user_cpu,Now), 677 getval(memory_user,Last), 678 Delta is Now - Last, 679 setval(memory_user,Now). 680 681/* 682MegaLog : number of timers from database system 683 684Note : Defined in ml_builtins.c, global in Sepia-MegaLog integration 685 mentioned in manual 686 687 current_time(timer,Value). 688 delta_time(timer,Value). 689*/ 690 691/* 692MegaLog : statistics support 693 694Note : Defined in ml_builtins.c, global in Sepia-MegaLog integration 695 mentioned in manual 696 697 resource(A,B,C). % UNIX access 698 statistics_heap. % Heap Organization 699 700Note : Defined in ml_bang_builtins.c, global in Sepia-MegaLog integration 701 mentioned in manual 702 703 statistics_bang. 704 statistics_bang_join. 705 statistics_desc. 706 statistics_relation(R). 707 708Note : Defined in ml_lock.c, global in Sepia-MegaLog integration 709 mentioned in manual 710 711 statistics_lock. % shared memory system only 712*/ 713 714statistics_heap :- statistics. 715 716%% print_gc_statistics.== statistics_gc % old name, not in MegaLog manual 717 718%% statistics_code. % Not need in Sepia 719%% statistics_did. % symbol table, must be copied 720%% statistics_gc. % stack GC, may already exist 721 722/* 723 ---------------------------------- 724 | Section 13.16 -- OS Connection | 725 ---------------------------------- 726*/ 727 728/* 729MegaLog : return atom, no trailing / 730 accept atom or string, optional trailing / without effect 731Sepia : return string, with trailing / 732 accept atom or string, optional trailing / without effect 733*/ 734 735chdir(Path_ma) :- var(Path_ma), !, 736 get_flag(cwd,Path_ss), 737 append_strings(Path_ms,"/",Path_ss), 738 atom_string(Path_ma,Path_ms), 739 !. 740chdir(Path_ma) :- 741 set_flag(cwd,Path_ma). 742 743/* 744MegaLog : atom 745Sepia : string with newline character at end 746*/ 747 748date(X) :- 749 sepia_kernel::date(Y), 750 append_strings(Z,"\n",Y), 751 atom_string(X,Z), 752 !. 753 754/* 755MegaLog : Test is file exists, checks permissions and ignored directories 756 757Note : Defined in builtins.c 758 mentioned in manual 759 exists/1 in Sepia checks existance, even directories 760 761 file_exist(File,Mode). 762*/ 763 764file_exists(File, read) :- 765 !, 766 get_file_info(File, mode, M), 767 M /\ 8'40000 =:= 0, 768 M /\ 8'444 =\= 0. 769file_exists(File, write) :- 770 !, 771 get_file_info(File, mode, M), 772 M /\ 8'40000 =:= 0, 773 M /\ 8'200 =\= 0. 774 775/* 776MegaLog : Get last modification time of a file 777 778 file_modify_time(file,Time). 779*/ 780 781file_modify_time(File, Time) :- 782 get_file_info(File, mtime, Time). 783 784/* 785MegaLog : Follows symbolic links, expands relative paths 786 787Note : Defined in builtins.c 788 limited portability to non BSD systems 789 790 full_path_name(name, FullName). 791*/ 792 793:- external(full_path_name/2, 'SBIfull_path_name'). 794 795/* 796MegaLog : prompt and dark type-in 797 798Note : Defined in ml_builtins.c, global in Sepia-MegaLog integration 799 used by EKS if at all 800 801 getpass(Prompt,PassWord). 802*/ 803 804:- external(getpass/2, 'SBIgetpass'). 805 806/* 807MegaLog : accepts also reals and sleep less than a second 808Sepia : accepts integers only 809 810Note : Sepia will sleep longer, however, it is anyway not a real time 811 system where one could rely on the sleep duration 812*/ 813 814sleep(Time) :- X is fix(Time) + 1, sepia_kernel::sleep(X). 815 816/* 817 ------------------------------ 818 | Section 13.17 -- Utilities | 819 ------------------------------ 820*/ 821 822conc(A,B,C) :- append(A,B,C). 823 824/* 825MegaLog : this was added by the EKS team 826*/ 827 828do(foreach( Firstgoal), SecondGoal) :- 829 call(Firstgoal), 830 not(SecondGoal), 831 !, fail. 832do(foreach(_), _). 833 834/* 835 ------------------------------------ 836 | Section 13.18 -- Term Comparison | 837 ------------------------------------ 838*/ 839 840/* identical */ 841 842 843/* 844 --------------------------------- 845 | Section 13.18 -- Type Testing | 846 --------------------------------- 847*/ 848 849/* 850MegaLog : discriminate compound and list 851Sepia : only compound 852 853Note : This also affects arg/3, functor/3, =../2 which are more 854 general in Sepia 855 %% should they be redefined to generate more errors ?? 856*/ 857 858compound(Term) :- 859 sepia_kernel::compound(Term), 860 Term \= [_|_]. 861 862list([_|_]) ?- true. 863 864type_of([_|_],Type) ?- Type=list. 865type_of(Term,Type) :- sepia::type_of(Term,Type). 866 867 868/* 869 ----------------- 870 | Not in manual | 871 ----------------- 872*/ 873 874/* 875MegaLog : not mentioned in manual, but maybe used by users 876*/ 877 878ask_if_more :- writeln("More ?"), get(C), char_int(';',C), !, fail. 879ask_if_more. 880 881/* 882MegaLog : Arity two, spelling 883Sepia : Arity one, different spelling 884*/ 885 886is_builtin(Name,Arity) :- is_built_in(Name/Arity). 887 888/* 889MegaLog : used by some simple tools and demos only (see Antoine's work) 890 891Note : not needed 892*/ 893 894%% get_dic_and_gc(X). 895%% get_stack_limits(A,B,C). 896 897/* 898MegaLog : computes a hash value 899 900Note : Defined in builtins.c 901 declared as external in module 'kb' (ecc.pl) 902 903 hash(Term,Value). 904*/ 905 906 907/* 908MegaLog : additions for TP-1 benchmark, not in manual 909Sepia : Prolog written replacement as below 910 911Note : expo_random/2, random_ab/3, random_01/1 return float values 912*/ 913 914expo_random(Mean,Value) :- 915 random(R), 916 Value is - ln(R / (2^31 - 1)) * Mean. 917 918init_random_generation. 919 920init_random_generation(_). 921 922random_ab(Min,Max,Value) :- 923 Min > Max, 924 !, 925 error(6,random(Min,Max,Value)). % error 6 = out_of_range 926random_ab(Min,Max,Value) :- 927 random(R), 928 Value is (R / (2^31 - 1)) * (Max - Min) + Min. 929 930random_01(Value) :- random_ab(0,1,Value). 931 932 933/* 934 ------------------------------------ 935 | Database backwards compatibility | 936 ------------------------------------ 937*/ 938 939/* 940** old predicates included for compatibility 941** 942** These predicates are not documented, however they were documented 943** in earlier versions of the system. They should not be used any more. 944*/ 945 946savedb :- 947 bang_register(dbdirectory, Path), 948 closedb, 949 opendb(Path). 950 951quit :- (closedb; true), halt. 952 953bang_commit :- 954 transaction_commit. 955 956bang_undo :- 957 transaction_undo. 958 959destroyrel(X) :- bang_destroyrel(X). 960 961getglob(R,V) :- bang_register(R,V). 962 963initglob. 964 965elapsed_time_value(X) :- current_time(elapsed,X). 966 967statistics_bang_join. 968 969nbratts(Relname, Number) :- bang_arity(Relname, Number). 970 971nbrtups(Relname, Number) :- bang_cardinality(Relname, Number). 972 973att_type(Relname, Position, Type) :- bang_attribute(Relname, Position, Type). 974 975bang_createrel(RelName, Format) :- 976 bang_createrel(RelName, Format, [permanent]). 977 978bang_createrel_temp(RelName, Format) :- 979 bang_createrel(RelName, Format, [temporary]). 980 981current_relation(Name/Arity, permanent) :- 982 current_relation(Name/Arity). 983current_relation(Name/Arity, temporary) :- 984 current_temp_relation(Name/Arity). 985 986bang_select_temp(Rel, CondT, ProjL, RelOut) :- 987 bang_select(Rel, CondT, ProjL, RelOut, 0). 988bang_select_temp(Rel, CondT, ProjL, RelOut, Action) :- 989 bang_select(Rel, CondT, ProjL, RelOut, Action). 990 991bang_join_temp(R1, R2, CondT, ProjL, RelOut) :- 992 bang_join(R1, R2, CondT, ProjL, RelOut, 0). 993bang_join_temp(R1, R2, CondT, ProjL, RelOut, Action) :- 994 bang_join(R1, R2, CondT, ProjL, RelOut, Action). 995 996bang_diff_temp(R1, R2, CondT, ProjL, RelOut) :- 997 bang_diff(R1, R2, CondT, ProjL, RelOut, 0). 998bang_diff_temp(R1, R2, CondT, ProjL, RelOut, Action) :- 999 bang_diff(R1, R2, CondT, ProjL, RelOut, Action). 1000 1001degree_dr(Rel,Arity) :- degree(Rel,Arity). 1002 1003domains(Rel,Domains) :- call_explicit(domains(Rel,Domains), kb). 1004 1005help_dr(Rel) :- helpdrel(Rel). 1006 1007insert_clauses_silent_from(File) :- insert_clauses_from(File). 1008 1009exec(Goal) :- 1010 retrieve_clause((Goal :- Body)), 1011 call(Body)@knowledge_base. 1012 1013/* 1014Start and End Handling 1015 1016If this file is loaded with the Sepia -b option one would like to 1017start in module megalog directly. The error handler for error 150 1018achieves that. 1019 1020In MegaLog a user defined predicate halt_cleanup/0 was executed after 1021calling halt/0. Error 152 is raised when Sepia terminates. 1022 1023The close operation on the the MegaLog database and (optional) disconnect 1024from shared memory is done in 'C' (see sepia/bip_control.c: p_exit() ). 1025*/ 1026 1027handle_150(150,megalog). 1028 1029:- sepia_kernel::set_error_handler(150, handle_150/2). 1030 1031handle_152(152,_) :- 1032 is_predicate(halt_cleanup/0), 1033 !, 1034 halt_cleanup. 1035handle_152(152,_). 1036 1037:- sepia_kernel::set_error_handler(152, handle_152/2). 1038 1039/* remove special syntax used in this file (see top of file) */ 1040:- erase_macro((::)/2). 1041:- abolish_op((::),xfx). 1042 1043 1044 1045 1046