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: define.pl,v 1.2 2011/04/01 07:12:07 jschimpf Exp $ 27% ---------------------------------------------------------------------- 28 29/* 30 * SEPIA PROLOG LIBRARY MODULE 31 * 32 * IDENTIFICATION: define.pl 33 * 34 * AUTHOR: Mark Shuttleworth (ICL Strategic Systems) & 35 * Emmanuel van Rossum 36 * 37 * CONTENTS: 38 * define/2, 39 * define/3, 40 * define_eval/2, 41 * define_erased/0, 42 * define_verbose/1. 43 * 44 * DESCRIPTION: 45 * 46 * This library allows to define macro transformation similar 47 * to the #define command of the cpp preprocessor. The macro 48 * are local to the module where they are defined. 49 * 50 * define(+MacroName, ?Term) will expand the following occurences of 51 * MacroName into Term. 52 * e.g. 53 * :- define(m_MAX, 256). 54 * :- define(inc(X, Y), (X == m_MAX -> Y = 0 ; Y is X + 1)). 55 * 56 * define(+MacroName, ?Term, +Goal) will first execute Goal (the purpose 57 * is to construct Term) and then the following occurences of MacroName 58 * will be expanded into Term. 59 * e.g. 60 * :- define(type_error, Err, list_error("type error", Err, _)). 61 * :- define(sizes, [A, B, C], (A is m_MAX, B is A // 2, C is B - 1)). 62 * 63 * define_eval(+MacroName, ?Term) will evaluate Term and the following 64 * occurences of MacroName will be expanded to this evaluated term. 65 * It is a shorthand for define(MacroName, EvalTerm, EvalTerm is Term). 66 * e.g. 67 * :- define_eval(m_HEIGHT, 10). 68 * :- define_eval(m_WIDTH, 20). 69 * :- define_eval(m_AREA, m_HEIGHT * m_WIDTH). 70 * 71 * define_erased/0 is used to erase all the macros defined with 72 * define/2,3 or define_eval/2 in the caller module. 73 * This is usualy done at the end of the compilation. 74 * 75 * define_verbose(on) can be used to display the result of the definitions. 76 * This sets an error handler ("macro successfully defined") so, it can be 77 * set to do something else for example to make a log file. 78 * The default handler is true/0 (not verbose). 79 * 80 * A warning is raised when redefining a macro. 81 * Set the error handler ("redefining a macro") to true/0 to remove 82 * the warning, or to abort/0 to abort the compilation when 83 * redefining a macro. The default handler is warning_handler/2. 84 * 85 * A type error or an instantiation fault is raised when the MacroName is 86 * not an atom or a compound term. 87 * 88 * It is safer to protect the MacroName by quoting it so that 89 * the MacroName is not expanded when it is redefined. 90 * e.g. 91 * :- define(no_macro_expansion(m_MAX), 257). 92 * % quoting prevent having define(256, 257). 93 * 94 */ 95 96:- module(define). 97 98:- export 99 define/2, 100 define/3, 101 define_eval/2, 102 define_erased/0, 103 define_verbose/1. 104 105 106:- 107 make_local_array(redef), 108 make_local_array(verbose), 109 define_error("redefining a macro", Redef), 110 define_error("macro successfully defined", Verbose), 111 setval(redef, Redef), 112 setval(verbose, Verbose), 113 (import set_default_error_handler/2, warning_handler/2 114 from sepia_kernel), 115 set_default_error_handler(Redef, warning_handler/2), 116 set_default_error_handler(Verbose, true/0), 117 reset_error_handler(Redef), 118 reset_error_handler(Verbose). 119 120:- tool(define/2, defined/3). 121defined(Term, Value, Module) :- 122 (var(Term) -> 123 Err = 4 124 ; 125 (not(compound(Term) ; atom(Term)) -> 126 Err = 5 127 )), 128 !, 129 error(Err, define(Term, Value), Module). 130defined(Term, Value, Module) :- 131 functor(Term, F, A), 132 ( 133 ( 134 is_predicate(is_defined_macro/2)@Module, 135 call(is_defined_macro(Term, _))@Module 136 ) 137 -> 138 ( 139 getval(redef, Err), 140 error(Err, define(Term, Value)), 141 retract(is_defined_macro(Term, _))@Module, 142 erase_macro(F/A)@Module 143 ) 144 ; 145 true 146 ), 147 assert(is_defined_macro(Term, Value))@Module, 148 define_macro(F/A, is_defined_macro/2, [])@Module, 149 getval(verbose, Verbose), 150 error(Verbose, define(Term, Value)). 151 152:- tool(define/3, define_exec/4). 153define_exec(Term, Value, Goal, Module) :- 154 call(Goal)@Module, 155 defined(Term, Value, Module). 156 157:- tool(define_eval/2, define_eval/3). 158define_eval(Term, Expression, Module) :- 159 define_exec(Term, Value, Value is Expression, Module). 160 161:- tool(define_erased/0, define_erased/1). 162define_erased(Module) :- 163 call(is_defined_macro(Term, _)@Module, 164 functor(Term, F, A), 165 erase_macro(F/A)@Module, 166 fail. 167define_erased(Module) :- 168 abolish(is_defined_macro/2)@Module. 169 170define_verbose(X) :- 171 var(X), !, 172 error(4, define_verbose(X)). 173define_verbose(on) :- !, 174 getval(verbose, Err), 175 set_error_handler(Err, define_message_handler/2). 176define_verbose(off) :- !, 177 getval(verbose, Err), 178 set_error_handler(Err, true/0). 179define_verbose(X) :- 180 error(6, define_verbose(X)). 181 182define_message_handler(_error, Goal) :- 183 arg(1, Goal, Name), 184 arg(2, Goal, Value), 185 write(Name), 186 write(' defined as '), 187 writeln(Value). 188