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%
26% ECLiPSe kernel built-ins
27%
28% System:	ECLiPSe Constraint Logic Programming System
29% Version:	$Id: kernel_bips.pl,v 1.6 2014/07/11 02:30:18 jschimpf Exp $
30%
31% ----------------------------------------------------------------------
32
33% Part of module sepia_kernel
34
35:- system.
36
37:- export
38	substring/4,
39	substring/5,
40	sub_string/5,
41	string_concat/3,
42	append_strings/3,
43	keysort/2,
44	sort/2,
45	number_sort/2,
46	msort/2,
47	merge/3,
48	number_merge/3,
49	prune_instances/2,
50        wait/2.
51
52
53%----------------------------------------------------------------------
54% String builtins
55%----------------------------------------------------------------------
56
57
58:- export string_code/3.
59string_code(Index, String, Code) :-
60	string_code(Index, String, Code, 1).	% nondet
61
62
63:- export string_char/3.
64string_char(Index, String, Char) :-
65	( var(Index) ->
66	    string_length(String, Length),
67	    between(1, Length, 1, Index),
68	    get_string_code(Index, String, Code),
69	    char_code(Char, Code)
70	; integer(Index) ->
71	    get_string_code(Index, String, Code),
72	    char_code(Char, Code)
73	;
74	    error(5, string_code(Index, String, Char))
75	).
76
77
78
79/* append_strings(S1, S2, S3) iff String3 is the concatenation of
80* String1 and String2
81* Periklis Tsahageas/18-8-88
82* implements BSI's specification :
83* all arguments strings or variables, otherwise type error
84* if var(S3) and [var(S1) or var(S2)] : instantiation fault.
85* i.e. the normal prolog relation without infinite backtracking.
86*/
87
88% alias for compatibility with SWI
89string_concat(X,Y,Z) :-
90	append_strings(X,Y,Z).
91
92append_strings(X,Y,Z) :-
93	( var(Z) ->
94	    concat_strings(X,Y,Z)
95
96	; string(Z) ->
97	    ( var(X) ->
98		( var(Y) ->
99		    string_list(Z, ZL),
100		    append(XL, YL, ZL),
101		    string_list(X, XL),
102		    string_list(Y, YL)
103
104		; string(Y) ->
105		    string_length(Y, Ylen),
106		    Xlen is string_length(Z) - Ylen,
107		    Ypos is Xlen + 1,
108		    first_substring(Z, Ypos, Ylen, Y),	% may fail
109		    first_substring(Z, 1, Xlen, X)
110		;
111		    error(5, append_strings(X,Y,Z))
112		)
113	    ; string(X) ->
114		( var(Y) ->
115		    string_length(X, Xlen),
116		    first_substring(Z, 1, Xlen, X),	% may fail
117		    Ypos is Xlen + 1,
118		    Ylen is string_length(Z) - Xlen,
119		    first_substring(Z, Ypos, Ylen, Y)
120
121		; string(Y) ->
122		    concat_strings(X,Y,Z)
123		;
124		    error(5, append_strings(X,Y,Z))
125		)
126	    ;
127	    	error(5, append_strings(X,Y,Z))
128	    )
129	;
130	    error(5, append_strings(X,Y,Z))
131	).
132
133
134% substring(+String, ?Pos, ?Len, ?SubStr) :-
135%
136% This predicate conforms to the BSI substring/4 specification.
137% That's why all the error checks are there.
138% We implement it using the deterministic builtin
139% first_substring(+String, +Pos, +Len, ?SubStr).
140
141substring(String, Pos, Len, SubStr) :-
142	check_string(String),
143	( var(Pos) ->
144	    true
145	;
146	    integer(Pos) ->
147	    ( (Pos > 0) ->
148		true
149	    ;
150		set_bip_error(6)
151	    )
152	;
153	    set_bip_error(5)
154	),
155	check_var_or_arity(Len),
156	check_var_or_string(SubStr),
157	!,
158	(string(SubStr)->string_length(SubStr, Len); true),
159	Total is string_length(String) + 1,
160	( integer(Pos) ->
161	    ( integer(Len) ->
162		true
163	    ;
164		MaxLen is Total - Pos,
165		between(0, MaxLen, 1, Len)
166	    )
167	;
168	    ( integer(Len) ->
169		MaxPos is Total - Len,
170		between(1, MaxPos, 1, Pos)
171	    ;
172		between(1, Total, 1, Pos),
173		MaxLen is Total - Pos,
174		between(0, MaxLen, 1, Len)
175	    )
176	),
177	first_substring(String, Pos, Len, SubStr).
178
179substring(String, Pos, Len, SubStr) :-
180	get_bip_error(ErrorCode),
181	error(ErrorCode, substring(String, Pos, Len, SubStr)).
182
183
184% substring(+String, ?Before, ?Length, ?After, ?SubString) :-
185%
186% This predicate is true iff string 'String' can be split
187% into three pieces, 'StringL', 'SubString' and 'StringR'.
188% In addition it must be split so that 'Before' is the length
189% of string 'StringL', 'Length' is the length of string
190% 'SubString' and 'After' is the length of the string 'StringR'.
191% We implement it using the deterministic builtin
192% first_substring(+String, +Pos, +Len, ?SubStr).
193
194% alias for compatibility with SWI
195sub_string(String, Before, Length, After, SubString) :-
196	substring(String, Before, Length, After, SubString).
197
198substring(String, Before, Length, After, SubString) :-
199	check_string(String),
200	check_var_or_arity(Before),
201	check_var_or_arity(Length),
202	check_var_or_arity(After),
203	check_var_or_string(SubString),
204	!,
205	(string(SubString)->string_length(SubString, Length); true),
206	StringLength is string_length(String),
207	( integer(Before) ->
208	    ( integer(Length) ->
209		( integer(After) ->
210		    StringLength =:= Before + Length + After
211		; % 'After' is a var!
212		    After is StringLength - Before - Length,
213		    After >= 0
214		)
215	    ; % 'Length' is a var!
216		( integer(After) ->
217		    Length is StringLength - Before - After,
218		    Length >= 0
219		; % 'Length' and 'After' are vars!
220		    MaxLength is StringLength - Before,
221		    between(0, MaxLength, 1, Length),
222		    After is MaxLength - Length
223		)
224	    )
225	; % 'Before' is a var!
226	    ( integer(Length) ->
227		( integer(After) ->
228		    Before is StringLength - Length - After,
229		    Before >= 0
230		; % 'Before' and 'After' are vars!
231		    MaxBefore is StringLength - Length,
232		    between(0, MaxBefore, 1, Before),
233		    After is MaxBefore - Before
234		)
235	    ; % 'Before' and 'Length' are vars!
236		( integer(After) ->
237		    MaxBefore is StringLength - After,
238		    between(0, MaxBefore, 1, Before),
239		    Length is MaxBefore - Before
240		; % 'Before', 'Length' and 'After' are vars!
241		    between(0, StringLength, 1, Before),
242		    MaxLength is StringLength - Before,
243		    between(0, MaxLength, 1, Length),
244		    After is StringLength - Before - Length
245		)
246	    )
247	),
248        % first_substring/4 uses position, not index, so add 1.
249	Pos is Before + 1,
250	first_substring(String, Pos, Length, SubString).
251
252substring(String, Before, Length, After, SubString) :-
253	get_bip_error(ErrorCode),
254	error(ErrorCode, substring(String, Before, Length, After, SubString)).
255
256
257:- export string_list/3.
258string_list(String, List, Format) :- var(Format), !,
259	error(4, string_list(String, List, Format)).
260string_list(String, List, utf8) :- !,
261	utf8_list(String, List).
262string_list(String, List, bytes) :- !,
263	string_list(String, List).
264string_list(String, List, octet) :- !,
265	string_list(String, List).
266string_list(String, List, codes) :- !,
267	string_list(String, List).
268string_list(String, List, chars) :- !,
269	string_chars(String, List).
270string_list(String, List, Format) :-
271	error(6, string_list(String, List, Format)).
272
273
274:- export string_codes/2.	% SWI compatibility
275string_codes(String, Codes) :-
276	string_list(String, Codes).
277
278:- export string_chars/2.	% SWI compatibility
279string_chars(String, List) :-
280	( var(String) ->
281	    check_chars_list(List),
282	    !,
283	    concat_string(List, String)
284	; string(String) ->
285	    !,
286	    ( for(I,1,string_length(String)), foreach(C,List), param(String) do
287		string_code(String, I, Code),
288		char_code(C, Code)
289	    )
290	;
291	    error(5, string_chars(String, List))
292	).
293string_chars(String, List) :-
294	bip_error(string_chars(String, List)).
295
296    check_chars_list(X) :- var(X), !, set_bip_error(4).
297    check_chars_list([]) :- !.
298    check_chars_list([H|T]) :- !,
299	check_char(H),
300	check_chars_list(T).
301    check_chars_list(_) :-
302	set_bip_error(5).
303
304    check_char(X) :- var(X), !, set_bip_error(4).
305    check_char(X) :- atom(X), !,
306	( atom_length(X, 1) -> true ; set_bip_error(6) ).
307    check_char(_) :-
308	set_bip_error(5).
309
310
311%----------------------------------------------------------------------
312% Sort builtins
313%----------------------------------------------------------------------
314
315:- skipped
316	keysort/2,
317	sort/2,
318	number_sort/2,
319	msort/2,
320	merge/3,
321	number_merge/3,
322	prune_instances/2.
323
324%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
325
326/*
327:- mode
328	keysort(+, -),
329	merge(+, +, -),
330	msort(+, -),
331	sort(+, -),
332	number_sort(+, -),
333	prune_instances(+, -).
334*/
335
336
337keysort(R, S) :-
338	sort(1, =<, R, S).
339
340
341msort(R, S) :-
342	sort(0, =<, R, S).
343
344
345sort(R, S) :-
346	sort(0, <, R, S).
347
348
349number_sort(R, S) :-
350	number_sort(0, =<, R, S).
351
352
353merge(A, B, M) :-
354	merge(0, =<, A, B, M).
355
356
357number_merge(A, B, M) :-
358	number_merge(0, =<, A, B, M).
359
360
361prune_instances(List, Pruned) :-
362	% sorting the list first is not necessary, but likely to reduce
363	% the number of instance checks because duplicates are removed,
364	% identical functors are grouped together, and variables are
365	% moved to the front.
366	sort(List, PreSortedList),
367	prune_instances(PreSortedList, [], Pruned).
368
369:- mode prune_instances(+,+,?).
370prune_instances([First|Rest], SoFar, Result) :-
371	insert_pruned(First, SoFar, NewSoFar),
372	prune_instances(Rest, NewSoFar, Result).
373prune_instances([], Result, Result).
374
375% insert elem into the list (which is itself pruned)
376:- mode insert_pruned(?,+,-).
377insert_pruned(Elem, [], [Elem]).
378insert_pruned(Elem, [First|Rest], Result) :-
379	( instance(Elem, First) ->
380	    Result = [First|Rest]		% already subsumed by list
381	; instance(First, Elem) ->
382	    Result = [Elem|Res0],		% replace first instance
383	    remove_instances(Elem, Rest, Res0)	% remove any others
384	;
385	    Result = [First|Res0],
386	    insert_pruned(Elem, Rest, Res0)	% keep checking
387	).
388
389:- mode remove_instances(?,+,-).
390remove_instances(_Elem, [], []).
391remove_instances(Elem, [First|Rest], Result) :-
392	( instance(First, Elem) ->
393	    remove_instances(Elem, Rest, Result)
394	;
395	    Result = [First|Res0],
396	    remove_instances(Elem, Rest, Res0)
397	).
398
399%----------------------------------------------------------------------
400% OS builtins
401%----------------------------------------------------------------------
402
403wait(Pid, Status) :-
404	wait(Pid, Status, hang).
405