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) 1989-2006 Cisco Systems, Inc.  All Rights Reserved.
19%
20% Contributor(s): ECRC GmbH
21% Contributor(s): IC-Parc, Imperal College London
22%
23% END LICENSE BLOCK
24%
25% System:	ECLiPSe Constraint Logic Programming System
26% Version:	$Id: goedel.pl,v 1.2 2011/04/01 07:12:07 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29/*
30 * SEPIA PROLOG SOURCE MODULE
31 */
32
33%
34% Sepia modifications for SICStus Goedel
35%
36
37:- module(user).
38
39:- local
40	retractall/1.
41
42:- ensure_loaded(library(lists)).
43:- ensure_loaded(library(sorts)).
44:- reexport sicstus.
45
46
47:- set_flag(toplevel_module, user).
48
49:- local
50	prolog_flag/3.
51
52:- export
53	retractall/1.
54
55:- import
56	retract_all_body/2
57    from sepia_kernel.
58
59prolog_flag(compiling, _, _).
60prolog_flag(A, B, C) :-
61	call_explicit(prolog_flag(A, B, C), quintus).
62
63% Sepia fixes
64:- tool(retractall/1, retract_all_body/2).
65
66%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
67
68% Goedel compatibility
69
70:- local
71	plus/3,
72	times/3,
73	(mod)/3,
74	format/3.
75
76:- [init] -> true.	% because of ptags
77:- findall(F, ( (system_file(F); (system_file(sys_modules) -> true; F = sys_modules)),
78		     system_directory(D),
79	             join_string(D, F, DF),
80	             compile(DF)
81		   ), _).
82
83
84is_runtime_system :- fail.		% temporary
85
86display_usage(C) :-
87   usage(C, Lists),
88   lists_to_strings(Lists, Strings),
89   printf('%-25.25s %-5.5s  - %s%n', Strings).
90
91show_usage(Abbrev) :-
92   usage(Abbrev, Lists),
93   lists_to_strings(Lists, [U|_]),
94   printf(user_error, 'Syntax error, use %s%n%b', U).
95
96lists_to_strings([], []).
97lists_to_strings([H|T], [S|R]) :-
98	string_list(S, H),
99	lists_to_strings(T, R).
100
101my_load(X) :-
102	compile(X).
103
104file_exist(File, Suffix) :-
105	concat_atoms(File, Suffix, Name),
106	exists(Name).
107
108format(S, L, X) :-
109	ttyflush,
110	call_explicit(format(S, L, X), quintus),
111	flush(S).
112
113/*------------------------------------------------------------------------------
114 * evaluate_delay_aux
115 */
116
117evaluate_delay_aux(Delay, X):-
118	goedel_freeze_aux(Delay, [], Var_list, NewDelay),
119	( var(NewDelay)
120	  -> X = 1
121	  ;  prolog:'$disjunctive_geler'(Var_list,
122				call(evaluate_delay_aux(NewDelay, X))@user )
123	).
124
125translate_stream('IO.InputStreamDescriptor.F1'(List), Stream) :-
126   List = [Stream].
127translate_stream('IO.OutputStreamDescriptor.F1'(List), Stream) :-
128   List = [Stream].
129translate_stream('IO.StdIn.C0', user_input).
130translate_stream('IO.StdOut.C0', user_output).
131translate_stream('IO.StdErr.C0', user_error).
132
133%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
134% Simulate non-documented SICStus predicates
135
136:- module(prolog).
137:- tool('$disjunctive_geler'/2, disjunctive_geler_body/3).
138:- import
139	make_suspension/3
140    from sepia_kernel.
141
142disjunctive_geler_body(List, Goal, M) :-
143	check_vars(List),
144	!,
145	make_suspension(Goal, S, M),
146	insert_suspension(List, S, 1, top).
147disjunctive_geler_body(_, Goal, M) :-
148	call(Goal)@M.
149
150check_vars([]).
151check_vars([V|L]) :-
152	var(V),
153	check_vars(L).
154
155:- begin_module('IO').
156
157translate_stream('IO.InputStreamDescriptor.F1'(List), Stream) :-
158   List = [Stream].
159translate_stream('IO.OutputStreamDescriptor.F1'(List), Stream) :-
160   List = [Stream].
161translate_stream('IO.StdIn.C0', user_input).
162translate_stream('IO.StdOut.C0', user_output).
163translate_stream('IO.StdErr.C0', user_error).
164
165