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: util.pl,v 1.3 2010/04/22 14:12:49 jschimpf Exp $ 27% ---------------------------------------------------------------------- 28 29/* 30 * SEPIA PROLOG SOURCE MODULE 31 * 32 * IDENTIFICATION: util.pl 33 * 34 * DESCRIPTION: Various utility predicates, for user convenience. 35 * 36 * CONTENTS: 37 * 38 */ 39 40:- module(util). 41 42:- comment(summary, "Various utility predicates for program development"). 43:- comment(categories, ["Programming Utilities"]). 44:- comment(author, "Various, ECRC Munich"). 45:- comment(copyright, "Cisco Systems, Inc"). 46:- comment(date, "$Date: 2010/04/22 14:12:49 $"). 47:- comment(add_path/1, [template:"add_path(+Directory)", 48 summary:"The directory will be added at the beginning of the library path." 49 ]). 50:- comment(add_suffix/1, [template:"add_suffix(+Suffix)", 51 summary:"The Suffix string will be added at the beginning of the prolog_suffix list." 52 ]). 53:- comment(between/3, [template:"between(+From, +To, ?I)", 54 summary:"Generates integers between From and To", 55 desc:html("Succeeds if From and To are integers and I unifies with a 56 number between the two. On backtracking it generates all 57 values for I starting from From onwards.")]). 58:- comment(compiled/0, [template:"compiled", 59 summary:"List all currently compiled files and indicate if they have been modified since they were compiled." 60 ]). 61:- comment(list_error/3, [template:"list_error(+String, -ErrNo, -ErrMsg)", 62 summary:"Find the event number whose message contains the specified substring" 63 ]). 64:- comment(read_line/2, [template:"read_line(+Stream, -String)", 65 summary:"Defined as read_string(Stream, end_of_line, _Length, String)" 66 ]). 67:- comment(read_line/1, [template:"read_line(-String)", 68 summary:"Defined as read_string(input, end_of_line, _Length, String)" 69 ]). 70:- comment(stream/1, [template:"stream(+Stream)", 71 summary:"List all information about the specified I/O stream" 72 ]). 73:- comment(streams/0, [template:"streams", 74 summary:"List information about the currently opened I/O streams" 75 ]). 76:- comment(time/1, [template:"time(Goal)", 77 summary:"Call the goal Goal, measure its runtime (cputime) and print the result after success or failure" 78 ]). 79:- comment(edit/1, [template:"edit(+PredSpec)", 80 summary:"Invoke an editor on the source of the specified predicate (UNIX only)" 81 ]). 82:- comment(file_info/1, [template:"file_info(+File)", 83 summary:"List all information about the specified File" 84 ]). 85:- comment(interface/1, [template:"interface(+Module)", 86 summary:"List the module interface of the specified Module" 87 ]). 88 89 90:- export 91 add_path/1, 92 add_suffix/1, 93 between/3, 94 c_compile_and_load/1, 95 compiled/0, 96 compile_selection/0, 97 edit/1, 98 file_info/1, 99 list_error/3, 100 interface/1, 101 stream/1, 102 streams/0, 103 read_line/1, 104 read_line/2, 105 time/1. 106 107 108% add_path(+Path) - prepend a directory to the library path 109 110add_path(Path) :- 111 get_flag(library_path, X), 112 set_flag(library_path, [Path|X]). 113 114add_suffix(Suffix) :- 115 get_flag(prolog_suffix, X), 116 set_flag(prolog_suffix, [Suffix|X]). 117 118 119% streams - print a table of currently opened streams 120 121streams :- 122 current_stream(S), 123 get_stream_info(S, device, D), 124 get_stream_info(S, mode, M), 125 get_stream_info(S, name, N), 126 printf("%w %6s %6s %q ( ", [S,D,M,N]), 127 ( 128 current_atom(Alias), 129 current_stream(Alias), 130 get_stream(Alias, S), 131 printf("%s ", [Alias]), 132 fail 133 ; 134 true 135 ), 136 writeln(')'), 137 fail. 138streams. 139 140stream(Stream) :- 141 get_stream_info(Stream, _, _), % so that it fails if not open 142 !, 143 atom_string('%-20s%w%n', Format), % to avoid problems in Q mode 144 ( get_stream_info(Stream, F, V), 145 printf(Format, [F, V]), 146 fail 147 ; 148 current_atom(Alias), 149 current_stream(Alias), 150 get_stream(Alias, Stream), 151 printf(Format, [alias, Alias]), 152 fail 153 ; 154 true 155 ). 156 157file_info(File) :- 158 atom_string('%-20s%w%n', Format), % to avoid problems in Q mode 159 ( get_file_info(File, F, V), 160 printf(Format, [F, V]), 161 fail 162 ; 163 true 164 ). 165 166% read_line([+Stream, ] ?String) - read a line of input into String 167 168read_line(Stream, String) :- 169 read_string(Stream, end_of_line, _, String). 170 171read_line(String) :- 172 read_string(input, end_of_line, _, String). 173 174between(From, To, I) :- 175 between(From, To, 1, I). 176 177 178% time(+Goal) - like call(Goal), but print cputime used 179 180:- tool(time/1, time_body/2). 181 182time_body(Goal, Module) :- 183 cputime(T0), 184 ( 185 call(Goal)@Module, 186 true 187 -> 188 T is cputime - T0, 189 write('\nSuccess, time = '), 190 writeln(T) 191 ; 192 T is cputime - T0, 193 write('\nFailure, time = '), 194 writeln(T), 195 fail 196 ). 197 198 199% print a list of compiled files and if they were modified since 200 201compiled :- 202 current_compiled_file(File, Time, _), 203 write(File), 204 (get_file_info(File, mtime) =\= Time -> 205 writeln(" (modified)") 206 ; 207 nl 208 ), 209 fail. 210compiled. 211 212% List all the errors whose message contains a specified text 213 214list_error(String, N, Message) :- 215 current_error(N), 216 error_id(N, Message), 217 substring(Message, String, _). 218 219 220% Compile selected text (OpenWindow) 221 222:- tool(compile_selection/0, compile_selection/1). 223 224compile_selection(Module) :- 225 exec(xv_get_sel, [null, S], Pid), 226 compile_stream(S)@Module, 227 wait(Pid, _). 228 229 230% invoke an editor on the source of a predicate 231 232:- tool(edit/1, edit/2). 233 234edit(Pred0, Module0) :- 235 ( get_flag(Pred0, tool, on)@Module0 -> 236 tool_body(Pred0, Pred, Module) % edit the tool body instead 237 ; 238 Pred = Pred0, 239 Module = Module0 240 ), 241 get_flag(Pred, source_file, File)@Module, 242 get_flag(Pred, source_line, Line)@Module, 243 ( getenv('EDITOR', Editor) -> true ; Editor = "vi"), 244 concat_string([Editor, " +", Line, " ", File], Cmd), 245 get_file_info(File, mtime, TimeBefore), 246 sh(Cmd), 247 ( get_file_info(File, mtime) =\= TimeBefore -> 248 compile(File, Module) % recompile if changed 249 ; 250 true 251 ). 252 253 254% Invoke the proper C compiler on File.c and load the result dynamically 255 256c_compile_and_load(File) :- 257 get_flag(installation_directory, Inst), 258 get_flag(hostarch, Arch), 259 get_flag(object_suffix, O), 260 concat_string([Inst,"/lib/",Arch,"/Makefile.external"], Makefile), 261 concat_string([File,.,O], Ofile), 262 concat_string(["sh -c \"ECLIPSEDIR=",Inst,";export ECLIPSEDIR;", 263 "make -f ",Makefile," ",Ofile,"\""], Make), 264 writeln(Make), 265 exec(Make, []), 266 load(Ofile). 267 268 269 270% print a module's interface 271 272interface(Module) :- 273 write(:- module(Module)), 274 get_module_info(Module, locked, Locked), 275 ( Locked == on -> writeln(".\t% (locked)") ; writeln(.) ), 276 get_module_info(Module, interface, List), 277 ( 278 member(Directive, List), 279 write(:- Directive), write(.), nl, 280 fail 281 ; 282 true 283 ). 284 285