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