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