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) 1990-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: quintus_util.pl,v 1.1 2008/06/30 17:43:49 jschimpf Exp $ 27% ---------------------------------------------------------------------- 28 29/* 30 * SEPIA PROLOG SOURCE MODULE 31 * 32 * IDENTIFICATION: quintus_util.pl 33 * 34 * DESCRIPTION: Utility predicates, for user convenience. 35 * 36 * CONTENTS: 37 * 38 */ 39 40 41:- module(quintus_util). 42 43:- export q_prompt/2, redef_handler/2, end_compile_handler/2. 44 45% 46% predicate to obtain a Quintus-like prompt 47% 48 49q_prompt(_, Module) :- 50 get_flag(debugging, Dbg), 51 debug_mode(Dbg, Debug), 52 (Debug == nodebug -> 53 (Module == eclipse -> 54 true 55 ; 56 printf(toplevel_output, "[%s]\n", Module) 57 ) 58 ; 59 60 put(toplevel_output, 0'[), 61 (Module == eclipse -> 62 true 63 ; 64 printf(toplevel_output, "%s ", Module) 65 ), 66 printf(toplevel_output, "%s]\n", Debug) 67 ), 68 write(toplevel_output, '| ?- '), 69 flush(toplevel_output). 70 71debug_mode(leap, debug). 72debug_mode(nodebug, nodebug). 73debug_mode(creep, trace). 74 75 76 77% A flag to suppress the warnings 78:- setval(pflag, 0). 79 80redef_handler(_, (Proc, OldFile, NewFile)) :- 81 (getval(pflag, 1) -> 82 true 83 ; 84 printf("Procedure %w is being redefined in a different file\n", 85 Proc), 86 printf(" Previous file: %s\n New file: %s\n", 87 [OldFile, NewFile]), 88 printf("Do you want to redefine it? (y, n or p) %b", []), 89 tyi(X), 90 (X == 0'y -> 91 writeln(yes) 92 ; 93 X == 0'p -> 94 writeln('suppress warnings'), 95 setval(pflag, 1) 96 ; 97 writeln(no), 98 fail 99 ) 100 ). 101 102% At the file end reset the flag 103end_compile_handler(A, B) :- 104 setval(pflag, 0), 105 error(default(A), B). 106 107