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: bsi.pl,v 1.2 2008/07/27 12:25:05 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29/*
30 * SEPIA PROLOG SOURCE MODULE
31 */
32
33/*
34 * IDENTIFICATION:	bsi.pl
35 *
36 * DESCRIPTION:
37 *
38 *
39 * CONTENTS:
40 *
41 */
42:- module(bsi).
43:- export
44%	syntax_option(no_other_quote),	% no longer supported by the lexer
45	syntax_option(no_array_subscripts),
46	chtab(0'$, symbol),
47	op(1100, xfy, '|'),
48	op(1000, xfy, '&'),
49	op(500, xfy, (\/)),
50	op(500, xfy, (/\)),
51	op(0, fy, (nospy)).
52
53:- system.		% compiler directive to add the SYSTEM flag
54
55:- export
56	at/2,
57	concat/3,
58	consult/1,
59	device/2,
60	display/1,
61	e/1,
62	open/3,
63	pi/1,
64	prolog_flag/3,
65	reconsult/1,
66	seek/2,
67	stream/3,
68	string_list/2,
69	strlength/2.
70
71:- import
72	error_handler/2,
73	eval/3,
74	import_body/2,
75	set_default_error_handler/2
76   from sepia_kernel.
77
78%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
79
80% to define current_input and current_output
81
82?-
83	set_stream(current_input,input),
84	set_stream(current_output,output).
85
86% consult and reconsult are not exactly like compile
87
88?-
89	tool(consult/1,consult_body/2),
90	tool(reconsult/1,reconsult_body/2).
91
92consult_body(X,M) :-
93	compile(X,M).
94
95reconsult_body(X,M) :-
96	compile(X,M).
97
98'|'(A -> B, _) :-
99	call(A), !, call(B).
100'|'(_ -> _, C) :-
101	!,
102	call(C).
103'|'(A, _) :-
104	call(A).
105'|'(_, B) :-
106	call(B).
107
108'&'(A, B) :-
109	call(A),
110	call(B).
111
112strlength(S,L) :-
113	string_length(S,L).
114
115concat(X,Y,Z) :-
116	var_or_string(X),
117	var_or_string(Y),
118	var_or_string(Z),
119	!,
120	concat_chk(X,Y,Z).
121concat(X, Y, Z) :-
122	error(5, concat(X, Y, Z)).
123
124concat_chk(X,Y,Z) :-
125	var(Z),
126	!,
127	((var(X) ; var(Y))  ->
128		error(4, concat(X, Y, Z))
129	;
130		concat_strings(X, Y, Z)
131	).
132concat_chk(X,Y,Z) :-
133	eclipse_language:string_list(Z, ZL),
134	append(XL, YL, ZL),
135	eclipse_language:string_list(X, XL),
136	eclipse_language:string_list(Y, YL).
137
138var_or_string(X) :-
139	var(X),
140	!.
141var_or_string(X) :-
142	string(X).
143
144
145% in bsi, the result is a list of characters
146
147string_list(S,L) :-
148	nonground(S),
149	nonground(L),
150	!,
151	error(4,string_list(S,L)).
152string_list(S,L) :-
153	nonground(S),
154	!,
155	convert_to_char(LI,L),
156	eclipse_language:string_list(S,LI).
157string_list(S,L) :-
158	eclipse_language:string_list(S,LI),
159	convert_to_char(LI,L).
160
161convert_to_char([],[]) :-
162	!.
163convert_to_char([HI|TI],[H|T]) :-
164	!,
165	char_int(H,HI),
166	convert_to_char(TI,T).
167convert_to_char(S,L) :-
168	error(5,string_list(S,L)).
169
170device(_,delete_file(F)) :-
171	!,
172	delete(F).
173device(S,P) :-
174	P =.. [F|L],
175	append(L,[S],NL),
176	NP =.. [F|NL],
177	NP.
178
179% display should always output to the terminal in bsi
180
181display(X) :-
182	get_stream(output,O),
183	set_stream(output, stdout),
184	eclipse_language:display(X),
185	set_stream(output,O).
186
187% BSI uses a descriptor which is implementation dependent.
188% Here, we consider a "sepia like" syntax, but open may be
189% redefined as : open(file(F),M,S) :- open(F,M,S)
190
191open(F,readwrite,S) :-
192	!,
193	eclipse_language:open(F,update,S).
194open(F,M,S) :-
195	eclipse_language:open(F,M,S).
196
197% the following predicates have the stream as first argument
198% in bsi, and as last argument in sepia
199
200at(S,Pos) :-
201	Pos \== end_of_file,
202	!,
203	eclipse_language:at(S, Pos).
204at(S,end_of_file) :-                     % according to bsi, always fails
205	fail.
206
207seek(S,Pos) :-
208	eclipse_language:seek(S, Pos).
209
210% prolog_flag is not fully implemented here
211
212prolog_flag(error_break,_,_) :-
213	!.
214prolog_flag(error_number,_,_) :-
215	!.
216prolog_flag(current_input,Old,New) :-
217	New == user,
218	!,
219	prolog_flag(current_input, Old, stdin).
220prolog_flag(current_input,Old,New) :-
221	get_stream(current_input,Old),
222	set_stream(current_input,New),
223	set_stream(input,New).
224prolog_flag(current_output,Old,New) :-
225	New == user,
226	!,
227	prolog_flag(current_output, Old, stdout).
228prolog_flag(current_output,Old,New) :-
229	get_stream(current_output,Old),
230	set_stream(current_output,New),
231	set_stream(output,New).
232
233
234% the descriptor is supposed to be the name of the file
235
236stream(Stream, Des, Mode) :-
237	current_stream(Des, Smode, Stream),
238	(	Smode = update
239	->	Mode = readwrite
240	;	Mode = Smode
241	).
242
243
244% arithmetic: all arithmetic builtins must evaluate their arguments.
245% in sepia only is/2 and the comparisons do it, else +/3 etc would
246% have to be tools ...
247% This leads to problems here, since the handler is called without
248% a module argument. We may therefore be unable to call a
249% user-defined arithmetic precidate (if it's not global).
250
251bsi_eval_handler(_, Goal) :-
252	arg(1, Goal, X),		% Goals has arity 3
253	eval(X, X1, bsi),
254	(number(X1) -> true ; var(X1) -> true ; error(5, Goal)),
255	arg(2, Goal, Y),
256	eval(Y, Y1, bsi),
257	(number(Y1) -> true ; var(Y1) -> true ; error(5, Goal)),
258	functor(Goal, F, A),
259	functor(NewGoal, F, A),
260	arg(1, NewGoal, X1),
261	arg(2, NewGoal, Y1),
262	(A == 3 ->
263	    arg(3, Goal, Res),
264	    arg(3, NewGoal, Res)
265	;
266	    true
267	),
268	call(NewGoal).			% we don't have the caller module!
269
270pi(X) :- X is pi.
271e(X) :- X is e.
272
273%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
274
275?-
276	skipped	at/2,
277		bsi_eval_handler/2,
278		concat/3,
279	        consult/1,
280		device/2,
281		display/1,
282		open/3,
283		prolog_flag/3,
284		reconsult/1,
285	        seek/2,
286		stream/3,
287		string_list/2,
288		strlength/2.
289?-
290	untraceable
291		bsi_eval_handler/2.
292
293:-
294	set_default_error_handler(198, fail/0),		% fail when past eof
295	reset_error_handler(198),
296	set_default_error_handler(24, bsi_eval_handler/2),
297	reset_error_handler(24).
298
299%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
300