1% BEGIN LICENSE BLOCK 2% Version: CMPL 1.1 3% 4% The contents of this file are subject to the Cisco-style Mozilla Public 5% License Version 1.1 (the "License"); you may not use this file except 6% in compliance with the License. You may obtain a copy of the License 7% at www.eclipse-clp.org/license. 8% 9% Software distributed under the License is distributed on an "AS IS" 10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11% the License for the specific language governing rights and limitations 12% under the License. 13% 14% The Original Code is The ECLiPSe Constraint Logic Programming System. 15% The Initial Developer of the Original Code is Cisco Systems, Inc. 16% Portions created by the Initial Developer are 17% Copyright (C) 2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): Mark Wallace and Hani El Sakkout, IC-Parc 20% 21% END LICENSE BLOCK 22:- module(ic_probe_support). 23 24:- lib(repair). 25:- lib(ic). 26:- lib(ic_kernel). 27 28:- export iddiff/3, 29 idmemb/2, 30 remove1/3, 31 replace_list/4, 32 set_to_tent/1, 33 set_to_min/1, 34 my_tent_call/4, 35 demon_suspend/4, 36 task_structure/4. 37:- export struct(task(start,duration,resource)). 38:- export struct(options(granularity,priority)). 39 40:- import 41 get_priority/1, 42 set_priority/1 43 from sepia_kernel. 44 45:- tool(demon_suspend/4,demon_suspend/5). 46:- tool(my_tent_call/4, my_tent_call/5). 47 48/************************************************************/ 49/************** Library Predicates ***********************/ 50/************************************************************/ 51 52task_structure(Tasks,Starts,Durations,Resources) :- 53 (foreach(task with [start:S,duration:D,resource:R],Tasks), 54 foreach(S,Starts), 55 foreach(D,Durations), 56 foreach(R,Resources) 57 do check_resource(R) 58 ). 59 60check_resource(R) :- get_min(R) > 0, !. 61check_resource(R) :- 62 write(error,'Error: a task has a potentially zero resource: '), 63 writeln(error,R), 64 abort. 65 66/* 67remove1(+Value,+InList,-OutList) 68Arguments: 69Value - The value or structure to be removed from a list 70InList - The input list from which the value is to be removed 71OutList - The remainder of the list after removing the value 72*/ 73remove1(X,[H|T],T) :- 74 nonvar(H), H=X, !. 75remove1(X,[H|T],[H|R]) :- 76 remove1(X,T,R). 77 78 79/* 80iddiff(+List1,+List2,-OutList) 81Arguments: 82List1 - an (input) list of variables 83List2 - an (input) list of variables 84OutList - an (output) variable 85 86iddiff returns a list of variables occurring in the first list 87 List1, but not in the second list List2 88*/ 89 90iddiff(List1,List2,OutList) :- 91 foreach(Var,List1), 92 fromto([],This,Next,OutList), 93 param(List2) 94 do (idmemb(Var,List2) -> Next=This ; Next=[Var|This]). 95 96/* 97idmemb(?Var,+List) 98Var is a variable 99List is a list 100 101idmemb succeeds if the variable is a member of the list: idmemb uses 102identity to test for membership, rather than unification as used by member. 103*/ 104 105idmemb(Var,[H|_]) :- Var==H, !. 106idmemb(Var,[_|T]) :- idmemb(Var,T). 107 108/* 109replace_list(+VarList,?Term,+ValList,?NewTerm) 110Arguments: 111VarList - a list of variables 112Term - a term (containing some or all of those variables, among others) 113ValList - a list of "things" (variables, atoms, terms) of the same 114 length as the VarList 115NewTerm - an (output) variable 116 117Same as: 118 copy_term_vars(VarList, 119 VarList-Term, 120 ValList-NewTerm), 121but doesn't keep finite domains. 122 123replace_list makes a new term NewTerm from an existing term Term, by 124 replacing all the variables in the VarList by the values in the 125 ValList 126*/ 127replace_list(VarList,Term,ValList,NewTerm) :- 128 foreach(Var,VarList),foreach(Val,ValList), 129 fromto(Term,This,Next,NewTerm) 130 do replace(Var,This,Val,Next). 131 132replace(Var,Term,Val,Val) :- Term==Var, !. 133replace(_Var,Term,_Val,Term) :- (var(Term) ; atomic(Term)), !. 134replace(Var,Term,Val,NewTerm) :- 135 Term=..[F|Args], 136 replace_each(Var,Args,Val,NewArgs), 137 NewTerm=..[F|NewArgs]. 138 139replace_each(Var,List,Val,NewList) :- 140 foreach(El,List), foreach(NewEl,NewList), param(Var,Val) 141 do replace(Var,El,Val,NewEl). 142 143/* Should be an ECLiPSe built-in */ 144set_to_tent(Term) :- 145 Term tent_get Term. 146 147set_to_min(Cost) :- 148 get_min(Cost,MinCost), 149 Cost=MinCost. 150 151 152 153/* 154demon_suspend(Goal,Prior,Cond,Susp) 155This should probably be a built-in in ECLiPSe. It suspends a 156goal, but it also calls it immediately. 157*/ 158:- inline(demon_suspend/4, tr_demon_suspend/2). 159tr_demon_suspend( 160 demon_suspend(Goal,Prior,Cond,Susp), 161 ( 162 suspend(Goal,Prior,Cond,Susp), 163 schedule_woken([Susp]), 164 wake 165 )). 166 167demon_suspend(Goal,Prior,Cond,Susp,Module) :- 168 suspend(Goal,Prior,Cond,Susp)@Module, 169 schedule_woken([Susp]), 170 wake. 171 172/* 173my_tent_call(?InTerm,?Goal,?OutTerm,+Priority,+Module) 174Arguments: 175InTerm - Any term containing variables whose tentative values are 176 input to the propagation 177Goal - Any goal which can be called in ECLiPSe 178OutTerm - Any term containing variables whose tentative values will be 179 set by this propagation. 180 181my_tent_call sets up two demons, one to perform propagation whenever the 182 tentative values change, and the other to kill the first demon 183 whenever the variables all become instantiated. 184*/ 185my_tent_call(InTerm,Goal,OutTerm,Priority,Module) :- 186 shelf_create(tent_val(nil),GlobVar), 187 term_variables(InTerm,InVars), 188 term_variables(OutTerm,OutVars1), 189 iddiff(OutVars1,InVars,OutVars), 190 replace_list(InVars,Goal,InParams,Goal2), 191 replace_list(OutVars,Goal2,OutParams,NewGoal), 192 Prior is Priority+1, 193 demon_suspend(tent_call_prior(InVars,InParams,NewGoal,GlobVar,OutParams,OutVars,Module),Priority,InVars->ga_chg,Susp), 194 demon_suspend(kill_tent_check(InVars,Goal,Susp,S,Module),Prior,InVars->inst,S). 195 196 197:- demon kill_tent_check/5. 198kill_tent_check(InVars,Goal,Susp,S,Module) :- 199 ground(InVars), !, 200 call(Goal)@Module, 201 kill_suspension(Susp), 202 kill_suspension(S). 203kill_tent_check(_,_,_,_,_). 204 205/* 206tent_call_prior(?InVars,?Goal,?OutVars,+Module) 207Variables occurring in both the InVars and the OutVars are treated as input. 208 The input variables are replaced by their tentative values and the 209 output variables by new variables. The resulting goal is then 210 invoked, and the output values tentatively assigned to the output 211 variables. 212*/ 213:- demon tent_call_prior / 7. 214tent_call_prior(InVars,InParams,NewGoal,GlobVar,OutParams,_OutVars,Module) :- 215 InVars tent_get Value,true, 216 InParams = Value, 217 ( call(NewGoal)@Module -> 218 shelf_set(GlobVar,1,OutParams) ; 219 shelf_set(GlobVar,1,nil) 220 ), fail. 221tent_call_prior(_InVars,_InParams,_NewGoal,GlobVar,_OutParams,OutVars,_Module) :- 222 shelf_get(GlobVar,1,OutParams), 223 (OutVars=nil -> fail ; OutVars tent_set OutParams). 224 225:- comment(categories, ["Constraints","Techniques"]). 226:- comment(summary, "Probe Support Library"). 227:- comment(author, "Mark Wallace, Hani El Sakkout"). 228:- comment(date, "$Date: 2009/07/16 09:11:27 $"). 229:- comment(copyright, "Cisco Systems, Inc."). 230 231:- comment(desc, html(" 232 A library exporting structures and predicates used in probing for scheduling. 233<P> 234The following two structures are exported: 235<PRE> 236task(start,duration,resource) 237options(granularity,priority) 238</PRE> 239<P> 240 ")). 241 242