1/* Part of Extended Libraries for SWI-Prolog 2 3 Author: Edison Mera 4 E-mail: efmera@gmail.com 5 WWW: https://github.com/edisonm/xlibrary 6 Copyright (C): 2014, Process Design Center, Breda, The Netherlands. 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(compound_expand, 36 [ before/1, 37 after/1, 38 init_expansors/0, 39 op(1, fx, '$compound_expand') % Used to detect expansion modules 40 ]). 41 42/* <module> Compound expansions 43 44 This module allows to define compositional term and goal expansions, using 45 this module in a module that already defines the predicates 46 term_expansion/2/4 and goal_expansion/2/4 but don't export them. 47 48 The composition of expansions is instrumental to grammar and syntax 49 extensions, which is the key point of Ciao Prolog, but not supported in 50 SWI-Prolog. We do not need to deal with all the complexity that the Ciao 51 package system has, so with this helper the port of Ciao Packages to 52 SWI-Prolog can be achieved smoothly and such modules can be used in SWI 53 Programs that do not require the Ciao dialect. 54 55 Notes: 56 57 - Use reexport(library(compound_expand)) in order for this to work 58 efficiently, otherwise you will have to import compound_expand on each of 59 the dependent expansions, but also you should avoid to import this in the 60 user module. 61 62 - Expansions are not applied to the module where they are implemented, but to 63 the modules that import them. This is a bit different from how expansions 64 work in SWI-Prolog, but it has a more clear behavior. 65 66@author Edison Mera 67*/ 68 69:- use_module(library(def_modules), []). 70 71% The most efficient way to implement the compound expansions library is to 72% redefine the predicate '$def_modules'/2, which is only called in expand.pl, 73% but for some reason I don't know why we can not redefine it, so instead the 74% next lines are in place: 75 76% :- redefine_system_predicate('$def_modules'(_,_)). % This does not work 77:- abolish('$expand':'$def_modules'/2), 78 use_module('$expand':library(def_modules), ['$def_modules'/2]). 79 80:- use_module(library(expansion_module)). 81:- use_module(library(partsort)). 82:- use_module(library(lists)). 83:- use_module(library(apply)). 84:- use_module(library(option)). 85 86:- multifile 87 system:term_expansion/4, 88 system:goal_expansion/4, 89 before/2.
96before(_).103after(_). 104 105:- public implemented_pi/1. 106:- meta_predicate implemented_pi(). 107implemented_pi(M:F/A) :- 108 functor(H, F, A), 109 % Can not use current_module/1 at this stage: --EMM 110 once(predicate_property(M:H, visible)), 111 \+ predicate_property(M:H, imported_from(_)). 112 113expansion_order(>, M1-_, M2-_) :- 114 expansion_order_gt(M1, M2), 115 !. 116expansion_order(=, X, X) :- !. 117 118% Control the expansion orders via reexport, i.e., first the transformations in 119% the current library and later the transformation in the reexported one. 120expansion_order_gt(M1, M2) :- 121 before(M2, M1), % let programmers decide 122 !. 123expansion_order_gt(M1, M2) :- 124 before(M1, M2), % overrule reexport 125 !, 126 fail. 127expansion_order_gt(M1, M2) :- 128 module_property(M1, file(File)), 129 current_op(1, fx, M1:'$compound_expand'), 130 '$load_context_module'(File, M2, Options), 131 option(reexport(true), Options), 132 !. 133expansion_order_gt(M, M2) :- 134 '$load_context_module'(File1, M2, Options), 135 option(reexport(true), Options), 136 module_property(M1, file(File1)), 137 current_op(1, fx, M1:'$compound_expand'), 138 expansion_order_gt(M, M1), 139 !. 140 141collect_expansor(EM, ExpansorName) --> 142 ( {implemented_pi(EM:ExpansorName)} 143 ->[ExpansorName] 144 ; [] 145 ). 146 147collect_expansors(ExpansorNameL, M, ML) :- 148 findall(EM-PIL, 149 ( expansion_module(M, EM), 150 foldl(collect_expansor(EM), ExpansorNameL, PIL, []), 151 PIL \= [] 152 ), MU), 153 partsort(expansion_order, MU, ML).
163init_expansors. 164 165no_more_expansions_after_init(Source) :- 166 member(Expansors, 167 [[term_expansion/4, term_expansion/2], 168 [goal_expansion/4, goal_expansion/2]]), 169 collect_expansors(Expansors, Source, TN), 170 ( '$defined_predicate'(Source:'$module_expansors'(_, _, _)) 171 ->Source:'$module_expansors'(Expansors, TL, []), 172 subtract(TN, TL, EL), 173 EL \= [], 174 print_message(warning, format("More expansors added after :- init_expansors declaration: ~w", [EL])) 175 ; TN \= [] 176 ->print_message(warning, format("Missing :- init_expansors declaration, but expansors present: ~w", [TN])) 177 ). 178systemterm_expansion(end_of_file, _) :- 179 '$current_source_module'(Source), 180 module_property(Source, file(File)), 181 prolog_load_context(source, File), 182 no_more_expansions_after_init(Source), 183 fail. 184/* NOTE: this is commented out to let expansions in module qualified literals 185 * work, since you need to keep the expansions available --EMM 186 187stop_expansors :- 188 '$current_source_module'(Source), 189 abolish(Source:'$module_expansors'/3). 190 191system:term_expansion(end_of_file, _) :- 192 '$current_source_module'(Source), 193 module_property(Source, file(File)), 194 prolog_load_context(source, File), 195 stop_expansors, 196 fail. 197*/ 198systemterm_expansion(:- before(B), compound_expand:before(A, B)) :- 199 '$current_source_module'(A). 200systemterm_expansion(:- after( B), compound_expand:before(B, A)) :- 201 '$current_source_module'(A). 202systemterm_expansion((:- init_expansors), []) :- 203 '$current_source_module'(Source), 204 dynamic(Source:'$module_expansors'/3), 205 public(Source:'$module_expansors'/3), 206 retractall(Source:'$module_expansors'(_, _, _)), 207 forall(member(Expansors, 208 [[term_expansion/4, term_expansion/2], 209 [goal_expansion/4, goal_expansion/2]]), 210 ( collect_expansors(Expansors, Source, TH), 211 '$append'(TH, TT, TL), 212 assertz(Source:'$module_expansors'(Expansors, TL, TT)) 213 ))