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