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) 1993-2006 Cisco Systems, Inc.  All Rights Reserved.
18 *
19 * Contributor(s):
20 *
21 * END LICENSE BLOCK */
22
23/**************************************************************************/
24/*
25  FILE:           constraints_elipsys.c
26  AUTHOR:         Andre Veron
27  CREATION:       June 1993
28
29  DESCRIPTION:
30                                                                          */
31/**************************************************************************/
32
33#include <stdio.h>
34#include "config.h"
35#include "sepia.h"
36#include "types.h"
37#include        "embed.h"
38#include "mem.h"
39#include "dict.h"
40#include "fd.h"
41#include "error.h"
42
43#if defined(BARRELFISH) && defined(__ARM_ARCH_7A__) && defined(false)
44#undef false
45#endif
46
47#define Assert(ex)	{if (!(ex)){(void) p_fprintf(current_err_, "Elipsys FD internal error: file \"%s\":%d\n", __FILE__, __LINE__); p_reset();}}
48
49
50#define Append_List3(fct, tag1,val1,tag2,val2,tag3,val3, list) {\
51        register pword *_pw1,*_pw2;             \
52	_pw1 = TG ;                             \
53	Push_Struct_Frame((fct));		\
54	 CopyToPrologWord(_pw1[1],(val1),(tag1));\
55	 CopyToPrologWord(_pw1[2],(val2),(tag2));\
56	 CopyToPrologWord(_pw1[3],(val3),(tag3));\
57 	_pw2 = TG;                              \
58	Push_List_Frame();                      \
59	    _pw2[0].val.ptr = _pw1;		\
60	    _pw2[0].tag.kernel = TCOMP;		\
61	if (*(list)) {				\
62	    _pw2[1].val.ptr = *(list);		\
63	    _pw2[1].tag.kernel = TLIST;		\
64	} else {				\
65	    _pw2[1].tag.kernel = TNIL; 		\
66	}					\
67	*(list) = _pw2;				\
68    }
69
70
71
72#define Append_List(wd, tag1, val1, tag2, val2, list){   \
73        register pword *_pw1,*_pw2;             \
74	_pw1 = TG ;                             \
75	Push_Struct_Frame(wd);			\
76	 CopyToPrologWord(_pw1[1],(val1),(tag1));\
77	 CopyToPrologWord(_pw1[2],(val2),(tag2));\
78 	_pw2 = TG;                              \
79	Push_List_Frame();                      \
80	    _pw2[0].val.ptr = _pw1;		\
81	    _pw2[0].tag.kernel = TCOMP;		\
82	if (*(list)) {				\
83	    _pw2[1].val.ptr = *(list);          \
84	    _pw2[1].tag.kernel = TLIST;		\
85	} else {				\
86	    _pw2[1].tag.kernel = TNIL; 		\
87	}					\
88	*(list) = _pw2;				\
89    }
90
91
92#define CopyToPrologWord(to,value,tagg)                         \
93   (to).val.all = (value);                                      \
94   (to).tag.kernel = (tagg);
95
96
97/* Compatibility package from ElipSys to Eclipse */
98
99
100#define INLINE
101#define FALSE PFAIL
102#define FAIL  PFAIL
103#define TRUE  PSUCCEED
104#define SUCCEED PSUCCEED
105#define _False(v) ((v) == FALSE)
106#define _True(v) (!((v) == FALSE))
107#define DELAY PSUCCEED
108#define d_arity(did) DidArity((did))
109#define StructArgs(s) (((s)->val.ptr) + 1)
110#define StrArg(s,n)   (((s)->val.ptr) + 1 + (n))
111#define Functor(s)    (((s)->val.ptr)->val.did)
112#define IVal(p)       ((p)->val.nint)
113#define IsInt(p) IsInteger((p)->tag)
114#define IsDomVar(p) IsMeta((p)->tag)
115#define IsDvar(p) IsMeta((p)->tag)
116#define IsStruct(p) IsCompound((p)->tag)
117#define Unsigned uword
118#define Int word
119#define BOOLEAN int
120#define PrologWord pword
121#define MetaTerm(pw)                       ((pw) + 1)
122
123
124#ifdef __STDC__
125static PrologWord       *dereference(PrologWord *);
126static Int              dmax(PrologWord *);
127static Int              dmin(PrologWord *);
128static BOOLEAN          dupdate_min(PrologWord *,Int, pword **);
129static BOOLEAN          dupdate_max(PrologWord *,Int, pword **);
130static Int              gmin(PrologWord *);
131static Int              gmax(PrologWord *);
132
133#else
134static PrologWord       *dereference();
135static Int              dmax();
136static Int              dmin();
137static BOOLEAN          dupdate_min();
138static BOOLEAN          dupdate_max();
139static Int              gmin();
140static Int              gmax();
141
142#endif
143
144static BOOLEAN		contigs(pword *StructTable, pword *Sequences, pword *Item, pword *Occurences, pword *Contigs, pword **list);
145static BOOLEAN		disjunctive(pword *StructStarts, pword *StructDurations, pword *StructOrientations, pword **list);
146static BOOLEAN		disjunction_choose(pword *x, pword *Dx, pword *y, pword *Dy, pword *branch, pword **list);
147static BOOLEAN		sequences(pword *StructTable, pword *Sequences, pword *Item, pword *Occurences, pword **list);
148
149/*
150 * EXTERNAL VARIABLE DEFINITIONS:
151 */
152static int UNI_RESULT;
153
154
155/*
156 * EXTERNAL VARIABLE DECLARATIONS:
157 */
158
159/*
160 * STATIC VARIABLE DEFINITIONS:
161 */
162static int	p_disjunctive_interface(value Val1, type Tag1, value Val2, type Tag2, value Val3, type Tag3, value vl, type tl),
163		p_disjunction_choose_interface(value Val1, type Tag1, value Val2, type Tag2, value Val3, type Tag3, value Val4, type Tag4, value Val5, type Tag5, value vl, type tl),
164		p_contigs_interface(value Val1, type Tag1, value Val2, type Tag2, value Val3, type Tag3, value Val4, type Tag4, value Val5, type Tag5, value vl, type tl),
165		p_sequences_interface(value Val1, type Tag1, value Val2, type Tag2, value Val3, type Tag3, value Val4, type Tag4, value vl, type tl);
166
167static dident	d_update_min,
168		d_update_max,
169		d_update_any,
170		d_greatereq;
171
172void
173bip_elipsys_fd_init(int flags)
174{
175    d_update_min = in_dict("update_min", 2);
176    d_update_max = in_dict("update_max", 2);
177    d_update_any = in_dict("update_any", 2);
178    d_greatereq = in_dict("greatereq", 3);
179
180    if (!(flags & INIT_SHARED))
181	return;
182
183    (void) exported_built_in(in_dict("disjunctive_interface", 4),
184		p_disjunctive_interface, B_UNSAFE);
185    (void) exported_built_in(in_dict("disjunction_choose_interface", 6),
186		p_disjunction_choose_interface, B_UNSAFE);
187    (void) exported_built_in(in_dict("contigs_interface", 6),
188		p_contigs_interface, B_UNSAFE);
189    (void) exported_built_in(in_dict("sequences_interface", 5),
190		p_sequences_interface, B_UNSAFE);
191}
192
193static void
194FunifyIntLocal(pword *p, word i)
195{
196  PrologWord temp_unify_int;
197  Make_Integer(&temp_unify_int,(i));
198  UNI_RESULT = ec_unify(*p, temp_unify_int);
199}
200
201
202static INLINE PrologWord * _Ptrbody(pword *p)
203{
204  PrologWord *temp;
205
206  Var_Domain(p,temp);
207
208  return temp;
209}
210
211static INLINE PrologWord *dereference(pword *p)
212{
213  PrologWord *temp;
214
215  temp =  p;
216  Dereference_(temp);
217  return  temp;
218}
219
220
221static INLINE Int dmax(pword *p)
222{
223  Int max,min;
224
225  (void) dom_range(p,&min,&max);
226  return max;
227}
228
229
230static INLINE Int dmin(pword *p)
231{
232  Int max,min;
233
234  (void) dom_range(p,&min,&max);
235  return min;
236}
237
238static INLINE BOOLEAN
239dupdate_min(pword *p, word newmin, pword **list)
240{
241  Append_List(d_update_min,TINT,newmin,p->tag.kernel,p->val.all, list);
242  return TRUE;
243}
244
245
246static INLINE BOOLEAN
247dupdate_max(pword *p, word newmax, pword **list)
248{
249    Append_List(d_update_max,TINT,newmax,p->tag.kernel,p->val.all, list);
250    return TRUE;
251}
252
253
254static BOOLEAN setup_domain_greatereq(pword *ArgX, pword *ArgY, pword *ArgNb, pword **list)
255{
256
257  Append_List3(d_greatereq,ArgX->tag.kernel, ArgX->val.all,
258	     ArgY->tag.kernel,ArgY->val.all,
259	     ArgNb->tag.kernel,ArgNb->val.all, list);
260  return TRUE;
261}
262
263
264static INLINE BOOLEAN
265dremove_value(pword *p, word v, pword **list)
266{
267  int res;
268  PrologWord *domain;
269  pword		inst;
270
271  domain = _Ptrbody(p);
272
273  res = dom_remove_element(domain, v, (word) TINT, &inst);
274
275  /* Debbugging phase only */
276  Assert(res == RES_ANY || res == RES_MIN || res == RES_MAX || res == RES_INSTANTIATED);
277
278  switch (res) {
279    case RES_ANY:{
280      Append_List(d_update_any,TINT,v,p->tag.kernel,p->val.all, list);
281      break;
282    }
283    case RES_MIN:{
284      Append_List(d_update_min,TINT,v,p->tag.kernel,p->val.all, list);
285      break;
286    }
287    case RES_MAX:      {
288      Append_List(d_update_max,TINT,v,p->tag.kernel,p->val.all, list);
289      break;
290    }
291    case RES_INSTANTIATED:{
292      FunifyIntLocal(p,dmax(domain));
293      break;
294    }
295  }
296  return SUCCEED;
297}
298
299
300static INLINE BOOLEAN present(pword *domain, word v)
301{
302  int res;
303
304
305  res = dom_check_in(v, tint, domain);
306
307  /* Debbugging phase only */
308  Assert(res == 0 || res == 1);
309
310  if (res == 0)
311     return FAIL;
312  else
313     return SUCCEED;
314}
315
316
317static INLINE Int gmin(pword *p)
318{
319
320  if (IsInt(p))
321     return IVal(p);
322  else
323     return dmin(_Ptrbody(p));
324}
325
326static INLINE Int gmax(pword *p)
327{
328  if (IsInt(p))
329     return IVal(p);
330  else
331     return dmax(_Ptrbody(p));
332}
333
334
335
336
337
338/* disjunctive/3 core constraint */
339
340
341static int
342p_disjunctive_interface(value Val1, type Tag1, value Val2, type Tag2, value Val3, type Tag3, value vl, type tl)
343{
344
345  pword P1,P2,P3;
346  pword		*list = 0;
347  int		res;
348
349  CopyToPrologWord(P1,Val1.all,Tag1.kernel);
350  CopyToPrologWord(P2,Val2.all,Tag2.kernel);
351  CopyToPrologWord(P3,Val3.all,Tag3.kernel);
352
353    res = disjunctive(&P1,&P2,&P3, &list);
354    if (res == PSUCCEED) {
355	if (list == (pword *) 0) {
356	    Return_Unify_Nil(vl, tl)
357	} else {
358	    Return_Unify_List(vl, tl, list)
359	}
360    } else
361	return res;
362}
363
364
365
366
367
368
369#define DOMAIN_MAX     200000000
370#define DOMAIN_MIN     0
371#define MAX_NUMBER_TASKS 128
372
373#define MASK_POSSIBLE_LAST  (Unsigned)0x1
374#define MASK_POSSIBLE_FIRST (Unsigned)0x2
375#define MASK_LAST           (unsigned)0x4
376#define MASK_FIRST          (Unsigned)0x8
377#define MASK_MIDDLE         (Unsigned)0x10
378
379
380
381Unsigned states_cache[MAX_NUMBER_TASKS];
382Int      increasing_starts[MAX_NUMBER_TASKS*4];
383Int      increasing_ends[MAX_NUMBER_TASKS*4];
384
385#define  _KeyDate(i)         (4*(i))
386#define  _EndDate(i)         (4*(i) + 1)
387#define  _Index(i)           (4*(i) + 2)
388
389static void
390siftup(word *array, word i, word n)
391{
392  Int j;
393  Int loc;
394
395
396  while (2*i <= n) {
397    j = 2*i;
398    if (j < n)
399       if (array[_KeyDate(j)] < array[_KeyDate(j+1)] ||
400	   (array[_KeyDate(j)] == array[_KeyDate(j+1)] &&
401	    array[_EndDate(j)] < array[_EndDate(j+1)]))
402	  j = j + 1;
403    if (array[_KeyDate(i)] < array[_KeyDate(j)] ||
404	(array[_KeyDate(i)] == array[_KeyDate(j)] &&
405	 array[_EndDate(i)] < array[_EndDate(j)])) {
406
407      loc = array[_KeyDate(j)];
408      array[_KeyDate(j)] = array[_KeyDate(i)];
409      array[_KeyDate(i)] = loc;
410
411      loc = array[_EndDate(j)];
412      array[_EndDate(j)] = array[_EndDate(i)];
413      array[_EndDate(i)] = loc;
414
415      loc = array[_Index(j)];
416      array[_Index(j)] = array[_Index(i)];
417      array[_Index(i)] = loc;
418
419      i = j;
420    }
421    else
422       i = n + 1;
423  }
424}
425
426
427static INLINE BOOLEAN false(void)
428{
429  return FALSE;
430}
431
432
433
434
435
436
437
438
439
440/* To implement the proposition 9 of Carlier and Pinson's paper */
441#define PROPOSITION_9  1
442
443/* To implement the proposition 12 of Carlier and Pinson's paper */
444#define PROPOSITION_12 1
445
446/* To implement the proposition 6 and 7 of Carlier and Pinson's paper */
447#define PROPOSITION_67 1
448
449/* To enable the interruption of the constraint by other constraints */
450#define PREEMPTION     0
451
452
453#if __STDC__
454BOOLEAN schedule_as_before(PrologWord *,PrologWord *,PrologWord *,Int,Int);
455BOOLEAN schedule_as_after(PrologWord *,PrologWord *,PrologWord *,Int,Int);
456#else
457BOOLEAN schedule_as_before();
458BOOLEAN schedule_as_after();
459#endif
460
461
462
463
464static BOOLEAN
465disjunctive(pword *StructStarts, pword *StructDurations, pword *StructOrientations, pword **list)
466{
467  Int arity,sum_subset,n_tasks_to_schedule,n_partial_schedule;
468  Int i,k;
469  PrologWord *AuxStart,*AuxPPW;
470  Unsigned value_state;
471  BOOLEAN condition1,condition2,condition3;
472
473
474
475  /* Arrays to memoize accesses and computations */
476
477  Int min_starts[MAX_NUMBER_TASKS];
478  Int max_ends[MAX_NUMBER_TASKS];
479  Int durations[MAX_NUMBER_TASKS];
480
481  Int subset[MAX_NUMBER_TASKS];
482  Int total_index[MAX_NUMBER_TASKS];
483  Int partial_index[MAX_NUMBER_TASKS];
484
485
486#if PREEMPTION
487  Int old_Bpropagation_index;
488#endif
489
490
491
492  arity = d_arity(Functor(StructStarts));
493
494  /* Sort the tasks by increasing starting dates and by increasing ending dates */
495  /* A priority queue is used to perform a heap sort.                           */
496  /* The algorithm is taken from the Handbook of Algorithms and Data Structures */
497  /* by G.H Gonnet (International Compuetr Science Series).                     */
498
499  /* The constraint is only applied to the tasks which have not yet been scheduled */
500  /* at the end or at the beginning of the schedule on the machine.                */
501  /* The states held in StructStates describe whether a task has already been      */
502  /* scheduled in such a fashion.                                                  */
503  /* Note: This is currently not implemented.                                      */
504  /*       All tasks are considered for each invokation of the constraint.         */
505
506  n_tasks_to_schedule = 0;
507  for (i = arity - 1; i >= 0 ; i --) {
508    AuxPPW = dereference(StrArg(StructStarts,i));
509
510    /* Fill up the queue and initialize the array used to memoize the computation of */
511    /* starting and ending date of tasks.                                            */
512
513    durations[i] = IVal(dereference(StrArg(StructDurations,i)));
514    increasing_starts[_KeyDate(i+1)] = min_starts[i] = gmin(AuxPPW);
515    increasing_starts[_EndDate(i+1)] = max_ends[i] = gmax(AuxPPW) +  durations[i];
516    increasing_starts[_Index(i+1)] = i;
517    increasing_ends[_KeyDate(i+1)] = gmax(AuxPPW) +  durations[i];
518    increasing_ends[_EndDate(i+1)] = 0;
519
520    /* Map the tasks in the sorted sequence to the tasks in the input data structures */
521    total_index[n_tasks_to_schedule] = i;
522    n_tasks_to_schedule ++;
523  }
524
525  for (i = n_tasks_to_schedule / 2; i >= 1; i --) {
526    siftup(increasing_starts,i,n_tasks_to_schedule);
527    siftup(increasing_ends,i,n_tasks_to_schedule);
528  }
529
530  for (i = n_tasks_to_schedule; i >= 1; i --)  {
531    Int loc;
532
533    siftup(increasing_starts,1,i);
534
535    loc = increasing_starts[_KeyDate(1)];
536    increasing_starts[_KeyDate(1)] = increasing_starts[_KeyDate(i)];
537    increasing_starts[_KeyDate(i)] = loc;
538
539    loc = increasing_starts[_EndDate(1)];
540    increasing_starts[_EndDate(1)] = increasing_starts[_EndDate(i)];
541    increasing_starts[_EndDate(i)] = loc;
542
543    loc = increasing_starts[_Index(1)];
544    increasing_starts[_Index(1)] = increasing_starts[_Index(i)];
545    increasing_starts[_Index(i)] = loc;
546
547    siftup(increasing_ends,1,i);
548
549    loc = increasing_ends[_KeyDate(1)];
550    increasing_ends[_KeyDate(1)] = increasing_ends[_KeyDate(i)];
551    increasing_ends[_KeyDate(i)] = loc;
552
553    loc = increasing_ends[_EndDate(1)];
554    increasing_ends[_EndDate(1)] = increasing_ends[_EndDate(i)];
555    increasing_ends[_EndDate(i)] = loc;
556
557    loc = increasing_ends[_Index(1)];
558    increasing_ends[_Index(1)] = increasing_ends[_Index(i)];
559    increasing_ends[_Index(i)] = loc;
560
561  }
562
563  /* In the Carlier and Pinson's constraints described in their 1989 paper */
564  /* they use a clique C of tasks on one machine.                          */
565  /* This clique is left unspecified. One could apply the constraints to all */
566  /* the possible subsets of the set of tasks. This would obviously be     */
567  /* very expensive.                                                       */
568  /* Reinhard Enders (SIEMENS/ZFE) has noticed that one could restrict     */
569  /* oneself to the application of the constraints on maximal subsets      */
570  /* where maximality is defined with regard to the following partial      */
571  /* relation between set of tasks:                                        */
572  /* S1 <= S2 iff min_starts(S1) = min_starts(S2) /\                       */
573  /*              max_ends[(S1)   = max_ends[(S2)   /\                       */
574  /*              S1 included in S2                                        */
575
576  /* Iteration on all the maximal subsets                                  */
577
578
579
580  {
581    Int ptr_starts,ptr_ends;
582    Int xcurrent_start,xcurrent_end;
583    Int ptr_subset;
584    Int latest_end,current_end;
585    Int earliest_start,current_start;
586
587    /* To be able to detect interruptions */
588#if PREEMPTION
589    old_Bpropagation_index = Bpropagation_index;
590#endif
591
592    for (ptr_starts = 1; ptr_starts <= n_tasks_to_schedule;) {
593      for (ptr_ends = 1 ; ptr_ends <= n_tasks_to_schedule; ptr_ends ++){
594
595	/* The minimum starting time  in a maximal subset can only be smaller */
596	/* than its maximumum ending time.                                    */
597
598	if (increasing_starts[_KeyDate(ptr_starts)] > increasing_ends[_KeyDate(ptr_ends)])
599	   continue;
600
601	/* Skip to the last task with the current ending date. Hence all tasks with */
602	/* ending dates smaller than the current ending date will be included in the*/
603	/* maximal subset.                                                          */
604
605	{
606	  Int temp_ending_date;
607	  temp_ending_date = increasing_ends[_KeyDate(ptr_ends)];
608	  ptr_ends ++;
609	  for (;ptr_ends <= n_tasks_to_schedule &&
610	       increasing_ends[_KeyDate(ptr_ends)] == temp_ending_date;
611	       ptr_ends ++);
612	  ptr_ends --;
613	}
614	/* Initialise the position descriptor of a task within all possible schedules */
615	/* of the current maximal subset.                                             */
616
617	for (i = n_tasks_to_schedule - 1; i >= 0; i --)  {
618	  states_cache[total_index[i]] = MASK_POSSIBLE_FIRST | MASK_POSSIBLE_LAST;
619	  subset[total_index[i]] = 0;
620	}
621
622
623	n_partial_schedule = 0;
624	sum_subset = 0;
625	latest_end = DOMAIN_MIN;
626	earliest_start = DOMAIN_MAX;
627
628	for (ptr_subset = ptr_starts; ptr_subset <= n_tasks_to_schedule;
629	     ptr_subset ++) {
630	  Int index_i;
631
632	  xcurrent_start = increasing_starts[_KeyDate(ptr_subset)];
633	  xcurrent_end = increasing_starts[_EndDate(ptr_subset)];
634
635	  /* Halts the loop - End of the maximal subset */
636	  if (xcurrent_start > increasing_ends[_KeyDate(ptr_ends)])
637	     break;
638
639	  /* This task ends later that the current maximum end in the maximal */
640	  /* subset beeig constructed. It cannot be put in the maximal subset */
641	  if (xcurrent_end > increasing_ends[_KeyDate(ptr_ends)])
642	     continue;
643
644	  /* Records the index in the input data structure of the tasks in the maximal subset */
645
646	  index_i = partial_index[n_partial_schedule] = increasing_starts[_Index(ptr_subset)];
647
648	  /* Records which tasks in t input data structure are in the current */
649	  /* maximal subset.                                                  */
650
651	  subset[partial_index[n_partial_schedule]] = 1;
652
653	  /* Compute the sum of the durations of the tasks in the curent maximal subset */
654
655	  sum_subset = sum_subset + durations[partial_index[n_partial_schedule]];
656
657	  /* Compute the minimum starting date and the maximu ending date of the tasks in the */
658	  /* maximal subset.                                                                  */
659
660	  current_end = max_ends[index_i];
661	  current_start = min_starts[index_i];
662	  if (latest_end < current_end) {
663	    latest_end = current_end;
664	  }
665	  if (earliest_start > current_start) {
666	    earliest_start = current_start;
667	  }
668
669	  n_partial_schedule ++;
670	}
671
672	/* Empty maximal subset nothing to do */
673	if (n_partial_schedule == 0)
674	   continue;
675
676
677	{
678      {
679	    for (k = n_tasks_to_schedule - 1; k >= 0; k --) {
680	      Int index_k = total_index[k];
681	      if (subset[index_k] != 1) {
682		value_state = states_cache[index_k];
683
684
685		/* Condition 1 */
686		if (value_state & MASK_POSSIBLE_FIRST) {
687
688		  /* Test whether task k can be scheduled as the first of the tasks   */
689		  /* which have not yet been scheduled at the beginning or at the end */
690		  /* of any schedule of the maximal subset                            */
691
692		  if (min_starts[index_k] + sum_subset + durations[index_k] > latest_end ) {
693		    states_cache[index_k] =  states_cache[index_k] & ~MASK_POSSIBLE_FIRST;
694		  }
695		}
696
697
698		/* Condition 2 */
699		if (value_state & MASK_POSSIBLE_LAST) {
700
701		  /* Test whether task k can be scheduled as the first of the tasks   */
702		  /* which have not yet been scheduled at the beginning or at the end */
703		  /* of any schedule of the maximal subset                            */
704
705		  if (earliest_start + sum_subset + durations[index_k]> max_ends[index_k]){
706		    states_cache[index_k] =  states_cache[index_k] & ~MASK_POSSIBLE_LAST;
707		  }
708		}
709	      }
710	    }
711	  }
712	}
713
714
715#if PROPOSITION_67
716	{
717	  /* For all operations in the subset which have not yet been scheduled at the end   */
718	  /* or at the beginning of the partial schedule, apply the proposition 6 and 7.     */
719	  /* The following variables are used:                                               */
720
721	  /* index_k:    index on the tasks we try to position with respect to the current   */
722	  /*             subset.                                                             */
723	  /* condition1: BOOLEAN if set to TRUE means that the index_k task can be scheduled */
724	  /*             after the current subset.                                           */
725	  /* condition2: BOOLEAN if set to TRUE means that the index_k task can be scheduled */
726	  /*             before the current subset.                                          */
727	  /* condition3: BOOLEAN if set to TRUE means that the index_k task can not be       */
728	  /*             scheduled within the  current subset.                               */
729
730
731	  /* For all tasks .... */
732	  for (k = n_tasks_to_schedule - 1 ; k >= 0; k -- ) {
733	    Int index_k = total_index[k];
734	    BOOLEAN already_scheduled;
735
736	    /* ... not in the current maximal subset */
737	    if (subset[index_k] != 1) {
738
739#if PREEMPTION
740	      if (Bpropagation_index != old_Bpropagation_index)
741		 return PREEMPTED;
742#endif
743
744
745	      /* Detect whether the task could be scheduled within the boundaries of the */
746	      /* partial schedule.                                                       */
747
748	      /* We can do it by testing whether there is enough room within the         */
749	      /* boundaries of the partial schedule.                                     */
750
751	      if (earliest_start + sum_subset  + durations[index_k] > latest_end)
752		 condition3 = TRUE;
753	      else
754		 condition3 = FALSE;
755
756	      /* We can also do it by checking the pairwise orientations of the task */
757	      /* and the tasks within the partial schedule.                          */
758
759	      condition1 = condition2 = FALSE;
760	      already_scheduled = FALSE;
761
762
763	      if (_False(condition3)) {
764		condition3 = TRUE;
765		for (i = n_partial_schedule - 1  ;  i >= 0; i -- )  {
766		  Int index_i = partial_index[i];
767		  Int ix;
768		  if (index_k < index_i) {
769		    ix = index_k*arity + index_i;
770		    AuxPPW = dereference(StrArg(StructOrientations,ix));
771		    if (IsInt(AuxPPW)) {
772
773		      /* Debugging phase only */
774		      Assert(IVal(AuxPPW) == 1 || IVal(AuxPPW) == 2);
775
776		      if (IVal(AuxPPW) == 2) {
777			condition1 = TRUE;
778
779			/* If the task can be before some tasks and  after some others */
780			/* it must be within the partial schedule.                     */
781
782			if (_True(condition2)) {
783			  condition3 = FALSE;
784			  break;
785			}
786		      }
787
788		      else  {
789
790			condition2 = TRUE;
791
792			/* If the task can be before some tasks and  after some others */
793			/* it must be within the partial schedule.                     */
794
795			if (_True(condition1)) {
796			  condition3 = FALSE;
797			  break;
798			}
799		      }
800		    }
801		    else {
802		      /* If no orientation is given for a pair there is nothing to do */
803		      condition3 = FALSE;
804		      break;
805		    }
806		  }
807		  else
808		     if (index_k > index_i) {
809		       ix = index_i*arity + index_k;
810		       AuxPPW = dereference(StrArg(StructOrientations,ix));
811		       if (IsInt(AuxPPW)) {
812
813			 /* Debugging phase only */
814			 Assert(IVal(AuxPPW) == 1 || IVal(AuxPPW) == 2);
815
816
817			 if (IVal(AuxPPW) == 2) {
818			   condition2 = TRUE;
819
820			   /* If the task can be before some tasks and  after some others */
821			   /* it must be within the partial schedule.                     */
822
823			   if (_True(condition1)) {
824			     condition3 = FALSE;
825			     break;
826			   }
827
828			 }
829			 else {
830			   condition1 = TRUE;
831
832			   /* If the task can be before some tasks and  after some others */
833			   /* it must be within the partial schedule.                     */
834
835			   if (_True(condition2)) {
836			     condition3 = FALSE;
837			     break;
838			   }
839			 }
840		       }
841		       else {
842			 /* If no orientation is given for a pair there is nothing to do */
843			 condition3 = FALSE;
844			 break;
845		       }
846
847		     }
848		}
849
850		/* The operation can be in "the middle of the subset". Nothing to be done */
851		if (_False(condition3))
852		   continue;
853		else
854		   already_scheduled = TRUE;
855	      }
856
857	      if (_False(condition3))
858		 continue;
859
860
861	      /* if we get to here we have been able to decide that the task  was either */
862	      /* before or after the subset.                                             */
863
864	      /* if we do not yet know on which side it should be then we can try to find out */
865
866	      /* if we already know we do not do anything */
867	      if (_False(condition1) && _False(condition2)) {
868		value_state = states_cache[index_k];
869		if (value_state == MASK_POSSIBLE_FIRST) {
870		  condition2 = TRUE;
871		}
872		else
873		   condition2 = FALSE;
874
875		if (value_state == MASK_POSSIBLE_LAST) {
876		  condition1 = TRUE;
877		}
878		else
879		   condition1 = FALSE;
880
881
882
883		/* We inspect the array of orientations describing how tasks are  */
884		/* pairwise oriented.                                             */
885		/* If we find an orientation which is already set we can conclude */
886
887		if (_False(condition1) && _False(condition2)) {
888		  for (i = n_partial_schedule - 1 ;  i >= 0; i -- )  {
889		    Int index_i = partial_index[i];
890		    Int ix;
891
892		    /* Debugging phase only */
893		    Assert(index_k != index_i);
894
895		    if (index_k < index_i) {
896		      ix = index_k*arity + index_i;
897		      AuxPPW = dereference(StrArg(StructOrientations,ix));
898		      if (IsInt(AuxPPW)) {
899
900			/* Debugging phase only */
901			Assert(IVal(AuxPPW) == 1 || IVal(AuxPPW) == 2);
902
903			if (IVal(AuxPPW) == 2) {
904			  condition1 = TRUE;
905			  condition2 = FALSE;
906			}
907			else {
908			  condition1 = FALSE;
909			  condition2 = TRUE;
910			}
911			break;
912		      }
913		    }
914
915		    /* index_k > index_i */
916
917		    else {
918		      ix = index_i*arity + index_k;
919		      AuxPPW = dereference(StrArg(StructOrientations,ix));
920		      if (IsInt(AuxPPW)) {
921
922			/* Debugging phase only */
923			Assert(IVal(AuxPPW) == 1 || IVal(AuxPPW) == 2);
924
925			if (IVal(AuxPPW) == 2) {
926			  condition1 = FALSE;
927			  condition2 = TRUE;
928			}
929			else  {
930			  condition1 = TRUE;
931			  condition2 = FALSE;
932			}
933			break;
934		      }
935
936		    }
937		  }
938
939		  /* If we still have not been able to decide then we can not do anything */
940		  if (_False(condition1) && _False(condition2))
941		     continue;
942		}
943	      }
944
945
946	      /* Debugging phase only */
947	      Assert(condition1 != condition2);
948
949
950	      /* Proposition 6 */
951	      if (_True(condition1)) {
952
953		states_cache[index_k] = MASK_LAST;
954		if (_False(already_scheduled)) {
955		  for (i = n_partial_schedule - 1; i >= 0; i --) {
956		    Int index_i = partial_index[i];
957		    if (_False(schedule_as_after(StructOrientations,StructStarts,StructDurations,
958						 index_k,index_i)))
959		       return false();
960		  }
961		}
962
963#if PROPOSITION_9
964		{
965		  /* Proposition 9 */
966
967
968
969		  AuxStart= dereference(StrArg(StructStarts,index_k));
970		  if (IsInt(AuxStart)) {
971
972
973		    if (earliest_start + sum_subset > IVal(AuxStart))
974		       return false();
975		  }
976		  else {
977
978		    if (_False(dupdate_min(AuxStart,earliest_start + sum_subset, list)))
979		       return false();
980
981		    /* Maintain the coherence of the auxilliary data structures */
982
983		    {
984		      AuxStart = dereference(StrArg(StructStarts,index_k));
985		      min_starts[index_k] = gmin(AuxStart);
986		    }
987
988		  }
989		}
990#endif				/* PROPOSITION_9 */
991
992		/* Next operation */
993		continue;
994	      }
995
996	      /* Proposition 7 */
997	      if (_True(condition2)) {
998
999		states_cache[index_k] = MASK_FIRST;
1000		if (_False(already_scheduled)) {
1001		  for ( i = n_partial_schedule -1 ; i >= 0; i --) {
1002		    Int index_i = partial_index[i];
1003		    if (_False(schedule_as_before(StructOrientations,StructStarts,StructDurations,
1004						  index_k,index_i)))
1005		       return false();
1006		  }
1007		}
1008
1009
1010#if PROPOSITION_9
1011		/* Proposition 9 */
1012		{
1013
1014		  AuxStart = dereference(StrArg(StructStarts,index_k));
1015		  if (IsInt(AuxStart)) {
1016
1017		    if (latest_end - sum_subset < IVal(AuxStart) + durations[index_k])
1018		       return false();
1019		  }
1020
1021		  else {
1022
1023		    if (_False(dupdate_max(AuxStart,latest_end - sum_subset - durations[index_k], list)))
1024		       return false();
1025
1026		    /* Maintain the coherence of the auxilliary data structures */
1027		    {
1028		      AuxStart= dereference(StrArg(StructStarts,index_k));
1029		      max_ends[index_k] = gmax(AuxStart) + durations[index_k];
1030		    }
1031		  }
1032
1033		}
1034#endif				/* PROPOSITION_9 */
1035
1036		/* Next operation */
1037		continue;
1038	      }
1039
1040
1041
1042
1043
1044	    }
1045	  }
1046
1047	}
1048#endif				/* PROPOSITION_67 */
1049
1050
1051
1052#if PROPOSITION_12
1053
1054	/* Proposition 12 */
1055
1056	{
1057	  Int min_end_possible_firsts;
1058	  Int max_start_possible_lasts;
1059	  Int temp;
1060
1061	  min_end_possible_firsts = DOMAIN_MAX;
1062	  max_start_possible_lasts = DOMAIN_MIN;
1063
1064	  for (i = n_partial_schedule - 1; i >= 0; i --) {
1065	    Int index_i = partial_index[i];
1066	    Int duration_i = durations[index_i];
1067
1068	    temp = max_ends[index_i] - duration_i;
1069	    if (max_start_possible_lasts < temp)
1070	       max_start_possible_lasts = temp;
1071
1072	    temp = min_starts[index_i] + duration_i;
1073	    if (min_end_possible_firsts > temp)
1074	       min_end_possible_firsts = temp;
1075	  }
1076
1077
1078	  for (i = n_tasks_to_schedule - 1; i >= 0; i --) {
1079	    Int index_i = total_index[i];
1080	    if (subset[index_i] != 1) {
1081	      value_state = states_cache[index_i];
1082	      AuxStart = dereference(StrArg(StructStarts,index_i));
1083
1084	      if (value_state == MASK_POSSIBLE_FIRST){
1085		if (IsInt(AuxStart)) {
1086		  if (IVal(AuxStart) + durations[index_i] > max_start_possible_lasts)
1087		     return false();
1088		}
1089		else {
1090		  if (_False(dupdate_max(AuxStart,max_start_possible_lasts-durations[index_i], list)))
1091		     return false();
1092
1093		  /* Maintain the coherence of the cache data structures */
1094		  AuxStart= dereference(StrArg(StructStarts,index_i));
1095		  max_ends[index_i] = gmax(AuxStart) + durations[index_i];
1096		}
1097	      }
1098
1099
1100
1101	      if (value_state ==  MASK_POSSIBLE_LAST){
1102		if (IsInt(AuxStart)) {
1103		  if (IVal(AuxStart) < min_end_possible_firsts )
1104		     return false();
1105		}
1106		else {
1107		  if (_False(dupdate_min(AuxStart, min_end_possible_firsts, list)))
1108		     return false();
1109
1110
1111		  /* Maintain the coherence of the cache data structures */
1112		  AuxStart= dereference(StrArg(StructStarts,index_i));
1113		  min_starts[index_i] = gmin(AuxStart);
1114
1115
1116		}
1117	      }
1118	    }
1119	  }
1120	}
1121#endif				/* PROPOSITION_12 */
1122
1123
1124      }
1125
1126      /* Skip the tasks which have the same starting date has the current starting */
1127      /* date for the maximal subsets.                                             */
1128      /* If they were not skipped the constraint might consider subsets of maximal */
1129      /* subsets.                                                                  */
1130      /* For instance in the following case:                                       */
1131      /*                                                                           */
1132      /*  increasing_starts: [10 , 20] [10, 30] [ 10, 40] [12 20] ...              */
1133      /*  increasing_ends  :                     ........ [15 20] [15 30] [15 40]  */
1134      /* after generating the maximal subset with starting date 10, one should     */
1135      /* subsets with 12 as minimal starting date.                                 */
1136
1137      {
1138	Int temp_starting_date;
1139	temp_starting_date = increasing_starts[_KeyDate(ptr_starts)];
1140
1141	for (;ptr_starts <= n_tasks_to_schedule &&
1142	     increasing_starts[_KeyDate(ptr_starts)] == temp_starting_date;
1143	     ptr_starts++);
1144      }
1145
1146    }
1147  }
1148
1149  return DELAY;
1150
1151}
1152
1153
1154
1155
1156
1157#undef  _KeyDate
1158#undef  _EndDate
1159#undef  _Index
1160
1161
1162
1163
1164
1165
1166
1167/* i before j */
1168/*ARGSUSED*/
1169BOOLEAN schedule_as_before(pword *StructOrientations, pword *StructStarts, pword *StructDurations, word i, word j)
1170{
1171  Int index;
1172  Int arity;
1173
1174
1175  arity = d_arity(Functor(StructStarts));
1176
1177  /* Debugging phase only */
1178  Assert(i != j);
1179
1180
1181  /* j < i */
1182  if (j < i) {
1183    index = j*arity + i;
1184
1185    FunifyIntLocal(StrArg(StructOrientations,index),2);
1186    if (_False(UNI_RESULT))
1187       return false();
1188
1189  }
1190
1191  /* i < j */
1192  else  {
1193    index = i*arity + j;
1194
1195    FunifyIntLocal(StrArg(StructOrientations,index),1);
1196    if (_False(UNI_RESULT))
1197       return false();
1198
1199  }
1200  return SUCCEED;
1201}
1202
1203/* i after j */
1204/*ARGSUSED*/
1205BOOLEAN schedule_as_after(pword *StructOrientations, pword *StructStarts, pword *StructDurations, word i, word j)
1206{
1207  Int index;
1208  Int arity;
1209
1210
1211
1212  /* Debugging phase only */
1213  Assert(i != j);
1214
1215  arity = d_arity(Functor(StructStarts));
1216
1217  /* j < i */
1218  if (j < i) {
1219    index = j*arity + i;
1220    FunifyIntLocal(StrArg(StructOrientations,index),1);
1221    if (_False(UNI_RESULT))
1222       return false();
1223
1224
1225  }
1226
1227  /* i < j */
1228  else {
1229    index = i*arity + j;
1230
1231    FunifyIntLocal(StrArg(StructOrientations,index),2);
1232    if (_False(UNI_RESULT))
1233       return false();
1234
1235  }
1236
1237  return SUCCEED;
1238}
1239
1240
1241static int
1242p_contigs_interface(value Val1, type Tag1, value Val2, type Tag2, value Val3, type Tag3, value Val4, type Tag4, value Val5, type Tag5, value vl, type tl)
1243{
1244
1245  pword P1,P2,P3,P4,P5;
1246  pword		*list = 0;
1247  int		res;
1248
1249  CopyToPrologWord(P1,Val1.all,Tag1.kernel);
1250  CopyToPrologWord(P2,Val2.all,Tag2.kernel);
1251  CopyToPrologWord(P3,Val3.all,Tag3.kernel);
1252  CopyToPrologWord(P4,Val4.all,Tag4.kernel);
1253  CopyToPrologWord(P5,Val5.all,Tag5.kernel);
1254
1255    res = contigs(&P1,&P2,&P3,&P4,&P5, &list);
1256    if (res == PSUCCEED) {
1257	if (list == (pword *) 0) {
1258	    Return_Unify_Nil(vl, tl)
1259	} else {
1260	    Return_Unify_List(vl, tl, list)
1261	}
1262    } else
1263	return res;
1264}
1265
1266
1267static INLINE BOOLEAN false_contigs(void)
1268{
1269  return FALSE;
1270}
1271
1272
1273
1274static BOOLEAN contigs(pword *StructTable, pword *Sequences, pword *Item, pword *Occurences, pword *Contigs, pword **list)
1275{
1276  PrologWord * Table;
1277  Int end;
1278
1279  /* Smallest length of subsequence of item */
1280  Int at_least_length;
1281
1282  /* Greatest length of a possible sequence of items found */
1283  /* during one iteration.                                 */
1284  Int at_most_length;
1285
1286  /* End of a longest possible sequence of items found    */
1287  /* during one iteration.                                */
1288  Int at_most_length_end;
1289
1290  /* Number of subsequences of the longest possible length */
1291  /* found during one iteration.                           */
1292  Int at_most_length_count;
1293
1294  /* Greatest number of occurences of item in one of the */
1295  /* longest possible subsequences of item.              */
1296  Int at_most_placed;
1297
1298
1299  /* Non volatile (not reset at each iteration) length of a */
1300  /* longest possible sequence of item.                     */
1301  Int non_volatile_greatest_length;
1302
1303
1304  /* contains the current length of the current possible sequence */
1305  Int length_possible_sequence;
1306
1307  Int length_prefix_possible_sequence;
1308
1309  /* contains the number of occurence of items in the current     */
1310  /* possible sequence.                                           */
1311  Int occurences_in_possible_sequence;
1312
1313  /* contains the length of the current sequence of items.  */
1314  Int length_current_sequence;
1315
1316  Int item_value;
1317  Int upper_limit_length_subsequence;
1318  Int lower_limit_length_subsequence;
1319
1320  /* The maximal number of occurences in the sequence*/
1321  Int upper_limit_occurences;
1322
1323
1324  Int at_least_occurences;
1325  Int at_most_occurences;
1326
1327
1328  /* The minimal number of occurences in the sequence */
1329  Int lower_limit_occurences;
1330
1331  /* Counter for the dvariables present in the sequence */
1332  Int count_dvars;
1333
1334  /* Length of the sequence of items */
1335  Int length_global_sequence;
1336
1337
1338  BOOLEAN new_sequence;
1339  Int at_most_contigs, at_least_contigs;
1340  Int counter_contigs;
1341
1342  Int remaining_values;
1343  Int counter_different_items;
1344  Int purge_done;
1345  BOOLEAN iterate;
1346
1347
1348  Occurences = dereference(Occurences);
1349  Sequences = dereference(Sequences);
1350  Contigs = dereference(Contigs);
1351
1352  /* Debugging phase only */
1353  Assert(IsDomVar(Occurences) || IsInt(Occurences));
1354  Assert(IsDomVar(Sequences) || IsInt(Sequences));
1355  Assert(IsDomVar(Contigs) || IsInt(Contigs));
1356  Assert(IsInt(Item));
1357  Assert(IsStruct(StructTable));
1358
1359
1360  Table = StructArgs(StructTable);
1361  end  = d_arity(Functor(StructTable)) - 1;
1362  length_global_sequence  = d_arity(Functor(StructTable));
1363
1364  purge_done = FALSE;
1365  item_value = IVal(Item);
1366
1367
1368  /* Set up the limits for the possible subsequences of items within */
1369  /* the sequence.                                                   */
1370
1371  if (IsInt(Sequences)) {
1372    upper_limit_length_subsequence = IVal(Sequences);
1373    lower_limit_length_subsequence = IVal(Sequences);
1374  }
1375  else {
1376    upper_limit_length_subsequence = dmax(_Ptrbody(Sequences));
1377    lower_limit_length_subsequence = dmin(_Ptrbody(Sequences));
1378  }
1379
1380
1381  /* Set up the upper limit for the number of times the item is present */
1382  /* in the sequence.                                                   */
1383
1384  if (IsInt(Occurences)) {
1385    upper_limit_occurences = IVal(Occurences);
1386    lower_limit_occurences = IVal(Occurences);
1387  }
1388  else {
1389    upper_limit_occurences = dmax(_Ptrbody(Occurences));
1390    lower_limit_occurences = dmin(_Ptrbody(Occurences));
1391  }
1392
1393  /* Set up the upper limit for the number of contigs in the sequence */
1394
1395  if (IsInt(Contigs)) {
1396    at_most_contigs = IVal(Contigs);
1397    at_least_contigs = IVal(Contigs);
1398  }
1399  else {
1400    at_most_contigs = dmax(_Ptrbody(Contigs));
1401    at_least_contigs = dmin(_Ptrbody(Contigs));
1402  }
1403
1404
1405
1406  non_volatile_greatest_length = 0;
1407
1408  /* The iteration loop.                 */
1409  /* Loop until the constraint fixpoints */
1410  do
1411     {
1412       Int i;
1413       PrologWord *temp_item;
1414
1415       iterate = FALSE;
1416       count_dvars = 0;
1417
1418       remaining_values = upper_limit_occurences;
1419       counter_different_items = 0;
1420
1421       length_current_sequence = 0;
1422       length_possible_sequence = 0;
1423       length_prefix_possible_sequence = 0;
1424       occurences_in_possible_sequence = 0;
1425
1426
1427       at_most_length = 0;
1428       at_most_length_count = 0;
1429       at_most_length_end = 0;
1430       at_least_length = 0;
1431       at_most_placed = 0;
1432
1433       new_sequence = TRUE;
1434       counter_contigs = 0;
1435
1436       /* A trivial case of failure */
1437       /* The shortest sequence contains more items than is allowed */
1438
1439       if (lower_limit_length_subsequence > upper_limit_occurences)
1440	  return false_contigs();
1441
1442
1443       /* Scan the global sequence */
1444       for ( i = 0; i <= end; i ++) {
1445
1446	 temp_item = dereference(&Table[i]);
1447
1448
1449
1450	 /* Update the counters and recorders */
1451	 if (at_least_length < length_current_sequence)  {
1452	   at_least_length = length_current_sequence;
1453	 }
1454
1455	 if (at_most_length <= length_possible_sequence) {
1456	   at_most_length = length_possible_sequence;
1457
1458	   /* To record the position of the latest encountered longest possible */
1459	   /* sequence.                                                         */
1460	   if (length_possible_sequence == non_volatile_greatest_length) {
1461	     at_most_length_count ++;
1462	     at_most_length_end = i;
1463	   }
1464	 }
1465
1466	 if (at_most_placed < occurences_in_possible_sequence) {
1467	   at_most_placed = occurences_in_possible_sequence;
1468	 }
1469
1470
1471	 /* Trivial case of failure */
1472	 /* The start of the current sequence contains already more */
1473	 /* items than is allowed.                                  */
1474
1475	 if (length_current_sequence > upper_limit_length_subsequence)
1476	    return false_contigs();
1477
1478
1479	 if (IsInt(temp_item)) {
1480
1481	   /* One more item ... */
1482	   if (IVal(temp_item) == item_value) {
1483
1484	     /* ....  but no more items are allowed */
1485	     if (remaining_values == 0)
1486		return false_contigs();
1487
1488	     /* If it is the beginning of a new sequence one should record this */
1489	     if (_True(new_sequence)) {
1490	       counter_contigs ++;
1491	       new_sequence = FALSE;
1492	     }
1493
1494	     /* The current and possible sequence goes on */
1495	     length_current_sequence ++;
1496
1497	     if (length_possible_sequence == length_prefix_possible_sequence)
1498		length_prefix_possible_sequence ++;
1499
1500	     length_possible_sequence ++;
1501	     occurences_in_possible_sequence ++;
1502
1503	     remaining_values --;
1504
1505	   }
1506
1507	   else {
1508
1509
1510	     /* Start a new sequence */
1511	     length_current_sequence = 0;
1512	     new_sequence = TRUE;
1513
1514	     /* Start a new possible sequence */
1515	     length_possible_sequence = 0;
1516	     occurences_in_possible_sequence = 0;
1517
1518	     /* Count the number of items different from the allowed one */
1519	     counter_different_items ++;
1520	   }
1521
1522	   /* Scan the rest of the global sequence */
1523	   continue;
1524	 }
1525
1526
1527	 /* Fuzzy element ... */
1528	 if (IsDvar(temp_item)) {
1529
1530	   count_dvars += 1;
1531
1532	   /* The item can be at the current place */
1533	   if (_True(present(_Ptrbody(temp_item),item_value))) {
1534
1535
1536	     /* No more items are available to append to the current sequence */
1537	     /* Hence the current element can not have the item as value.     */
1538
1539	     if (remaining_values == 0) {
1540	       /* Satisfy lint */
1541	       if (dremove_value(temp_item,item_value, list)) {;}
1542	       iterate = TRUE;
1543
1544	       /* Start a new sequence */
1545	       length_current_sequence = 0;
1546
1547	       /* Start a new possible sequence */
1548	       length_possible_sequence = 0;
1549	       length_prefix_possible_sequence = 0;
1550	       occurences_in_possible_sequence = 0;
1551
1552	       /* Update the counter of the number of items different from the */
1553	       /* right one.                                                  */
1554	       counter_different_items ++;
1555
1556	       /* Scan the rest of the global sequence */
1557	       continue;
1558	     }
1559
1560
1561	     /* It is not allowed         to have more items in this  */
1562	     /* sequence because its length is already the maximum    */
1563	     /* possible.                                             */
1564
1565	     if (length_current_sequence == upper_limit_length_subsequence) {
1566	       /* Satisfy lint */
1567	       if (dremove_value(temp_item,item_value, list)){;}
1568	       iterate = TRUE;
1569
1570	       /* Start a new sequence */
1571	       length_current_sequence = 0;
1572
1573	       /* Start a new possible sequence */
1574	       length_possible_sequence = 0;
1575	       length_prefix_possible_sequence = 0;
1576	       occurences_in_possible_sequence = 0;
1577
1578	       /* Update the counter of the number of items different from the */
1579	       /* right one.                                                  */
1580	       counter_different_items ++;
1581
1582	       /* Scan the rest of the global sequence */
1583	       continue;
1584	     }
1585
1586	     /* If a sequence of the minimum length has not yet been found*/
1587	     /* some available items must be used NOW if we hope to be    */
1588	     /* able to fill a sequence of the minimum length.            */
1589
1590	     if (remaining_values < lower_limit_length_subsequence &&
1591		 at_least_length < lower_limit_length_subsequence) {
1592
1593	       FunifyIntLocal(temp_item,item_value);
1594	       if (_False(UNI_RESULT))
1595		  return false_contigs();
1596
1597	       iterate = TRUE;
1598
1599	       remaining_values --;
1600
1601	       /* The sequence goes on */
1602	       length_current_sequence ++;
1603
1604	       /* The possible sequence goes on */
1605	       length_possible_sequence ++;
1606	       length_prefix_possible_sequence ++;
1607
1608	       /* Scan the rest of the global sequence */
1609	       continue;
1610	     }
1611
1612
1613	     /* Nothing definitive can be said about the current element.     */
1614	     /* The current sequence stops here whereas the possible sequence */
1615	     /* can go on.                                                    */
1616	     {
1617
1618	       /* Start a new sequence */
1619	       length_current_sequence = 0;
1620
1621	       /* The possible sequence goes on */
1622	       length_possible_sequence ++;
1623
1624	       /* Scan the rest of the global sequence */
1625	       continue;
1626	     }
1627	   }
1628
1629	   /* The item can not be at the current place */
1630	   else {
1631
1632	     /* The current sequence and the possible sequence must stop here */
1633	     {
1634	       /* Start a new sequence */
1635	       length_current_sequence = 0;
1636	       new_sequence = TRUE;
1637
1638	       /* Start a new possible sequence */
1639	       length_possible_sequence = 0;
1640	       length_prefix_possible_sequence = 0;
1641	       occurences_in_possible_sequence = 0;
1642
1643	       /* Update the counter of the number of items different from the */
1644	       /* right one.                                                  */
1645	       counter_different_items ++;
1646
1647	       /* Scan the rest of the global sequence */
1648	       continue;
1649	     }
1650	   }
1651	 }
1652       }
1653
1654
1655       /* Update the counters and recorders */
1656       if (at_least_length < length_current_sequence)  {
1657	 at_least_length = length_current_sequence;
1658       }
1659
1660       if (at_most_length < length_possible_sequence) {
1661	 at_most_length = length_possible_sequence;
1662       }
1663
1664       if (at_most_placed < occurences_in_possible_sequence) {
1665	 at_most_placed = occurences_in_possible_sequence;
1666       }
1667
1668       if (at_most_length < length_possible_sequence) {
1669	 at_most_length = length_possible_sequence;
1670       }
1671
1672       /* The scan of the global sequence has been done in one direction hence */
1673       /* some information discovered in the later steps of the scan should    */
1674       /* back propagated.                                                     */
1675
1676       /* 1/                                                                   */
1677       /* There are two many different items. The minimal number of occurences */
1678       /* can not be reached any more.                                         */
1679       if (length_global_sequence - counter_different_items < lower_limit_occurences) {
1680	 return false_contigs();
1681       }
1682
1683       /* 2/                                                                   */
1684       /* the number of items different from the right one can only be known   */
1685       /* after a complete scan. An additional iteration is needed when  the   */
1686       /* number of occurences is reduced.                                     */
1687       if (length_global_sequence - counter_different_items < upper_limit_occurences) {
1688	 upper_limit_occurences = length_global_sequence - counter_different_items;
1689	 iterate = TRUE;
1690	 continue;
1691       }
1692
1693       /* 3/                                                                    */
1694       /* The maximum number of available items has been found in the global    */
1695       /* sequence (information only available after the completion of the scan)*/
1696       /* Hence the item must be removed from the domain of all variables       */
1697       /* remaining in the sequence.                                            */
1698
1699       if (remaining_values == 0 && count_dvars != 0 &&  _False(purge_done)) {
1700	 purge_done = TRUE;
1701	 for ( i = 0; i <= end; i ++) {
1702	   temp_item = dereference(&Table[i]);
1703	   if (IsDvar(temp_item)) {
1704	     /* Satisfy lint */
1705	     if (dremove_value(temp_item,item_value, list)) {;}
1706	     iterate = TRUE;
1707	   }
1708	 }
1709	 continue;
1710       }
1711
1712       /* 4/                                                                    */
1713       /* There are remaining items to be put somewhere and there is exactly the*/
1714       /* corresponding amount of empty slots. The items MUST fit in these slots*/
1715
1716       if (upper_limit_occurences - remaining_values + count_dvars
1717	   == lower_limit_occurences){
1718	 for ( i = 0; i <= end; i ++) {
1719	   temp_item = dereference(&Table[i]);
1720	   if (IsDvar(temp_item)) {
1721	     if (_True(present(_Ptrbody(temp_item),item_value))) {
1722	       FunifyIntLocal(temp_item,item_value);
1723	       if (_False(UNI_RESULT))
1724		  return false_contigs();
1725	       iterate = TRUE;
1726	     }
1727	     else
1728		return false_contigs();
1729	   }
1730	   continue;
1731	 }
1732       }
1733
1734       /* 5/                                                                   */
1735       /* Record the length of the longest sequence ever found                 */
1736       if (non_volatile_greatest_length < at_most_length) {
1737	 non_volatile_greatest_length = at_most_length;
1738	 iterate = TRUE;
1739	 continue;
1740       }
1741
1742       /* 6/                                                                   */
1743       /* If the least count of possible contigs is already equal to the       */
1744       /* maximal allowed count of contigs then the holes in the global        */
1745       /* sequence which can potentially create new contigs should be filled   */
1746       /* accordingly.                                                         */
1747
1748       /*        1 _ _ _ _ 1 1 1 _ _ _ 1   and ncontigs == 1                   */
1749       /* can be automatically transformed into:                               */
1750       /*        1 1 1 1 1 1 1 1 1 1 1 1                                       */
1751
1752       if (counter_contigs == at_most_contigs) {
1753	 Int temp_start,j;
1754	 PrologWord *temp_ppw;
1755
1756	 temp_start = -1;
1757	 for ( i = 0; i <= end; i ++) {
1758	   temp_item = dereference(&Table[i]);
1759	   if (IsInt(temp_item) && IVal(temp_item) == item_value) {
1760
1761	     /* If we have found the end of a       possible contig then we fill */
1762	     /* the contig.                                                      */
1763	     if (temp_start >= 0) {
1764	       for (j = temp_start + 1; j < i; j ++) {
1765
1766		 /* If there is an item in the list whose value has not been fixed    */
1767		 /* and which is between two items which have the searched value, the */
1768		 /* not yet fixed item must be given the searched value. Otherwise the*/
1769		 /* number of contigs would increase.                                 */
1770
1771		 temp_ppw = dereference(&Table[j]);
1772		 if (!IsInt(temp_ppw)) {
1773		   FunifyIntLocal(temp_ppw,item_value);
1774		   if (_False(UNI_RESULT))
1775		      return false_contigs();
1776		   iterate = TRUE;
1777		 }
1778	       }
1779
1780	       /* The end of this contig is the start of the next one */
1781	       temp_start = i;
1782	     }
1783	     else {
1784
1785	       /* The start of a contig */
1786	       temp_start = i;
1787	     }
1788	   }
1789	 }
1790       }
1791
1792
1793
1794     } while (_True(iterate));
1795
1796
1797  /* Propagation on size of the longest chunk of consecutive value */
1798  /* in the sequence.                                              */
1799
1800  /* Already Dereferenced */
1801  if (IsDvar(Sequences)) {
1802
1803    /* The least possible number of items present in the sequence */
1804    /* is known and can propagated to the domain variable which   */
1805    /* gives the possible values for this length.                 */
1806
1807    if (_False(dupdate_min(Sequences,at_least_length, list)))
1808       return false_contigs();
1809
1810    Sequences = dereference(Sequences);
1811
1812
1813
1814    /* The greatest possible number of items present in the sequence */
1815    /* is known and can propagated to the domain variable whic       */
1816    /* gives the possible values for this length.                    */
1817
1818    /* Maybe the domain variable has been reduced to an integer by the */
1819    /* previous update.                                                */
1820
1821    if (IsInt(Sequences)) {
1822      if (IVal(Sequences) > at_most_length)
1823	 return false_contigs();
1824    }
1825
1826    if (IsDvar(Sequences)){
1827      if (_False(dupdate_max(Sequences,at_most_length, list)))
1828	 return false_contigs();
1829    }
1830  }
1831
1832  else if (IsInt(Sequences)) {
1833
1834    /* Fail when there is necessarily more items than required */
1835    if (at_least_length > IVal(Sequences))
1836       return false_contigs();
1837
1838    /* If there is only place where a sequence of the correct maximal */
1839    /* length can be found, then the sequence must be put there.      */
1840
1841    if (at_most_length_count == 1 && at_most_length == IVal(Sequences)) {
1842      Int i;
1843      for (i = at_most_length_end - at_most_length - 1;
1844	   i < at_most_length_end;
1845	   i ++)
1846	 {
1847	   PrologWord *temp;
1848	   temp = dereference(&Table[i]);
1849	   if (IsDvar(temp)) {
1850	     FunifyIntLocal(temp,item_value);
1851	     if (_False(UNI_RESULT))
1852		return false_contigs();
1853	   }
1854	 }
1855    }
1856  }
1857
1858  /* Check whether there is enough occurences of the item so as to */
1859  /* enable to have a subsequnce of the minimum length.            */
1860
1861  Sequences = dereference(Sequences);
1862
1863  {
1864    Int min_length_necessary;
1865
1866    if (IsInt(Sequences))
1867       min_length_necessary = IVal(Sequences);
1868    else
1869       min_length_necessary = dmin(_Ptrbody(Sequences));
1870
1871    if (at_least_length < min_length_necessary)
1872       if ((at_most_placed + remaining_values) < min_length_necessary)
1873	  return false_contigs();
1874  }
1875
1876
1877  /* Propagation on the number of times the value is present */
1878  /* in the sequence.                                        */
1879
1880
1881  /* There are too many items or not enough items in the sequence */
1882  /* Already Dereferenced */
1883
1884  if (IsInt(Occurences)) {
1885
1886    /* Not enough */
1887    if (count_dvars == 0 && remaining_values != 0)
1888       return false_contigs();
1889
1890    /* Too many */
1891  }
1892
1893  else if (IsDvar(Occurences)) {
1894    at_least_occurences = upper_limit_occurences -  remaining_values;
1895    at_most_occurences = length_global_sequence - counter_different_items;
1896
1897    /* When no variables are left the number of occurences of the item in the */
1898    /* sequence is known.                                                     */
1899    if (count_dvars == 0) {
1900      if (_True(present(_Ptrbody(Occurences), at_least_occurences))) {
1901	FunifyIntLocal(Occurences,at_least_occurences);
1902	if (_False(UNI_RESULT))
1903	   return false_contigs();
1904      }
1905      else
1906	 return false_contigs();
1907    }
1908
1909    else {
1910
1911      /* The minimal number of occurences is known; it can be */
1912      /* propagated to the domain variable describing the     */
1913      /* possible occurences number.                          */
1914
1915      if (_False(dupdate_min(Occurences,at_least_occurences, list)))
1916	 return false_contigs();
1917
1918      Occurences= dereference(Occurences);
1919
1920      if (IsInt(Occurences))
1921	 if (IVal(Occurences) > at_most_occurences)
1922	    return false_contigs();
1923
1924      if (IsDvar(Occurences))
1925	 if _False(dupdate_max(Occurences,at_most_occurences, list))
1926	    return false_contigs();
1927    }
1928  }
1929
1930
1931  if (at_least_contigs < counter_contigs)
1932     at_least_contigs = counter_contigs;
1933
1934  if (count_dvars == 0) {
1935    at_most_contigs = counter_contigs;
1936    at_least_contigs = counter_contigs;
1937  }
1938
1939  if (IsInt(Contigs)) {
1940    if (IVal(Contigs) < at_least_contigs)
1941       return false_contigs();
1942    if (IVal(Contigs) > at_most_contigs)
1943       return false_contigs();
1944  }
1945  else {
1946    if (_False(dupdate_min(Contigs,at_least_contigs, list)))
1947       return false_contigs();
1948
1949    Contigs = dereference(Contigs);
1950
1951    if (IsInt(Contigs)) {
1952       if (IVal(Contigs) > at_most_contigs)
1953	  return false_contigs();
1954     }
1955    else {
1956      if (_False(dupdate_max(Contigs,at_most_contigs, list)))
1957	 return false_contigs();
1958    }
1959
1960  }
1961
1962
1963  if (count_dvars == 0)
1964     return SUCCEED;
1965
1966  return DELAY;
1967}
1968
1969
1970
1971static int
1972p_sequences_interface(value Val1, type Tag1, value Val2, type Tag2, value Val3, type Tag3, value Val4, type Tag4, value vl, type tl)
1973{
1974
1975  pword P1,P2,P3,P4;
1976  pword		*list = 0;
1977  int		res;
1978
1979  CopyToPrologWord(P1,Val1.all,Tag1.kernel);
1980  CopyToPrologWord(P2,Val2.all,Tag2.kernel);
1981  CopyToPrologWord(P3,Val3.all,Tag3.kernel);
1982  CopyToPrologWord(P4,Val4.all,Tag4.kernel);
1983
1984    res = sequences(&P1,&P2,&P3,&P4, &list);
1985    if (res == PSUCCEED) {
1986	if (list == (pword *) 0) {
1987	    Return_Unify_Nil(vl, tl)
1988	} else {
1989	    Return_Unify_List(vl, tl, list)
1990	}
1991    } else
1992	return res;
1993}
1994
1995
1996
1997static INLINE BOOLEAN false_sequences(void)
1998{
1999  return FALSE;
2000}
2001
2002static BOOLEAN sequences(pword *StructTable, pword *Sequences, pword *Item, pword *Occurences, pword **list)
2003{
2004  PrologWord * Table;
2005  Int end;
2006
2007  /* Smallest length of subsequence of item */
2008  Int at_least_length;
2009
2010  /* Greatest length of a possible sequence of items found */
2011  /* during one iteration.                                 */
2012  Int at_most_length;
2013
2014  /* End of a longest possible sequence of items found    */
2015  /* during one iteration.                                */
2016  Int at_most_length_end;
2017
2018  /* Number of subsequences of the longest possible length */
2019  /* found during one iteration.                           */
2020  Int at_most_length_count;
2021
2022  /* Greatest number of occurences of item in one of the */
2023  /* longest possible subsequences of item.              */
2024  Int at_most_placed;
2025
2026
2027  /* Non volatile (not reset at each iteration) length of a */
2028  /* longest possible sequence of item.                     */
2029  Int non_volatile_greatest_length;
2030
2031
2032
2033  /* contains the current length of the current possible sequence */
2034  Int length_possible_sequence;
2035
2036  Int length_prefix_possible_sequence;
2037
2038  /* contains the number of occurence of items in the current     */
2039  /* possible sequence.                                           */
2040  Int occurences_in_possible_sequence;
2041
2042  /* contains the length of the current sequence of items.  */
2043  Int length_current_sequence;
2044
2045  Int item_value;
2046  Int upper_limit_length_subsequence;
2047  Int lower_limit_length_subsequence;
2048
2049  /* The maximal number of occurences in the sequence*/
2050  Int upper_limit_occurences;
2051
2052
2053
2054
2055  Int at_least_occurences;
2056  Int at_most_occurences;
2057
2058
2059  /* The minimal number of occurences in the sequence */
2060  Int lower_limit_occurences;
2061
2062  /* Counter for the dvariables present in the sequence */
2063  Int count_dvars;
2064
2065  /* Length of the sequence of items */
2066  Int length_global_sequence;
2067
2068
2069  Int remaining_values;
2070  Int counter_different_items;
2071
2072  Int purge_done;
2073
2074  BOOLEAN iterate;
2075
2076
2077  Occurences = dereference(Occurences);
2078  Sequences = dereference(Sequences);
2079
2080  /* Debugging phase only */
2081  Assert(IsDomVar(Occurences) || IsInt(Occurences));
2082  Assert(IsDomVar(Sequences) || IsInt(Sequences));
2083  Assert(IsInt(Item));
2084  Assert(IsStruct(StructTable));
2085
2086
2087  Table = StructArgs(StructTable);
2088  end  = d_arity(Functor(StructTable)) - 1;
2089  length_global_sequence  = d_arity(Functor(StructTable));
2090
2091  purge_done = FALSE;
2092  item_value = IVal(Item);
2093
2094
2095  /* Set up the limits for the possible subsequences of items within */
2096  /* the sequence.                                                   */
2097
2098  if (IsInt(Sequences)) {
2099    upper_limit_length_subsequence = IVal(Sequences);
2100    lower_limit_length_subsequence = IVal(Sequences);
2101  }
2102  else {
2103    upper_limit_length_subsequence = dmax(_Ptrbody(Sequences));
2104    lower_limit_length_subsequence = dmin(_Ptrbody(Sequences));
2105  }
2106
2107
2108  /* Set up the upper limit for the number of times the item is present */
2109  /* in the sequence.                                                   */
2110
2111  if (IsInt(Occurences)) {
2112    upper_limit_occurences = IVal(Occurences);
2113    lower_limit_occurences = IVal(Occurences);
2114  }
2115  else {
2116    upper_limit_occurences = dmax(_Ptrbody(Occurences));
2117    lower_limit_occurences = dmin(_Ptrbody(Occurences));
2118  }
2119
2120  /* A trivial case of failure */
2121  /* The shortest sequence contains more items than is allowed */
2122  if (lower_limit_length_subsequence > upper_limit_occurences)
2123     return false_sequences();
2124
2125
2126  non_volatile_greatest_length = 0;
2127
2128  /* The iteration loop.                 */
2129  /* Loop until the constraint fixpoints */
2130  do
2131     {
2132       Int i;
2133       PrologWord *temp_item;
2134
2135       iterate = FALSE;
2136       count_dvars = 0;
2137
2138       remaining_values = upper_limit_occurences;
2139       counter_different_items = 0;
2140
2141       length_current_sequence = 0;
2142       length_possible_sequence = 0;
2143       length_prefix_possible_sequence = 0;
2144       occurences_in_possible_sequence = 0;
2145
2146
2147       at_most_length = 0;
2148       at_most_length_count = 0;
2149       at_most_length_end = 0;
2150       at_least_length = 0;
2151       at_most_placed = 0;
2152
2153
2154       /* Scan the global sequence */
2155       for ( i = 0; i <= end; i ++) {
2156
2157	 temp_item = dereference(&Table[i]);
2158
2159
2160
2161	 /* Update the counters and recorders */
2162	 if (at_least_length < length_current_sequence)  {
2163	   at_least_length = length_current_sequence;
2164	 }
2165
2166	 if (at_most_length <= length_possible_sequence) {
2167	   at_most_length = length_possible_sequence;
2168
2169	   if (length_possible_sequence == non_volatile_greatest_length) {
2170	     at_most_length_count ++;
2171	     at_most_length_end = i;
2172	   }
2173	 }
2174
2175	 if (at_most_placed < occurences_in_possible_sequence) {
2176	   at_most_placed = occurences_in_possible_sequence;
2177	 }
2178
2179
2180	 /* Trivial case of failure */
2181	 /* The start of the current sequence contains already more */
2182	 /* items than is allowed.                                  */
2183
2184	 if (length_current_sequence > upper_limit_length_subsequence)
2185	    return false_sequences();
2186
2187
2188	 if (IsInt(temp_item)) {
2189
2190	   /* One more item ... */
2191	   if (IVal(temp_item) == item_value) {
2192
2193	     /* ....  but no more items are allowed */
2194	     if (remaining_values == 0)
2195		return false_sequences();
2196
2197	     /* The current and possible sequence go on */
2198	     length_current_sequence ++;
2199
2200	     if (length_possible_sequence == length_prefix_possible_sequence)
2201		length_prefix_possible_sequence ++;
2202
2203	     length_possible_sequence ++;
2204	     occurences_in_possible_sequence ++;
2205
2206	     remaining_values --;
2207
2208	   }
2209
2210	   else {
2211
2212	     /* Start a new sequence */
2213	     length_current_sequence = 0;
2214
2215	     /* Start a new possible sequence */
2216	     length_possible_sequence = 0;
2217	     occurences_in_possible_sequence = 0;
2218
2219	     /* Count the number of items different from the allowed one */
2220	     counter_different_items ++;
2221	   }
2222
2223	   /* Scan the rest of the global sequence */
2224	   continue;
2225	 }
2226
2227
2228	 /* Fuzzy element ... */
2229	 if (IsDvar(temp_item)) {
2230
2231	   count_dvars += 1;
2232
2233	   /* The item can be at the current place */
2234	   if (_True(present(_Ptrbody(temp_item),item_value))) {
2235
2236
2237	     /* No more items are available to append to the current sequence */
2238	     /* Hence the current element can not have the item as value.     */
2239
2240	     if (remaining_values == 0) {
2241	       /* Satisfy lint */
2242	       if (dremove_value(temp_item,item_value, list)) {;}
2243	       iterate = TRUE;
2244
2245	       /* Start a new sequence */
2246	       length_current_sequence = 0;
2247
2248	       /* Start a new possible sequence */
2249	       length_possible_sequence = 0;
2250	       length_prefix_possible_sequence = 0;
2251	       occurences_in_possible_sequence = 0;
2252
2253	       /* Update the counter of the number of items different from the */
2254	       /* right one.                                                  */
2255	       counter_different_items ++;
2256
2257	       /* Scan the rest of the global sequence */
2258	       continue;
2259	     }
2260
2261
2262	     /* It is not allowed         to have more items in this  */
2263	     /* sequence because its length is already the maximum    */
2264	     /* possible.                                             */
2265
2266	     if (length_current_sequence == upper_limit_length_subsequence) {
2267	       /* Satisfy lint */
2268	       if (dremove_value(temp_item,item_value, list)){;}
2269	       iterate = TRUE;
2270
2271	       /* Start a new sequence */
2272	       length_current_sequence = 0;
2273
2274	       /* Start a new possible sequence */
2275	       length_possible_sequence = 0;
2276	       length_prefix_possible_sequence = 0;
2277	       occurences_in_possible_sequence = 0;
2278
2279	       /* Update the counter of the number of items different from the */
2280	       /* right one.                                                  */
2281	       counter_different_items ++;
2282
2283	       /* Scan the rest of the global sequence */
2284	       continue;
2285	     }
2286
2287	     /* If a sequence of the minimum length has not yet been found*/
2288	     /* some available items must be used NOW if we hope to be    */
2289	     /* able to fill a sequence of the minimum length.            */
2290
2291	     if (remaining_values < lower_limit_length_subsequence &&
2292		 at_least_length < lower_limit_length_subsequence) {
2293
2294	       FunifyIntLocal(temp_item,item_value);
2295	       if (_False(UNI_RESULT))
2296		  return false_sequences();
2297
2298	       iterate = TRUE;
2299
2300	       remaining_values --;
2301
2302	       /* The sequence goes on */
2303	       length_current_sequence ++;
2304
2305	       /* The possible sequence goes on */
2306	       length_possible_sequence ++;
2307	       length_prefix_possible_sequence ++;
2308
2309	       /* Scan the rest of the global sequence */
2310	       continue;
2311	     }
2312
2313
2314	     /* Nothing definitive can be said about the current element.     */
2315	     /* The current sequence stops here whereas the possible sequence */
2316	     /* can go on.                                                    */
2317	     {
2318
2319	       /* Start a new sequence */
2320	       length_current_sequence = 0;
2321
2322	       /* The possible sequence goes on */
2323	       length_possible_sequence ++;
2324
2325	       /* Scan the rest of the global sequence */
2326	       continue;
2327	     }
2328	   }
2329
2330	   /* The item can not be at the current place */
2331	   else {
2332
2333	     /* The current sequence and the possible sequence must stop here */
2334	     {
2335	       /* Start a new sequence */
2336	       length_current_sequence = 0;
2337
2338	       /* Start a new possible sequence */
2339	       length_possible_sequence = 0;
2340	       length_prefix_possible_sequence = 0;
2341	       occurences_in_possible_sequence = 0;
2342
2343	       /* Update the counter of the number of items different from the */
2344	       /* right one.                                                  */
2345	       counter_different_items ++;
2346
2347	       /* Scan the rest of the global sequence */
2348	       continue;
2349	     }
2350	   }
2351	 }
2352       }
2353
2354
2355       /* Update the counters and recorders */
2356       if (at_least_length < length_current_sequence)  {
2357	 at_least_length = length_current_sequence;
2358       }
2359
2360       if (at_most_length < length_possible_sequence) {
2361	 at_most_length = length_possible_sequence;
2362       }
2363
2364       if (at_most_placed < occurences_in_possible_sequence) {
2365	 at_most_placed = occurences_in_possible_sequence;
2366       }
2367
2368       if (at_most_length < length_possible_sequence) {
2369	 at_most_length = length_possible_sequence;
2370
2371       }
2372
2373
2374       /* The scan of the global sequence has been done in one direction hence */
2375       /* some information discovered in the later steps of the scan should    */
2376       /* back propagated.                                                     */
2377
2378       /* 1/                                                                   */
2379       /* There are two many different items. The minimal number of occurences */
2380       /* can not be reached any more.                                         */
2381       if (length_global_sequence - counter_different_items < lower_limit_occurences) {
2382	 return false_sequences();
2383       }
2384
2385       /* 2/                                                                   */
2386       /* the number of items different from the right one can only be known   */
2387       /* after a complete scan. An additional iteration is needed when  the   */
2388       /* number of occurences is reduced.                                     */
2389       if (length_global_sequence - counter_different_items < upper_limit_occurences) {
2390	 upper_limit_occurences = length_global_sequence - counter_different_items;
2391	 iterate = TRUE;
2392	 continue;
2393       }
2394
2395       /* 3/                                                                    */
2396       /* The maximum number of available items has been found in the global    */
2397       /* sequence (information only available after the completion of the scan)*/
2398       /* Hence the item must be removed from the domain of all variables       */
2399       /* remaining in the sequence.                                            */
2400
2401       if (remaining_values == 0 && count_dvars != 0 &&  _False(purge_done)) {
2402	 purge_done = TRUE;
2403	 for ( i = 0; i <= end; i ++) {
2404	   temp_item = dereference(&Table[i]);
2405	   if (IsDvar(temp_item)) {
2406	     /* Satisfy lint */
2407	     if (dremove_value(temp_item,item_value, list)) {;}
2408	     iterate = TRUE;
2409	   }
2410	 }
2411	 continue;
2412       }
2413
2414       /* 4/                                                                    */
2415       /* There are remaining items to be put somewhere and there is exactly the*/
2416       /* corresponding amount of empty slots. The items MUST fit in these slots*/
2417
2418       if (upper_limit_occurences - remaining_values + count_dvars
2419	   == lower_limit_occurences){
2420	 for ( i = 0; i <= end; i ++) {
2421	   temp_item = dereference(&Table[i]);
2422	   if (IsDvar(temp_item)) {
2423	     FunifyIntLocal(temp_item,item_value);
2424	     if (_False(UNI_RESULT))
2425		return false_sequences();
2426	     iterate = TRUE;
2427	   }
2428	   continue;
2429	 }
2430       }
2431
2432       /* 5/                                                                   */
2433       /* Record the length of the longest sequence ever found                 */
2434       if (non_volatile_greatest_length < at_most_length) {
2435	 non_volatile_greatest_length = at_most_length;
2436	 iterate = TRUE;
2437	 continue;
2438       }
2439
2440
2441
2442     } while (_True(iterate));
2443
2444
2445  /* Propagation on size of the longest chunk of consecutive value */
2446  /* in the sequence.                                              */
2447
2448  /* Already Dereferenced */
2449  if (IsDvar(Sequences)) {
2450
2451    /* The least possible number of items present in the sequence */
2452    /* is known and can propagated to the domain variable which   */
2453    /* gives the possible values for this length.                 */
2454
2455    if (_False(dupdate_min(Sequences,at_least_length, list)))
2456       return false_sequences();
2457
2458    Sequences = dereference(Sequences);
2459
2460
2461
2462    /* The greatest possible number of items present in the sequence */
2463    /* is known and can propagated to the domain variable whic       */
2464    /* gives the possible values for this length.                    */
2465
2466    /* Maybe the domain variable has been reduced to an integer by the */
2467    /* previous update.                                                */
2468
2469    if (IsInt(Sequences)) {
2470      if (IVal(Sequences) > at_most_length)
2471	 return false_sequences();
2472    }
2473
2474    if (IsDvar(Sequences)){
2475      if (_False(dupdate_max(Sequences,at_most_length, list)))
2476	 return false_sequences();
2477    }
2478  }
2479
2480  else if (IsInt(Sequences)) {
2481
2482    /* Fail when there is necessarily more items than required */
2483    if (at_least_length > IVal(Sequences))
2484       return false_sequences();
2485
2486    /* If there is only place where a sequence of the correct maximal */
2487    /* length can be found, then the sequence must be put there.      */
2488
2489    if (at_most_length_count == 1 && at_most_length == IVal(Sequences)) {
2490      Int i;
2491      for (i = at_most_length_end - at_most_length - 1;
2492	   i < at_most_length_end;
2493	   i ++)
2494	 {
2495	   PrologWord *temp;
2496	   temp = dereference(&Table[i]);
2497	   if (IsDvar(temp)) {
2498	     FunifyIntLocal(temp,item_value);
2499	     if (_False(UNI_RESULT))
2500		return false_sequences();
2501	   }
2502	 }
2503    }
2504  }
2505
2506  /* Check whether there is enough occurences of the item so as to */
2507  /* enable to have a subsequnce of the minimum length.            */
2508
2509  Sequences = dereference(Sequences);
2510
2511  {
2512    Int min_length_necessary;
2513
2514    if (IsInt(Sequences))
2515       min_length_necessary = IVal(Sequences);
2516    else
2517       min_length_necessary = dmin(_Ptrbody(Sequences));
2518
2519    if (at_least_length < min_length_necessary)
2520       if ((at_most_placed + remaining_values) < min_length_necessary)
2521	  return false_sequences();
2522  }
2523
2524
2525  /* Propagation on the number of times the value is present */
2526  /* in the sequence.                                        */
2527
2528
2529  /* There are too many items or not enough items in the sequence */
2530  /* Already Dereferenced */
2531
2532  if (IsInt(Occurences)) {
2533
2534    /* Not enough */
2535    if (count_dvars == 0 && remaining_values != 0)
2536       return false_sequences();
2537
2538    /* Too many */
2539  }
2540
2541  else if (IsDvar(Occurences)) {
2542    at_least_occurences = upper_limit_occurences -  remaining_values;
2543    at_most_occurences = length_global_sequence - counter_different_items;
2544
2545    /* When no variables are left the number of occurences of the item in the */
2546    /* sequence is known.                                                     */
2547    if (count_dvars == 0) {
2548      if (_True(present(_Ptrbody(Occurences), at_least_occurences))) {
2549	FunifyIntLocal(Occurences,at_least_occurences);
2550	if (_False(UNI_RESULT))
2551	   return false_sequences();
2552      }
2553      else
2554	 return false_sequences();
2555    }
2556
2557    else {
2558
2559      /* The minimal number of occurences is known; it can be */
2560      /* propagated to the domain variable describing the     */
2561      /* possible occurences number.                          */
2562
2563      if (_False(dupdate_min(Occurences,at_least_occurences, list)))
2564	 return false_sequences();
2565
2566      Occurences = dereference(Occurences);
2567
2568      if (IsInt(Occurences))
2569	 if (IVal(Occurences) > at_most_occurences)
2570	    return false_sequences();
2571
2572      if (IsDvar(Occurences))
2573	 if _False(dupdate_max(Occurences,at_most_occurences, list))
2574	    return false_sequences();
2575    }
2576  }
2577
2578
2579
2580
2581  if (count_dvars == 0)
2582     return SUCCEED;
2583
2584  return DELAY;
2585
2586
2587}
2588
2589
2590static int
2591p_disjunction_choose_interface(value Val1, type Tag1, value Val2, type Tag2, value Val3, type Tag3, value Val4, type Tag4, value Val5, type Tag5, value vl, type tl)
2592{
2593
2594  pword P1,P2,P3,P4,P5;
2595  pword		*list = 0;
2596  int		res;
2597
2598  CopyToPrologWord(P1,Val1.all,Tag1.kernel);
2599  CopyToPrologWord(P2,Val2.all,Tag2.kernel);
2600  CopyToPrologWord(P3,Val3.all,Tag3.kernel);
2601  CopyToPrologWord(P4,Val4.all,Tag4.kernel);
2602  CopyToPrologWord(P5,Val5.all,Tag5.kernel);
2603
2604    res = disjunction_choose(&P1,&P2,&P3,&P4,&P5, &list);
2605    if (res == PSUCCEED) {
2606	if (list == (pword *) 0) {
2607	    Return_Unify_Nil(vl, tl)
2608	} else {
2609	    Return_Unify_List(vl, tl, list)
2610	}
2611    } else
2612	return res;
2613}
2614
2615
2616
2617static BOOLEAN disjunction_choose(pword *x, pword *Dx, pword *y, pword *Dy, pword *branch, pword **list)
2618{
2619  PrologWord *X,*Y,*Branch;
2620  BOOLEAN x_after_y = FALSE;
2621  BOOLEAN y_after_x = FALSE;
2622  BOOLEAN res;
2623  PrologWord *dx, *dy;
2624
2625  Branch = dereference(branch);
2626  dx = dereference(Dx);
2627  dy = dereference(Dy);
2628  x = dereference(x);
2629  y = dereference(y);
2630
2631  /* Debugging phase only */
2632  Assert(IsDomVar(Branch) || IsInt(Branch));
2633  Assert(IsInt(dx) && IsInt(dy));
2634
2635  /* An easy case which does not require to go through all the machinery */
2636
2637  if (IsInt(Branch)) {
2638    if (IVal(Branch) == 1) {
2639
2640      /* From now on the constraint is going to behave has an inequality */
2641      /* Instead of keeping it active as such, it better to replace it by*/
2642      /* a true inequality which is less reactive to the updates of its  */
2643      /* arguments. Useless wake-ups will then be avoided.               */
2644
2645      res = setup_domain_greatereq(y,x,dx, list);
2646
2647      /* Solve this constraint */
2648      if (res == DELAY)
2649	 return SUCCEED;
2650      return res;
2651    }
2652    if (IVal(Branch) == 2) {
2653
2654      /* From now on the constraint is going to behave has an inequality */
2655      /* Instead of keeping it active as such, it better to replace it by*/
2656      /* a true inequality which is less reactive to the updates of its  */
2657      /* arguments. Useless wake-ups will then be avoided.               */
2658
2659      res = setup_domain_greatereq(x,y,dy, list);
2660
2661      /* Solve this constraint */
2662      if (res == DELAY)
2663	 return SUCCEED;
2664      return res;
2665    }
2666
2667    /* Should never get there */
2668    Assert(0);
2669  }
2670
2671
2672  X = dereference(x);
2673  Y = dereference(y);
2674
2675  y_after_x = TRUE;
2676  x_after_y = TRUE;
2677
2678  if (gmin(X) + IVal(dx) > gmax(Y))
2679     y_after_x = FALSE;
2680  if (gmin(Y) + IVal(dy) > gmax(X))
2681     x_after_y = FALSE;
2682
2683  if (_False(y_after_x) && _False(x_after_y))
2684     return FAIL;
2685
2686  if (_False(y_after_x)) {
2687    FunifyIntLocal(Branch,2);
2688
2689    res = setup_domain_greatereq(x,y,dy, list);
2690
2691    /* Solve this constraint */
2692    if (res == DELAY)
2693       return SUCCEED;
2694    return res;
2695  }
2696
2697  if (_False(x_after_y)) {
2698    FunifyIntLocal(Branch,1);
2699
2700    res = setup_domain_greatereq(y,x,dx, list);
2701
2702    /* Solve this constraint */
2703    if (res == DELAY)
2704       return SUCCEED;
2705    return res;
2706  }
2707
2708
2709  return DELAY;
2710}
2711
2712