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