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% 22% END LICENSE BLOCK 23% 24% System: ECLiPSe Constraint Logic Programming System 25% Version: $Id: mixtus.pl,v 1.2 2011/04/01 07:12:07 jschimpf Exp $ 26% ---------------------------------------------------------------------- 27 28/* 29 * SEPIA PROLOG SOURCE MODULE 30 */ 31 32/* 33 * IDENTIFICATION: mixtus.pl 34 * 35 * DESCRIPTION: Package that loads Mixtus to Sepia. 36 * 37 * 38 * CONTENTS: 39 * 40 */ 41 42%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 43 44:- module(mixtus, [], quintus). 45:- system. % compiler directive to add the SYSTEM flag 46:- make_local_array(flag(2)), 47 get_flag(debug_compile, DC), 48 setval(flag(0), DC), 49 get_flag(variable_names, VN), 50 setval(flag(1), VN), 51 nodbgcomp. 52 53%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 54 55:- local is_dynamic/1. 56 57tracing(X) :- 58 var(X), 59 !, 60 error(4, tracing(X)). 61tracing(on) :- 62 assert(tracing). 63tracing(off) :- 64 retract_all(tracing). 65 66frozen(Var, Goals) :- 67 delayed_goals(Var, List), 68 list_to_comma(List, Goals). 69 70list_to_comma([], true) :- !. 71list_to_comma([G], G) :- !. 72list_to_comma([H|T], (H,Rest)) :- 73 list_to_comma(T, Rest). 74 75 76dif(A, B) :- 77 A ~= B. 78 79wait_body(X, _) :- 80 var(X), 81 !, 82 error(4, wait(X)). 83wait_body((P, Q), M) :- 84 !, 85 wait_body(P, M), 86 wait_body(Q, M). 87wait_body(F/A, M) :- 88 !, 89 functor(T, F, A), 90 arg(1, T, Var), 91 compile_term((delay(T) if var(Var))@M. 92wait_body(X, _) :- 93 error(5, wait(X)). 94 95% call_residue/2 is not quite ok, after executing the call the 96% suspended goals should be removed from the suspending variables 97call_residue_body(Goal, Delayed, Module) :- 98 call(Goal)@Module, 99 delayed_goals(Delayed). 100 101:- tool((wait)/1, wait_body/2), 102 tool(call_residue/2, call_residue_body/3). 103 104?- skipped 105 dif/2, 106 frozen/2, 107 (wait)/1. 108 109:- unskipped 110 call_residue/2, 111 call_residue_body/3. 112 113:- 114 op(1150, fx, wait). 115 116p(X) :- compile(X). % To prevent ptags and others to see the .sd file 117 118:- p('/home/lp/sepia/workdir/sepia/mixtus/mixtus/mixtus_load.sd'). 119 120:- export 121 pconsult/1, 122 pe/1, 123 pe/2, 124 set/1, 125 set/2, 126 settings/0, 127 tracing/1, 128 unset/1. 129 130 131:- 132 getval(flag(0), DC), 133 set_flag(debug_compile, DC), 134 getval(flag(1), VN), 135 set_flag(variable_names, VN). 136