1/* Scheme format strings.
2   Copyright (C) 2001-2005 Free Software Foundation, Inc.
3   Written by Bruno Haible <haible@clisp.cons.org>, 2001.
4
5   This program is free software; you can redistribute it and/or modify
6   it under the terms of the GNU General Public License as published by
7   the Free Software Foundation; either version 2, or (at your option)
8   any later version.
9
10   This program is distributed in the hope that it will be useful,
11   but WITHOUT ANY WARRANTY; without even the implied warranty of
12   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13   GNU General Public License for more details.
14
15   You should have received a copy of the GNU General Public License
16   along with this program; if not, write to the Free Software Foundation,
17   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
18
19#ifdef HAVE_CONFIG_H
20# include <config.h>
21#endif
22
23#include <stdbool.h>
24#include <stdlib.h>
25
26#include "format.h"
27#include "c-ctype.h"
28#include "gcd.h"
29#include "xalloc.h"
30#include "xerror.h"
31#include "format-invalid.h"
32#include "minmax.h"
33#include "error.h"
34#include "error-progname.h"
35#include "gettext.h"
36
37#define _(str) gettext (str)
38
39
40/* Assertion macros.  Could be defined to empty for speed.  */
41#define ASSERT(expr) if (!(expr)) abort ();
42#define VERIFY_LIST(list) verify_list (list)
43
44
45/* Scheme format strings are described in the GNU guile documentation,
46   section "Formatted Output".  They are implemented in
47   guile-1.6.4/ice-9/format.scm.  */
48
49/* Data structure describing format string derived constraints for an
50   argument list.  It is a recursive list structure.  Structure sharing
51   is not allowed.  */
52
53enum format_cdr_type
54{
55  FCT_REQUIRED,	/* The format argument list cannot end before this argument.  */
56  FCT_OPTIONAL	/* The format argument list may end before this argument.  */
57};
58
59enum format_arg_type
60{
61  FAT_OBJECT,			/* Any object, type T.  */
62  FAT_CHARACTER_INTEGER_NULL,	/* Type (OR CHARACTER INTEGER NULL).  */
63  FAT_CHARACTER_NULL,		/* Type (OR CHARACTER NULL).  */
64  FAT_CHARACTER,		/* Type CHARACTER.  */
65  FAT_INTEGER_NULL,		/* Type (OR INTEGER NULL).  */
66  FAT_INTEGER,			/* Meant for objects of type INTEGER.  */
67  FAT_REAL,			/* Meant for objects of type REAL.  */
68  FAT_COMPLEX,			/* Meant for objects of type COMPLEX.  */
69  FAT_LIST,			/* Meant for proper lists.  */
70  FAT_FORMATSTRING		/* Format strings.  */
71};
72
73struct format_arg
74{
75  unsigned int repcount; /* Number of consecutive arguments this constraint
76			    applies to.  Normally 1, but unconstrained
77			    arguments are often repeated.  */
78  enum format_cdr_type presence; /* Can the argument list end right before
79				    this argument?  */
80  enum format_arg_type type;	/* Possible values for this argument.  */
81  struct format_arg_list *list;	/* For FAT_LIST: List elements.  */
82};
83
84struct format_arg_list
85{
86  /* The constraints for the potentially infinite argument list are assumed
87     to become ultimately periodic.  (Too complicated argument lists without
88     a-priori period, like
89            (format t "~@{~:[-~;~S~]~}" nil t 1 t 3 nil t 4)
90     are described by a constraint that ends in a length 1 period of
91     unconstrained arguments.)  Such a periodic sequence can be split into
92     an initial segment and an endlessly repeated loop segment.
93     A finite sequence is represented entirely in the initial segment; the
94     loop segment is empty.  */
95
96  struct segment
97  {
98    unsigned int count;	/* Number of format_arg records used.  */
99    unsigned int allocated;
100    struct format_arg *element;	/* Argument constraints.  */
101    unsigned int length; /* Number of arguments represented by this segment.
102			    This is the sum of all repcounts in the segment.  */
103  }
104  initial,	/* Initial arguments segment.  */
105  repeated;	/* Endlessly repeated segment.  */
106};
107
108struct spec
109{
110  unsigned int directives;
111  struct format_arg_list *list;
112};
113
114
115/* Parameter for a directive.  */
116enum param_type
117{
118  PT_NIL,	/* param not present */
119  PT_CHARACTER,	/* character */
120  PT_INTEGER,	/* integer */
121  PT_ARGCOUNT,	/* number of remaining arguments */
122  PT_V		/* variable taken from argument list */
123};
124
125struct param
126{
127  enum param_type type;
128  int value;		/* for PT_INTEGER: the value, for PT_V: the position */
129};
130
131
132/* Forward declaration of local functions.  */
133#define union make_union
134static void verify_list (const struct format_arg_list *list);
135static void free_list (struct format_arg_list *list);
136static struct format_arg_list * copy_list (const struct format_arg_list *list);
137static bool equal_list (const struct format_arg_list *list1,
138			const struct format_arg_list *list2);
139static struct format_arg_list * make_intersected_list
140					       (struct format_arg_list *list1,
141						struct format_arg_list *list2);
142static struct format_arg_list * make_intersection_with_empty_list
143						(struct format_arg_list *list);
144static struct format_arg_list * make_union_list
145					       (struct format_arg_list *list1,
146						struct format_arg_list *list2);
147
148
149/* ======================= Verify a format_arg_list ======================= */
150
151/* Verify some invariants.  */
152static void
153verify_element (const struct format_arg * e)
154{
155  ASSERT (e->repcount > 0);
156  if (e->type == FAT_LIST)
157    verify_list (e->list);
158}
159
160/* Verify some invariants.  */
161/* Memory effects: none.  */
162static void
163verify_list (const struct format_arg_list *list)
164{
165  unsigned int i;
166  unsigned int total_repcount;
167
168  ASSERT (list->initial.count <= list->initial.allocated);
169  total_repcount = 0;
170  for (i = 0; i < list->initial.count; i++)
171    {
172      verify_element (&list->initial.element[i]);
173      total_repcount += list->initial.element[i].repcount;
174    }
175  ASSERT (total_repcount == list->initial.length);
176
177  ASSERT (list->repeated.count <= list->repeated.allocated);
178  total_repcount = 0;
179  for (i = 0; i < list->repeated.count; i++)
180    {
181      verify_element (&list->repeated.element[i]);
182      total_repcount += list->repeated.element[i].repcount;
183    }
184  ASSERT (total_repcount == list->repeated.length);
185}
186
187#define VERIFY_LIST(list) verify_list (list)
188
189
190/* ======================== Free a format_arg_list ======================== */
191
192/* Free the data belonging to an argument list element.  */
193static inline void
194free_element (struct format_arg *element)
195{
196  if (element->type == FAT_LIST)
197    free_list (element->list);
198}
199
200/* Free an argument list.  */
201/* Memory effects: Frees list.  */
202static void
203free_list (struct format_arg_list *list)
204{
205  unsigned int i;
206
207  for (i = 0; i < list->initial.count; i++)
208    free_element (&list->initial.element[i]);
209  if (list->initial.element != NULL)
210    free (list->initial.element);
211
212  for (i = 0; i < list->repeated.count; i++)
213    free_element (&list->repeated.element[i]);
214  if (list->repeated.element != NULL)
215    free (list->repeated.element);
216}
217
218
219/* ======================== Copy a format_arg_list ======================== */
220
221/* Copy the data belonging to an argument list element.  */
222static inline void
223copy_element (struct format_arg *newelement,
224	      const struct format_arg *oldelement)
225{
226  newelement->repcount = oldelement->repcount;
227  newelement->presence = oldelement->presence;
228  newelement->type = oldelement->type;
229  if (oldelement->type == FAT_LIST)
230    newelement->list = copy_list (oldelement->list);
231}
232
233/* Copy an argument list.  */
234/* Memory effects: Freshly allocated result.  */
235static struct format_arg_list *
236copy_list (const struct format_arg_list *list)
237{
238  struct format_arg_list *newlist;
239  unsigned int length;
240  unsigned int i;
241
242  VERIFY_LIST (list);
243
244  newlist =
245    (struct format_arg_list *) xmalloc (sizeof (struct format_arg_list));
246
247  newlist->initial.count = newlist->initial.allocated = list->initial.count;
248  length = 0;
249  if (list->initial.count == 0)
250    newlist->initial.element = NULL;
251  else
252    {
253      newlist->initial.element =
254	(struct format_arg *)
255	xmalloc (newlist->initial.allocated * sizeof (struct format_arg));
256      for (i = 0; i < list->initial.count; i++)
257	{
258	  copy_element (&newlist->initial.element[i],
259			&list->initial.element[i]);
260	  length += list->initial.element[i].repcount;
261	}
262    }
263  ASSERT (length == list->initial.length);
264  newlist->initial.length = length;
265
266  newlist->repeated.count = newlist->repeated.allocated = list->repeated.count;
267  length = 0;
268  if (list->repeated.count == 0)
269    newlist->repeated.element = NULL;
270  else
271    {
272      newlist->repeated.element =
273	(struct format_arg *)
274	xmalloc (newlist->repeated.allocated * sizeof (struct format_arg));
275      for (i = 0; i < list->repeated.count; i++)
276	{
277	  copy_element (&newlist->repeated.element[i],
278			&list->repeated.element[i]);
279	  length += list->repeated.element[i].repcount;
280	}
281    }
282  ASSERT (length == list->repeated.length);
283  newlist->repeated.length = length;
284
285  VERIFY_LIST (newlist);
286
287  return newlist;
288}
289
290
291/* ===================== Compare two format_arg_lists ===================== */
292
293/* Tests whether two normalized argument constraints are equivalent,
294   ignoring the repcount.  */
295static bool
296equal_element (const struct format_arg * e1, const struct format_arg * e2)
297{
298  return (e1->presence == e2->presence
299	  && e1->type == e2->type
300	  && (e1->type == FAT_LIST ? equal_list (e1->list, e2->list) : true));
301}
302
303/* Tests whether two normalized argument list constraints are equivalent.  */
304/* Memory effects: none.  */
305static bool
306equal_list (const struct format_arg_list *list1,
307	    const struct format_arg_list *list2)
308{
309  unsigned int n, i;
310
311  VERIFY_LIST (list1);
312  VERIFY_LIST (list2);
313
314  n = list1->initial.count;
315  if (n != list2->initial.count)
316    return false;
317  for (i = 0; i < n; i++)
318    {
319      const struct format_arg * e1 = &list1->initial.element[i];
320      const struct format_arg * e2 = &list2->initial.element[i];
321
322      if (!(e1->repcount == e2->repcount && equal_element (e1, e2)))
323	return false;
324    }
325
326  n = list1->repeated.count;
327  if (n != list2->repeated.count)
328    return false;
329  for (i = 0; i < n; i++)
330    {
331      const struct format_arg * e1 = &list1->repeated.element[i];
332      const struct format_arg * e2 = &list2->repeated.element[i];
333
334      if (!(e1->repcount == e2->repcount && equal_element (e1, e2)))
335	return false;
336    }
337
338  return true;
339}
340
341
342/* ===================== Incremental memory allocation ===================== */
343
344/* Ensure list->initial.allocated >= newcount.  */
345static inline void
346ensure_initial_alloc (struct format_arg_list *list, unsigned int newcount)
347{
348  if (newcount > list->initial.allocated)
349    {
350      list->initial.allocated =
351	MAX (2 * list->initial.allocated + 1, newcount);
352      list->initial.element =
353	(struct format_arg *)
354	xrealloc (list->initial.element,
355		  list->initial.allocated * sizeof (struct format_arg));
356    }
357}
358
359/* Ensure list->initial.allocated > list->initial.count.  */
360static inline void
361grow_initial_alloc (struct format_arg_list *list)
362{
363  if (list->initial.count >= list->initial.allocated)
364    {
365      list->initial.allocated =
366	MAX (2 * list->initial.allocated + 1, list->initial.count + 1);
367      list->initial.element =
368	(struct format_arg *)
369	xrealloc (list->initial.element,
370		  list->initial.allocated * sizeof (struct format_arg));
371    }
372}
373
374/* Ensure list->repeated.allocated >= newcount.  */
375static inline void
376ensure_repeated_alloc (struct format_arg_list *list, unsigned int newcount)
377{
378  if (newcount > list->repeated.allocated)
379    {
380      list->repeated.allocated =
381	MAX (2 * list->repeated.allocated + 1, newcount);
382      list->repeated.element =
383	(struct format_arg *)
384	xrealloc (list->repeated.element,
385		  list->repeated.allocated * sizeof (struct format_arg));
386    }
387}
388
389/* Ensure list->repeated.allocated > list->repeated.count.  */
390static inline void
391grow_repeated_alloc (struct format_arg_list *list)
392{
393  if (list->repeated.count >= list->repeated.allocated)
394    {
395      list->repeated.allocated =
396	MAX (2 * list->repeated.allocated + 1, list->repeated.count + 1);
397      list->repeated.element =
398	(struct format_arg *)
399	xrealloc (list->repeated.element,
400		  list->repeated.allocated * sizeof (struct format_arg));
401    }
402}
403
404
405/* ====================== Normalize a format_arg_list ====================== */
406
407/* Normalize an argument list constraint, assuming all sublists are already
408   normalized.  */
409/* Memory effects: Destructively modifies list.  */
410static void
411normalize_outermost_list (struct format_arg_list *list)
412{
413  unsigned int n, i, j;
414
415  /* Step 1: Combine adjacent elements.
416     Copy from i to j, keeping 0 <= j <= i.  */
417
418  n = list->initial.count;
419  for (i = j = 0; i < n; i++)
420    if (j > 0
421	&& equal_element (&list->initial.element[i],
422			  &list->initial.element[j-1]))
423      {
424	list->initial.element[j-1].repcount +=
425	  list->initial.element[i].repcount;
426	free_element (&list->initial.element[i]);
427      }
428    else
429      {
430	if (j < i)
431	  list->initial.element[j] = list->initial.element[i];
432	j++;
433      }
434  list->initial.count = j;
435
436  n = list->repeated.count;
437  for (i = j = 0; i < n; i++)
438    if (j > 0
439	&& equal_element (&list->repeated.element[i],
440			  &list->repeated.element[j-1]))
441      {
442	list->repeated.element[j-1].repcount +=
443	  list->repeated.element[i].repcount;
444	free_element (&list->repeated.element[i]);
445      }
446    else
447      {
448	if (j < i)
449	  list->repeated.element[j] = list->repeated.element[i];
450	j++;
451      }
452  list->repeated.count = j;
453
454  /* Nothing more to be done if the loop segment is empty.  */
455  if (list->repeated.count > 0)
456    {
457      unsigned int m, repcount0_extra;
458
459      /* Step 2: Reduce the loop period.  */
460      n = list->repeated.count;
461      repcount0_extra = 0;
462      if (n > 1
463	  && equal_element (&list->repeated.element[0],
464			    &list->repeated.element[n-1]))
465	{
466	  repcount0_extra = list->repeated.element[n-1].repcount;
467	  n--;
468	}
469      /* Proceed as if the loop period were n, with
470	 list->repeated.element[0].repcount incremented by repcount0_extra.  */
471      for (m = 2; m <= n / 2; n++)
472	if ((n % m) == 0)
473	  {
474	    /* m is a divisor of n.  Try to reduce the loop period to n.  */
475	    bool ok = true;
476
477	    for (i = 0; i < n - m; i++)
478	      if (!((list->repeated.element[i].repcount
479		     + (i == 0 ? repcount0_extra : 0)
480		     == list->repeated.element[i+m].repcount)
481		    && equal_element (&list->repeated.element[i],
482				      &list->repeated.element[i+m])))
483		{
484		  ok = false;
485		  break;
486		}
487	    if (ok)
488	      {
489		for (i = m; i < n; i++)
490		  free_element (&list->repeated.element[i]);
491		if (n < list->repeated.count)
492		  list->repeated.element[m] = list->repeated.element[n];
493		list->repeated.count = list->repeated.count - n + m;
494		list->repeated.length /= n / m;
495		break;
496	      }
497	  }
498
499      /* Step 3: Roll as much as possible of the initial segment's tail
500	 into the loop.  */
501      if (list->repeated.count == 1)
502	{
503	  if (list->initial.count > 0
504	      && equal_element (&list->initial.element[list->initial.count-1],
505				&list->repeated.element[0]))
506	    {
507	      /* Roll the last element of the initial segment into the loop.
508		 Its repcount is irrelevant.  The second-to-last element is
509		 certainly different and doesn't need to be considered.  */
510	      list->initial.length -=
511		list->initial.element[list->initial.count-1].repcount;
512	      list->initial.count--;
513	    }
514	}
515      else
516	{
517	  while (list->initial.count > 0
518		 && equal_element (&list->initial.element[list->initial.count-1],
519				   &list->repeated.element[list->repeated.count-1]))
520	    {
521	      unsigned int moved_repcount =
522		MIN (list->initial.element[list->initial.count-1].repcount,
523		     list->repeated.element[list->repeated.count-1].repcount);
524
525	      /* Add the element at the start of list->repeated.  */
526	      if (equal_element (&list->repeated.element[0],
527				 &list->repeated.element[list->repeated.count-1]))
528		list->repeated.element[0].repcount += moved_repcount;
529	      else
530		{
531		  unsigned int newcount = list->repeated.count + 1;
532		  ensure_repeated_alloc (list, newcount);
533		  for (i = newcount - 1; i > 0; i--)
534		    list->repeated.element[i] = list->repeated.element[i-1];
535		  list->repeated.count = newcount;
536		  copy_element (&list->repeated.element[0],
537				&list->repeated.element[list->repeated.count-1]);
538		  list->repeated.element[0].repcount = moved_repcount;
539		}
540
541	      /* Remove the element from the end of list->repeated.  */
542	      list->repeated.element[list->repeated.count-1].repcount -=
543		moved_repcount;
544	      if (list->repeated.element[list->repeated.count-1].repcount == 0)
545		{
546		  free_element (&list->repeated.element[list->repeated.count-1]);
547		  list->repeated.count--;
548		}
549
550	      /* Remove the element from the end of list->initial.  */
551	      list->initial.element[list->initial.count-1].repcount -=
552		moved_repcount;
553	      if (list->initial.element[list->initial.count-1].repcount == 0)
554		{
555		  free_element (&list->initial.element[list->initial.count-1]);
556		  list->initial.count--;
557		}
558	      list->initial.length -= moved_repcount;
559	    }
560	}
561    }
562}
563
564/* Normalize an argument list constraint.  */
565/* Memory effects: Destructively modifies list.  */
566static void
567normalize_list (struct format_arg_list *list)
568{
569  unsigned int n, i;
570
571  VERIFY_LIST (list);
572
573  /* First normalize all elements, recursively.  */
574  n = list->initial.count;
575  for (i = 0; i < n; i++)
576    if (list->initial.element[i].type == FAT_LIST)
577      normalize_list (list->initial.element[i].list);
578  n = list->repeated.count;
579  for (i = 0; i < n; i++)
580    if (list->repeated.element[i].type == FAT_LIST)
581      normalize_list (list->repeated.element[i].list);
582
583  /* Then normalize the top level list.  */
584  normalize_outermost_list (list);
585
586  VERIFY_LIST (list);
587}
588
589
590/* ===================== Unconstrained and empty lists ===================== */
591
592/* It's easier to allocate these on demand, than to be careful not to
593   accidentally modify statically allocated lists.  */
594
595
596/* Create an unconstrained argument list.  */
597/* Memory effects: Freshly allocated result.  */
598static struct format_arg_list *
599make_unconstrained_list ()
600{
601  struct format_arg_list *list;
602
603  list = (struct format_arg_list *) xmalloc (sizeof (struct format_arg_list));
604  list->initial.count = 0;
605  list->initial.allocated = 0;
606  list->initial.element = NULL;
607  list->initial.length = 0;
608  list->repeated.count = 1;
609  list->repeated.allocated = 1;
610  list->repeated.element =
611    (struct format_arg *) xmalloc (1 * sizeof (struct format_arg));
612  list->repeated.element[0].repcount = 1;
613  list->repeated.element[0].presence = FCT_OPTIONAL;
614  list->repeated.element[0].type = FAT_OBJECT;
615  list->repeated.length = 1;
616
617  VERIFY_LIST (list);
618
619  return list;
620}
621
622
623/* Create an empty argument list.  */
624/* Memory effects: Freshly allocated result.  */
625static struct format_arg_list *
626make_empty_list ()
627{
628  struct format_arg_list *list;
629
630  list = (struct format_arg_list *) xmalloc (sizeof (struct format_arg_list));
631  list->initial.count = 0;
632  list->initial.allocated = 0;
633  list->initial.element = NULL;
634  list->initial.length = 0;
635  list->repeated.count = 0;
636  list->repeated.allocated = 0;
637  list->repeated.element = NULL;
638  list->repeated.length = 0;
639
640  VERIFY_LIST (list);
641
642  return list;
643}
644
645
646/* Test for an empty list.  */
647/* Memory effects: none.  */
648static bool
649is_empty_list (const struct format_arg_list *list)
650{
651  return (list->initial.count == 0 && list->repeated.count == 0);
652}
653
654
655/* ======================== format_arg_list surgery ======================== */
656
657/* Unfold list->repeated m times, where m >= 1.
658   Assumes list->repeated.count > 0.  */
659/* Memory effects: list is destructively modified.  */
660static void
661unfold_loop (struct format_arg_list *list, unsigned int m)
662{
663  unsigned int i, j, k;
664
665  if (m > 1)
666    {
667      unsigned int newcount = list->repeated.count * m;
668      ensure_repeated_alloc (list, newcount);
669      i = list->repeated.count;
670      for (k = 1; k < m; k++)
671	for (j = 0; j < list->repeated.count; j++, i++)
672	  copy_element (&list->repeated.element[i], &list->repeated.element[j]);
673      list->repeated.count = newcount;
674      list->repeated.length = list->repeated.length * m;
675    }
676}
677
678/* Ensure list->initial.length := m, where m >= list->initial.length.
679   Assumes list->repeated.count > 0.  */
680/* Memory effects: list is destructively modified.  */
681static void
682rotate_loop (struct format_arg_list *list, unsigned int m)
683{
684  if (m == list->initial.length)
685    return;
686
687  if (list->repeated.count == 1)
688    {
689      /* Instead of multiple copies of list->repeated.element[0], a single
690	 copy with higher repcount is appended to list->initial.  */
691      unsigned int i, newcount;
692
693      newcount = list->initial.count + 1;
694      ensure_initial_alloc (list, newcount);
695      i = list->initial.count;
696      copy_element (&list->initial.element[i], &list->repeated.element[0]);
697      list->initial.element[i].repcount = m - list->initial.length;
698      list->initial.count = newcount;
699      list->initial.length = m;
700    }
701  else
702    {
703      unsigned int n = list->repeated.length;
704
705      /* Write m = list->initial.length + q * n + r with 0 <= r < n.  */
706      unsigned int q = (m - list->initial.length) / n;
707      unsigned int r = (m - list->initial.length) % n;
708
709      /* Determine how many entries of list->repeated are needed for
710	 length r.  */
711      unsigned int s;
712      unsigned int t;
713
714      for (t = r, s = 0;
715	   s < list->repeated.count && t >= list->repeated.element[s].repcount;
716	   t -= list->repeated.element[s].repcount, s++)
717	;
718
719      /* s must be < list->repeated.count, otherwise r would have been >= n.  */
720      ASSERT (s < list->repeated.count);
721
722      /* So we need to add to list->initial:
723	 q full copies of list->repeated,
724	 plus the s first elements of list->repeated,
725	 plus, if t > 0, a splitoff of list->repeated.element[s].  */
726      {
727	unsigned int i, j, k, newcount;
728
729	i = list->initial.count;
730	newcount = i + q * list->repeated.count + s + (t > 0 ? 1 : 0);
731	ensure_initial_alloc (list, newcount);
732	for (k = 0; k < q; k++)
733	  for (j = 0; j < list->repeated.count; j++, i++)
734	    copy_element (&list->initial.element[i],
735			  &list->repeated.element[j]);
736	for (j = 0; j < s; j++, i++)
737	  copy_element (&list->initial.element[i], &list->repeated.element[j]);
738	if (t > 0)
739	  {
740	    copy_element (&list->initial.element[i],
741			  &list->repeated.element[j]);
742	    list->initial.element[i].repcount = t;
743	    i++;
744	  }
745	ASSERT (i == newcount);
746	list->initial.count = newcount;
747	/* The new length of the initial segment is
748	   = list->initial.length
749	     + q * list->repeated.length
750	     + list->repeated[0..s-1].repcount + t
751	   = list->initial.length + q * n + r
752	   = m.
753	 */
754	list->initial.length = m;
755      }
756
757      /* And rotate list->repeated.  */
758      if (r > 0)
759	{
760	  unsigned int i, j, oldcount, newcount;
761	  struct format_arg *newelement;
762
763	  oldcount = list->repeated.count;
764	  newcount = list->repeated.count + (t > 0 ? 1 : 0);
765	  newelement =
766	    (struct format_arg *)
767	    xmalloc (newcount * sizeof (struct format_arg));
768	  i = 0;
769	  for (j = s; j < oldcount; j++, i++)
770	    newelement[i] = list->repeated.element[j];
771	  for (j = 0; j < s; j++, i++)
772	    newelement[i] = list->repeated.element[j];
773	  if (t > 0)
774	    {
775	      copy_element (&newelement[oldcount], &newelement[0]);
776	      newelement[0].repcount -= t;
777	      newelement[oldcount].repcount = t;
778	    }
779	  free (list->repeated.element);
780	  list->repeated.element = newelement;
781	}
782    }
783}
784
785
786/* Ensure index n in the initial segment falls on a split between elements,
787   i.e. if 0 < n < list->initial.length, then n-1 and n are covered by two
788   different adjacent elements.  */
789/* Memory effects: list is destructively modified.  */
790static unsigned int
791initial_splitelement (struct format_arg_list *list, unsigned int n)
792{
793  unsigned int s;
794  unsigned int t;
795  unsigned int oldrepcount;
796  unsigned int newcount;
797  unsigned int i;
798
799  VERIFY_LIST (list);
800
801  if (n > list->initial.length)
802    {
803      ASSERT (list->repeated.count > 0);
804      rotate_loop (list, n);
805      ASSERT (n <= list->initial.length);
806    }
807
808  /* Determine how many entries of list->initial need to be skipped.  */
809  for (t = n, s = 0;
810       s < list->initial.count && t >= list->initial.element[s].repcount;
811       t -= list->initial.element[s].repcount, s++)
812    ;
813
814  if (t == 0)
815    return s;
816
817  ASSERT (s < list->initial.count);
818
819  /* Split the entry into two entries.  */
820  oldrepcount = list->initial.element[s].repcount;
821  newcount = list->initial.count + 1;
822  ensure_initial_alloc (list, newcount);
823  for (i = list->initial.count - 1; i > s; i--)
824    list->initial.element[i+1] = list->initial.element[i];
825  copy_element (&list->initial.element[s+1], &list->initial.element[s]);
826  list->initial.element[s].repcount = t;
827  list->initial.element[s+1].repcount = oldrepcount - t;
828  list->initial.count = newcount;
829
830  VERIFY_LIST (list);
831
832  return s+1;
833}
834
835
836/* Ensure index n in the initial segment is not shared.  Return its index.  */
837/* Memory effects: list is destructively modified.  */
838static unsigned int
839initial_unshare (struct format_arg_list *list, unsigned int n)
840{
841  /* This does the same side effects as
842       initial_splitelement (list, n);
843       initial_splitelement (list, n + 1);
844   */
845  unsigned int s;
846  unsigned int t;
847
848  VERIFY_LIST (list);
849
850  if (n >= list->initial.length)
851    {
852      ASSERT (list->repeated.count > 0);
853      rotate_loop (list, n + 1);
854      ASSERT (n < list->initial.length);
855    }
856
857  /* Determine how many entries of list->initial need to be skipped.  */
858  for (t = n, s = 0;
859       s < list->initial.count && t >= list->initial.element[s].repcount;
860       t -= list->initial.element[s].repcount, s++)
861    ;
862
863  /* s must be < list->initial.count.  */
864  ASSERT (s < list->initial.count);
865
866  if (list->initial.element[s].repcount > 1)
867    {
868      /* Split the entry into at most three entries: for indices < n,
869	 for index n, and for indices > n.  */
870      unsigned int oldrepcount = list->initial.element[s].repcount;
871      unsigned int newcount =
872	list->initial.count + (t == 0 || t == oldrepcount - 1 ? 1 : 2);
873      ensure_initial_alloc (list, newcount);
874      if (t == 0 || t == oldrepcount - 1)
875	{
876	  unsigned int i;
877
878	  for (i = list->initial.count - 1; i > s; i--)
879	    list->initial.element[i+1] = list->initial.element[i];
880	  copy_element (&list->initial.element[s+1], &list->initial.element[s]);
881	  if (t == 0)
882	    {
883	      list->initial.element[s].repcount = 1;
884	      list->initial.element[s+1].repcount = oldrepcount - 1;
885	    }
886	  else
887	    {
888	      list->initial.element[s].repcount = oldrepcount - 1;
889	      list->initial.element[s+1].repcount = 1;
890	    }
891	}
892      else
893	{
894	  unsigned int i;
895
896	  for (i = list->initial.count - 1; i > s; i--)
897	    list->initial.element[i+2] = list->initial.element[i];
898	  copy_element (&list->initial.element[s+2], &list->initial.element[s]);
899	  copy_element (&list->initial.element[s+1], &list->initial.element[s]);
900	  list->initial.element[s].repcount = t;
901	  list->initial.element[s+1].repcount = 1;
902	  list->initial.element[s+2].repcount = oldrepcount - 1 - t;
903	}
904      list->initial.count = newcount;
905      if (t > 0)
906	s++;
907    }
908
909  /* Now the entry for index n has repcount 1.  */
910  ASSERT (list->initial.element[s].repcount == 1);
911
912  VERIFY_LIST (list);
913
914  return s;
915}
916
917
918/* Add n unconstrained elements at the front of the list.  */
919/* Memory effects: list is destructively modified.  */
920static void
921shift_list (struct format_arg_list *list, unsigned int n)
922{
923  VERIFY_LIST (list);
924
925  if (n > 0)
926    {
927      unsigned int i;
928
929      grow_initial_alloc (list);
930      for (i = list->initial.count; i > 0; i--)
931	list->initial.element[i] = list->initial.element[i-1];
932      list->initial.element[0].repcount = n;
933      list->initial.element[0].presence = FCT_REQUIRED;
934      list->initial.element[0].type = FAT_OBJECT;
935      list->initial.count++;
936      list->initial.length += n;
937
938      normalize_outermost_list (list);
939    }
940
941  VERIFY_LIST (list);
942}
943
944
945/* ================= Intersection of two format_arg_lists ================= */
946
947/* Create the intersection (i.e. combined constraints) of two argument
948   constraints.  Return false if the intersection is empty, i.e. if the
949   two constraints give a contradiction.  */
950/* Memory effects: Freshly allocated element's sublist.  */
951static bool
952make_intersected_element (struct format_arg *re,
953			  const struct format_arg * e1,
954			  const struct format_arg * e2)
955{
956  /* Intersect the cdr types.  */
957  if (e1->presence == FCT_REQUIRED || e2->presence == FCT_REQUIRED)
958    re->presence = FCT_REQUIRED;
959  else
960    re->presence = FCT_OPTIONAL;
961
962  /* Intersect the arg types.  */
963  if (e1->type == FAT_OBJECT)
964    {
965      re->type = e2->type;
966      if (re->type == FAT_LIST)
967	re->list = copy_list (e2->list);
968    }
969  else if (e2->type == FAT_OBJECT)
970    {
971      re->type = e1->type;
972      if (re->type == FAT_LIST)
973	re->list = copy_list (e1->list);
974    }
975  else if (e1->type == FAT_LIST
976	   && (e2->type == FAT_CHARACTER_INTEGER_NULL
977	       || e2->type == FAT_CHARACTER_NULL
978	       || e2->type == FAT_INTEGER_NULL))
979    {
980      re->type = e1->type;
981      re->list = make_intersection_with_empty_list (e1->list);
982      if (re->list == NULL)
983	return false;
984    }
985  else if (e2->type == FAT_LIST
986	   && (e1->type == FAT_CHARACTER_INTEGER_NULL
987	       || e1->type == FAT_CHARACTER_NULL
988	       || e1->type == FAT_INTEGER_NULL))
989    {
990      re->type = e2->type;
991      re->list = make_intersection_with_empty_list (e2->list);
992      if (re->list == NULL)
993	return false;
994    }
995  else if (e1->type == FAT_CHARACTER_INTEGER_NULL
996	   && (e2->type == FAT_CHARACTER_NULL || e2->type == FAT_CHARACTER
997	       || e2->type == FAT_INTEGER_NULL || e2->type == FAT_INTEGER))
998    {
999      re->type = e2->type;
1000    }
1001  else if (e2->type == FAT_CHARACTER_INTEGER_NULL
1002	   && (e1->type == FAT_CHARACTER_NULL || e1->type == FAT_CHARACTER
1003	       || e1->type == FAT_INTEGER_NULL || e1->type == FAT_INTEGER))
1004    {
1005      re->type = e1->type;
1006    }
1007  else if (e1->type == FAT_CHARACTER_NULL && e2->type == FAT_CHARACTER)
1008    {
1009      re->type = e2->type;
1010    }
1011  else if (e2->type == FAT_CHARACTER_NULL && e1->type == FAT_CHARACTER)
1012    {
1013      re->type = e1->type;
1014    }
1015  else if (e1->type == FAT_INTEGER_NULL && e2->type == FAT_INTEGER)
1016    {
1017      re->type = e2->type;
1018    }
1019  else if (e2->type == FAT_INTEGER_NULL && e1->type == FAT_INTEGER)
1020    {
1021      re->type = e1->type;
1022    }
1023  else if (e1->type == FAT_REAL && e2->type == FAT_INTEGER)
1024    {
1025      re->type = e2->type;
1026    }
1027  else if (e2->type == FAT_REAL && e1->type == FAT_INTEGER)
1028    {
1029      re->type = e1->type;
1030    }
1031  else if (e1->type == FAT_COMPLEX
1032	   && (e2->type == FAT_REAL || e2->type == FAT_INTEGER))
1033    {
1034      re->type = e2->type;
1035    }
1036  else if (e2->type == FAT_COMPLEX
1037	   && (e1->type == FAT_REAL || e1->type == FAT_INTEGER))
1038    {
1039      re->type = e1->type;
1040    }
1041  else if (e1->type == e2->type)
1042    {
1043      re->type = e1->type;
1044      if (re->type == FAT_LIST)
1045	{
1046	  re->list = make_intersected_list (copy_list (e1->list),
1047					    copy_list (e2->list));
1048	  if (re->list == NULL)
1049	    return false;
1050	}
1051    }
1052  else
1053    /* Each of FAT_CHARACTER, FAT_INTEGER, FAT_LIST, FAT_FORMATSTRING
1054       matches only itself.  Contradiction.  */
1055    return false;
1056
1057  return true;
1058}
1059
1060/* Append list->repeated to list->initial, and clear list->repeated.  */
1061/* Memory effects: list is destructively modified.  */
1062static void
1063append_repeated_to_initial (struct format_arg_list *list)
1064{
1065  if (list->repeated.count > 0)
1066    {
1067      /* Move list->repeated over to list->initial.  */
1068      unsigned int i, j, newcount;
1069
1070      newcount = list->initial.count + list->repeated.count;
1071      ensure_initial_alloc (list, newcount);
1072      i = list->initial.count;
1073      for (j = 0; j < list->repeated.count; j++, i++)
1074	list->initial.element[i] = list->repeated.element[j];
1075      list->initial.count = newcount;
1076      list->initial.length = list->initial.length + list->repeated.length;
1077      free (list->repeated.element);
1078      list->repeated.element = NULL;
1079      list->repeated.allocated = 0;
1080      list->repeated.count = 0;
1081      list->repeated.length = 0;
1082    }
1083}
1084
1085/* Handle a contradiction during building of a format_arg_list.
1086   The list consists only of an initial segment.  The repeated segment is
1087   empty.  This function searches the last FCT_OPTIONAL and cuts off the
1088   list at this point, or - if none is found - returns NULL.  */
1089/* Memory effects: list is destructively modified.  If NULL is returned,
1090   list is freed.  */
1091static struct format_arg_list *
1092backtrack_in_initial (struct format_arg_list *list)
1093{
1094  ASSERT (list->repeated.count == 0);
1095
1096  while (list->initial.count > 0)
1097    {
1098      unsigned int i = list->initial.count - 1;
1099      if (list->initial.element[i].presence == FCT_REQUIRED)
1100	{
1101	  /* Throw away this element.  */
1102	  list->initial.length -= list->initial.element[i].repcount;
1103	  free_element (&list->initial.element[i]);
1104	  list->initial.count = i;
1105	}
1106      else /* list->initial.element[i].presence == FCT_OPTIONAL */
1107	{
1108	  /* The list must end here.  */
1109	  list->initial.length--;
1110	  if (list->initial.element[i].repcount > 1)
1111	    list->initial.element[i].repcount--;
1112	  else
1113	    {
1114	      free_element (&list->initial.element[i]);
1115	      list->initial.count = i;
1116	    }
1117	  VERIFY_LIST (list);
1118	  return list;
1119	}
1120    }
1121
1122  free_list (list);
1123  return NULL;
1124}
1125
1126/* Create the intersection (i.e. combined constraints) of two argument list
1127   constraints.  Free both argument lists when done.  Return NULL if the
1128   intersection is empty, i.e. if the two constraints give a contradiction.  */
1129/* Memory effects: list1 and list2 are freed.  The result, if non-NULL, is
1130   freshly allocated.  */
1131static struct format_arg_list *
1132make_intersected_list (struct format_arg_list *list1,
1133		       struct format_arg_list *list2)
1134{
1135  struct format_arg_list *result;
1136
1137  VERIFY_LIST (list1);
1138  VERIFY_LIST (list2);
1139
1140  if (list1->repeated.length > 0 && list2->repeated.length > 0)
1141    /* Step 1: Ensure list1->repeated.length == list2->repeated.length.  */
1142    {
1143      unsigned int n1 = list1->repeated.length;
1144      unsigned int n2 = list2->repeated.length;
1145      unsigned int g = gcd (n1, n2);
1146      unsigned int m1 = n2 / g; /* = lcm(n1,n2) / n1 */
1147      unsigned int m2 = n1 / g; /* = lcm(n1,n2) / n2 */
1148
1149      unfold_loop (list1, m1);
1150      unfold_loop (list2, m2);
1151      /* Now list1->repeated.length = list2->repeated.length = lcm(n1,n2).  */
1152    }
1153
1154  if (list1->repeated.length > 0 || list2->repeated.length > 0)
1155    /* Step 2: Ensure the initial segment of the result can be computed
1156       from the initial segments of list1 and list2.  If both have a
1157       repeated segment, this means to ensure
1158       list1->initial.length == list2->initial.length.  */
1159    {
1160      unsigned int m = MAX (list1->initial.length, list2->initial.length);
1161
1162      if (list1->repeated.length > 0)
1163	rotate_loop (list1, m);
1164      if (list2->repeated.length > 0)
1165	rotate_loop (list2, m);
1166    }
1167
1168  if (list1->repeated.length > 0 && list2->repeated.length > 0)
1169    {
1170      ASSERT (list1->initial.length == list2->initial.length);
1171      ASSERT (list1->repeated.length == list2->repeated.length);
1172    }
1173
1174  /* Step 3: Allocate the result.  */
1175  result =
1176    (struct format_arg_list *) xmalloc (sizeof (struct format_arg_list));
1177  result->initial.count = 0;
1178  result->initial.allocated = 0;
1179  result->initial.element = NULL;
1180  result->initial.length = 0;
1181  result->repeated.count = 0;
1182  result->repeated.allocated = 0;
1183  result->repeated.element = NULL;
1184  result->repeated.length = 0;
1185
1186  /* Step 4: Elementwise intersection of list1->initial, list2->initial.  */
1187  {
1188    struct format_arg *e1;
1189    struct format_arg *e2;
1190    unsigned int c1;
1191    unsigned int c2;
1192
1193    e1 = list1->initial.element; c1 = list1->initial.count;
1194    e2 = list2->initial.element; c2 = list2->initial.count;
1195    while (c1 > 0 && c2 > 0)
1196      {
1197	struct format_arg *re;
1198
1199	/* Ensure room in result->initial.  */
1200	grow_initial_alloc (result);
1201	re = &result->initial.element[result->initial.count];
1202	re->repcount = MIN (e1->repcount, e2->repcount);
1203
1204	/* Intersect the argument types.  */
1205	if (!make_intersected_element (re, e1, e2))
1206	  {
1207	    /* If re->presence == FCT_OPTIONAL, the result list ends here.  */
1208	    if (re->presence == FCT_REQUIRED)
1209	      /* Contradiction.  Backtrack.  */
1210	      result = backtrack_in_initial (result);
1211	    goto done;
1212	  }
1213
1214	result->initial.count++;
1215	result->initial.length += re->repcount;
1216
1217	e1->repcount -= re->repcount;
1218	if (e1->repcount == 0)
1219	  {
1220	    e1++;
1221	    c1--;
1222	  }
1223	e2->repcount -= re->repcount;
1224	if (e2->repcount == 0)
1225	  {
1226	    e2++;
1227	    c2--;
1228	  }
1229      }
1230
1231    if (list1->repeated.count == 0 && list2->repeated.count == 0)
1232      {
1233	/* Intersecting two finite lists.  */
1234	if (c1 > 0)
1235	  {
1236	    /* list1 longer than list2.  */
1237	    if (e1->presence == FCT_REQUIRED)
1238	      /* Contradiction.  Backtrack.  */
1239	      result = backtrack_in_initial (result);
1240	  }
1241	else if (c2 > 0)
1242	  {
1243	    /* list2 longer than list1.  */
1244	    if (e2->presence == FCT_REQUIRED)
1245	      /* Contradiction.  Backtrack.  */
1246	      result = backtrack_in_initial (result);
1247	  }
1248	goto done;
1249      }
1250    else if (list1->repeated.count == 0)
1251      {
1252	/* Intersecting a finite and an infinite list.  */
1253	ASSERT (c1 == 0);
1254	if ((c2 > 0 ? e2->presence : list2->repeated.element[0].presence)
1255	    == FCT_REQUIRED)
1256	  /* Contradiction.  Backtrack.  */
1257	  result = backtrack_in_initial (result);
1258	goto done;
1259      }
1260    else if (list2->repeated.count == 0)
1261      {
1262	/* Intersecting an infinite and a finite list.  */
1263	ASSERT (c2 == 0);
1264	if ((c1 > 0 ? e1->presence : list1->repeated.element[0].presence)
1265	    == FCT_REQUIRED)
1266	  /* Contradiction.  Backtrack.  */
1267	  result = backtrack_in_initial (result);
1268	goto done;
1269      }
1270    /* Intersecting two infinite lists.  */
1271    ASSERT (c1 == 0 && c2 == 0);
1272  }
1273
1274  /* Step 5: Elementwise intersection of list1->repeated, list2->repeated.  */
1275  {
1276    struct format_arg *e1;
1277    struct format_arg *e2;
1278    unsigned int c1;
1279    unsigned int c2;
1280
1281    e1 = list1->repeated.element; c1 = list1->repeated.count;
1282    e2 = list2->repeated.element; c2 = list2->repeated.count;
1283    while (c1 > 0 && c2 > 0)
1284      {
1285	struct format_arg *re;
1286
1287	/* Ensure room in result->repeated.  */
1288	grow_repeated_alloc (result);
1289	re = &result->repeated.element[result->repeated.count];
1290	re->repcount = MIN (e1->repcount, e2->repcount);
1291
1292	/* Intersect the argument types.  */
1293	if (!make_intersected_element (re, e1, e2))
1294	  {
1295	    append_repeated_to_initial (result);
1296
1297	    /* If re->presence == FCT_OPTIONAL, the result list ends here.  */
1298	    if (re->presence == FCT_REQUIRED)
1299	      /* Contradiction.  Backtrack.  */
1300	      result = backtrack_in_initial (result);
1301
1302	    goto done;
1303	  }
1304
1305	result->repeated.count++;
1306	result->repeated.length += re->repcount;
1307
1308	e1->repcount -= re->repcount;
1309	if (e1->repcount == 0)
1310	  {
1311	    e1++;
1312	    c1--;
1313	  }
1314	e2->repcount -= re->repcount;
1315	if (e2->repcount == 0)
1316	  {
1317	    e2++;
1318	    c2--;
1319	  }
1320      }
1321    ASSERT (c1 == 0 && c2 == 0);
1322  }
1323
1324 done:
1325  free_list (list1);
1326  free_list (list2);
1327  if (result != NULL)
1328    {
1329      /* Undo the loop unfolding and unrolling done above.  */
1330      normalize_outermost_list (result);
1331      VERIFY_LIST (result);
1332    }
1333  return result;
1334}
1335
1336
1337/* Create the intersection of an argument list and the empty list.
1338   Return NULL if the intersection is empty.  */
1339/* Memory effects: The result, if non-NULL, is freshly allocated.  */
1340static struct format_arg_list *
1341make_intersection_with_empty_list (struct format_arg_list *list)
1342{
1343#if 0 /* equivalent but slower */
1344  return make_intersected_list (copy_list (list), make_empty_list ());
1345#else
1346  if (list->initial.count > 0
1347      ? list->initial.element[0].presence == FCT_REQUIRED
1348      : list->repeated.count > 0
1349	&& list->repeated.element[0].presence == FCT_REQUIRED)
1350    return NULL;
1351  else
1352    return make_empty_list ();
1353#endif
1354}
1355
1356
1357#ifdef unused
1358/* Create the intersection of two argument list constraints.  NULL stands
1359   for an impossible situation, i.e. a contradiction.  */
1360/* Memory effects: list1 and list2 are freed if non-NULL.  The result,
1361   if non-NULL, is freshly allocated.  */
1362static struct format_arg_list *
1363intersection (struct format_arg_list *list1, struct format_arg_list *list2)
1364{
1365  if (list1 != NULL)
1366    {
1367      if (list2 != NULL)
1368	return make_intersected_list (list1, list2);
1369      else
1370	{
1371	  free_list (list1);
1372	  return NULL;
1373	}
1374    }
1375  else
1376    {
1377      if (list2 != NULL)
1378	{
1379	  free_list (list2);
1380	  return NULL;
1381	}
1382      else
1383	return NULL;
1384    }
1385}
1386#endif
1387
1388
1389/* ===================== Union of two format_arg_lists ===================== */
1390
1391/* Create the union (i.e. alternative constraints) of two argument
1392   constraints.  */
1393static void
1394make_union_element (struct format_arg *re,
1395		    const struct format_arg * e1,
1396		    const struct format_arg * e2)
1397{
1398  /* Union of the cdr types.  */
1399  if (e1->presence == FCT_REQUIRED && e2->presence == FCT_REQUIRED)
1400    re->presence = FCT_REQUIRED;
1401  else /* Either one of them is FCT_OPTIONAL.  */
1402    re->presence = FCT_OPTIONAL;
1403
1404  /* Union of the arg types.  */
1405  if (e1->type == e2->type)
1406    {
1407      re->type = e1->type;
1408      if (re->type == FAT_LIST)
1409	re->list = make_union_list (copy_list (e1->list),
1410				    copy_list (e2->list));
1411    }
1412  else if (e1->type == FAT_CHARACTER_INTEGER_NULL
1413	   && (e2->type == FAT_CHARACTER_NULL || e2->type == FAT_CHARACTER
1414	       || e2->type == FAT_INTEGER_NULL || e2->type == FAT_INTEGER))
1415    {
1416      re->type = e1->type;
1417    }
1418  else if (e2->type == FAT_CHARACTER_INTEGER_NULL
1419	   && (e1->type == FAT_CHARACTER_NULL || e1->type == FAT_CHARACTER
1420	       || e1->type == FAT_INTEGER_NULL || e1->type == FAT_INTEGER))
1421    {
1422      re->type = e2->type;
1423    }
1424  else if (e1->type == FAT_CHARACTER_NULL && e2->type == FAT_CHARACTER)
1425    {
1426      re->type = e1->type;
1427    }
1428  else if (e2->type == FAT_CHARACTER_NULL && e1->type == FAT_CHARACTER)
1429    {
1430      re->type = e2->type;
1431    }
1432  else if (e1->type == FAT_INTEGER_NULL && e2->type == FAT_INTEGER)
1433    {
1434      re->type = e1->type;
1435    }
1436  else if (e2->type == FAT_INTEGER_NULL && e1->type == FAT_INTEGER)
1437    {
1438      re->type = e2->type;
1439    }
1440  else if (e1->type == FAT_REAL && e2->type == FAT_INTEGER)
1441    {
1442      re->type = e1->type;
1443    }
1444  else if (e2->type == FAT_REAL && e1->type == FAT_INTEGER)
1445    {
1446      re->type = e2->type;
1447    }
1448  else if (e1->type == FAT_COMPLEX
1449	   && (e2->type == FAT_REAL || e2->type == FAT_INTEGER))
1450    {
1451      re->type = e1->type;
1452    }
1453  else if (e2->type == FAT_COMPLEX
1454	   && (e1->type == FAT_REAL || e1->type == FAT_INTEGER))
1455    {
1456      re->type = e2->type;
1457    }
1458  else if (e1->type == FAT_LIST && is_empty_list (e1->list))
1459    {
1460      if (e2->type == FAT_CHARACTER_INTEGER_NULL
1461	  || e2->type == FAT_CHARACTER_NULL
1462	  || e2->type == FAT_INTEGER_NULL)
1463	re->type = e2->type;
1464      else if (e2->type == FAT_CHARACTER)
1465	re->type = FAT_CHARACTER_NULL;
1466      else if (e2->type == FAT_INTEGER)
1467	re->type = FAT_INTEGER_NULL;
1468      else
1469	re->type = FAT_OBJECT;
1470    }
1471  else if (e2->type == FAT_LIST && is_empty_list (e2->list))
1472    {
1473      if (e1->type == FAT_CHARACTER_INTEGER_NULL
1474	  || e1->type == FAT_CHARACTER_NULL
1475	  || e1->type == FAT_INTEGER_NULL)
1476	re->type = e1->type;
1477      else if (e1->type == FAT_CHARACTER)
1478	re->type = FAT_CHARACTER_NULL;
1479      else if (e1->type == FAT_INTEGER)
1480	re->type = FAT_INTEGER_NULL;
1481      else
1482	re->type = FAT_OBJECT;
1483    }
1484  else if ((e1->type == FAT_CHARACTER || e1->type == FAT_CHARACTER_NULL)
1485	   && (e2->type == FAT_INTEGER || e2->type == FAT_INTEGER_NULL))
1486    {
1487      re->type = FAT_CHARACTER_INTEGER_NULL;
1488    }
1489  else if ((e2->type == FAT_CHARACTER || e2->type == FAT_CHARACTER_NULL)
1490	   && (e1->type == FAT_INTEGER || e1->type == FAT_INTEGER_NULL))
1491    {
1492      re->type = FAT_CHARACTER_INTEGER_NULL;
1493    }
1494  else
1495    {
1496      /* Other union types are too hard to describe precisely.  */
1497      re->type = FAT_OBJECT;
1498    }
1499}
1500
1501/* Create the union (i.e. alternative constraints) of two argument list
1502   constraints.  Free both argument lists when done.  */
1503/* Memory effects: list1 and list2 are freed.  The result is freshly
1504   allocated.  */
1505static struct format_arg_list *
1506make_union_list (struct format_arg_list *list1, struct format_arg_list *list2)
1507{
1508  struct format_arg_list *result;
1509
1510  VERIFY_LIST (list1);
1511  VERIFY_LIST (list2);
1512
1513  if (list1->repeated.length > 0 && list2->repeated.length > 0)
1514    {
1515      /* Step 1: Ensure list1->repeated.length == list2->repeated.length.  */
1516      {
1517	unsigned int n1 = list1->repeated.length;
1518	unsigned int n2 = list2->repeated.length;
1519	unsigned int g = gcd (n1, n2);
1520	unsigned int m1 = n2 / g; /* = lcm(n1,n2) / n1 */
1521	unsigned int m2 = n1 / g; /* = lcm(n1,n2) / n2 */
1522
1523	unfold_loop (list1, m1);
1524	unfold_loop (list2, m2);
1525	/* Now list1->repeated.length = list2->repeated.length = lcm(n1,n2).  */
1526      }
1527
1528      /* Step 2: Ensure that list1->initial.length == list2->initial.length.  */
1529      {
1530	unsigned int m = MAX (list1->initial.length, list2->initial.length);
1531
1532	rotate_loop (list1, m);
1533	rotate_loop (list2, m);
1534      }
1535
1536      ASSERT (list1->initial.length == list2->initial.length);
1537      ASSERT (list1->repeated.length == list2->repeated.length);
1538    }
1539  else if (list1->repeated.length > 0)
1540    {
1541      /* Ensure the initial segment of the result can be computed from the
1542	 initial segment of list1.  */
1543      if (list2->initial.length >= list1->initial.length)
1544	{
1545	  rotate_loop (list1, list2->initial.length);
1546	  if (list1->repeated.element[0].presence == FCT_REQUIRED)
1547	    rotate_loop (list1, list1->initial.length + 1);
1548	}
1549    }
1550  else if (list2->repeated.length > 0)
1551    {
1552      /* Ensure the initial segment of the result can be computed from the
1553	 initial segment of list2.  */
1554      if (list1->initial.length >= list2->initial.length)
1555	{
1556	  rotate_loop (list2, list1->initial.length);
1557	  if (list2->repeated.element[0].presence == FCT_REQUIRED)
1558	    rotate_loop (list2, list2->initial.length + 1);
1559	}
1560    }
1561
1562  /* Step 3: Allocate the result.  */
1563  result =
1564    (struct format_arg_list *) xmalloc (sizeof (struct format_arg_list));
1565  result->initial.count = 0;
1566  result->initial.allocated = 0;
1567  result->initial.element = NULL;
1568  result->initial.length = 0;
1569  result->repeated.count = 0;
1570  result->repeated.allocated = 0;
1571  result->repeated.element = NULL;
1572  result->repeated.length = 0;
1573
1574  /* Step 4: Elementwise union of list1->initial, list2->initial.  */
1575  {
1576    struct format_arg *e1;
1577    struct format_arg *e2;
1578    unsigned int c1;
1579    unsigned int c2;
1580
1581    e1 = list1->initial.element; c1 = list1->initial.count;
1582    e2 = list2->initial.element; c2 = list2->initial.count;
1583    while (c1 > 0 && c2 > 0)
1584      {
1585	struct format_arg *re;
1586
1587	/* Ensure room in result->initial.  */
1588	grow_initial_alloc (result);
1589	re = &result->initial.element[result->initial.count];
1590	re->repcount = MIN (e1->repcount, e2->repcount);
1591
1592	/* Union of the argument types.  */
1593	make_union_element (re, e1, e2);
1594
1595	result->initial.count++;
1596	result->initial.length += re->repcount;
1597
1598	e1->repcount -= re->repcount;
1599	if (e1->repcount == 0)
1600	  {
1601	    e1++;
1602	    c1--;
1603	  }
1604	e2->repcount -= re->repcount;
1605	if (e2->repcount == 0)
1606	  {
1607	    e2++;
1608	    c2--;
1609	  }
1610       }
1611
1612    if (c1 > 0)
1613      {
1614	/* list2 already terminated, but still more elements in list1->initial.
1615	   Copy them all, but turn the first presence to FCT_OPTIONAL.  */
1616	ASSERT (list2->repeated.count == 0);
1617
1618	if (e1->presence == FCT_REQUIRED)
1619	  {
1620	    struct format_arg *re;
1621
1622	    /* Ensure room in result->initial.  */
1623	    grow_initial_alloc (result);
1624	    re = &result->initial.element[result->initial.count];
1625	    copy_element (re, e1);
1626	    re->presence = FCT_OPTIONAL;
1627	    re->repcount = 1;
1628	    result->initial.count++;
1629	    result->initial.length += 1;
1630	    e1->repcount -= 1;
1631	    if (e1->repcount == 0)
1632	      {
1633		e1++;
1634		c1--;
1635	      }
1636	  }
1637
1638	/* Ensure room in result->initial.  */
1639	ensure_initial_alloc (result, result->initial.count + c1);
1640	while (c1 > 0)
1641	  {
1642	    struct format_arg *re;
1643
1644	    re = &result->initial.element[result->initial.count];
1645	    copy_element (re, e1);
1646	    result->initial.count++;
1647	    result->initial.length += re->repcount;
1648	    e1++;
1649	    c1--;
1650	  }
1651      }
1652    else if (c2 > 0)
1653      {
1654	/* list1 already terminated, but still more elements in list2->initial.
1655	   Copy them all, but turn the first presence to FCT_OPTIONAL.  */
1656	ASSERT (list1->repeated.count == 0);
1657
1658	if (e2->presence == FCT_REQUIRED)
1659	  {
1660	    struct format_arg *re;
1661
1662	    /* Ensure room in result->initial.  */
1663	    grow_initial_alloc (result);
1664	    re = &result->initial.element[result->initial.count];
1665	    copy_element (re, e2);
1666	    re->presence = FCT_OPTIONAL;
1667	    re->repcount = 1;
1668	    result->initial.count++;
1669	    result->initial.length += 1;
1670	    e2->repcount -= 1;
1671	    if (e2->repcount == 0)
1672	      {
1673		e2++;
1674		c2--;
1675	      }
1676	  }
1677
1678	/* Ensure room in result->initial.  */
1679	ensure_initial_alloc (result, result->initial.count + c2);
1680	while (c2 > 0)
1681	  {
1682	    struct format_arg *re;
1683
1684	    re = &result->initial.element[result->initial.count];
1685	    copy_element (re, e2);
1686	    result->initial.count++;
1687	    result->initial.length += re->repcount;
1688	    e2++;
1689	    c2--;
1690	  }
1691      }
1692    ASSERT (c1 == 0 && c2 == 0);
1693  }
1694
1695  if (list1->repeated.length > 0 && list2->repeated.length > 0)
1696    /* Step 5: Elementwise union of list1->repeated, list2->repeated.  */
1697    {
1698      struct format_arg *e1;
1699      struct format_arg *e2;
1700      unsigned int c1;
1701      unsigned int c2;
1702
1703      e1 = list1->repeated.element; c1 = list1->repeated.count;
1704      e2 = list2->repeated.element; c2 = list2->repeated.count;
1705      while (c1 > 0 && c2 > 0)
1706	{
1707	  struct format_arg *re;
1708
1709	  /* Ensure room in result->repeated.  */
1710	  grow_repeated_alloc (result);
1711	  re = &result->repeated.element[result->repeated.count];
1712	  re->repcount = MIN (e1->repcount, e2->repcount);
1713
1714	  /* Union of the argument types.  */
1715	  make_union_element (re, e1, e2);
1716
1717	  result->repeated.count++;
1718	  result->repeated.length += re->repcount;
1719
1720	  e1->repcount -= re->repcount;
1721	  if (e1->repcount == 0)
1722	    {
1723	      e1++;
1724	      c1--;
1725	    }
1726	  e2->repcount -= re->repcount;
1727	  if (e2->repcount == 0)
1728	    {
1729	      e2++;
1730	      c2--;
1731	    }
1732	}
1733      ASSERT (c1 == 0 && c2 == 0);
1734    }
1735  else if (list1->repeated.length > 0)
1736    {
1737      /* Turning FCT_REQUIRED into FCT_OPTIONAL was already handled in the
1738	 initial segment.  Just copy the repeated segment of list1.  */
1739      unsigned int i;
1740
1741      result->repeated.count = list1->repeated.count;
1742      result->repeated.allocated = result->repeated.count;
1743      result->repeated.element =
1744	(struct format_arg *)
1745	xmalloc (result->repeated.allocated * sizeof (struct format_arg));
1746      for (i = 0; i < list1->repeated.count; i++)
1747	copy_element (&result->repeated.element[i],
1748		      &list1->repeated.element[i]);
1749      result->repeated.length = list1->repeated.length;
1750    }
1751  else if (list2->repeated.length > 0)
1752    {
1753      /* Turning FCT_REQUIRED into FCT_OPTIONAL was already handled in the
1754	 initial segment.  Just copy the repeated segment of list2.  */
1755      unsigned int i;
1756
1757      result->repeated.count = list2->repeated.count;
1758      result->repeated.allocated = result->repeated.count;
1759      result->repeated.element =
1760	(struct format_arg *)
1761	xmalloc (result->repeated.allocated * sizeof (struct format_arg));
1762      for (i = 0; i < list2->repeated.count; i++)
1763	copy_element (&result->repeated.element[i],
1764		      &list2->repeated.element[i]);
1765      result->repeated.length = list2->repeated.length;
1766    }
1767
1768  free_list (list1);
1769  free_list (list2);
1770  /* Undo the loop unfolding and unrolling done above.  */
1771  normalize_outermost_list (result);
1772  VERIFY_LIST (result);
1773  return result;
1774}
1775
1776
1777/* Create the union of an argument list and the empty list.  */
1778/* Memory effects: list is freed.  The result is freshly allocated.  */
1779static struct format_arg_list *
1780make_union_with_empty_list (struct format_arg_list *list)
1781{
1782#if 0 /* equivalent but slower */
1783  return make_union_list (list, make_empty_list ());
1784#else
1785  VERIFY_LIST (list);
1786
1787  if (list->initial.count > 0
1788      ? list->initial.element[0].presence == FCT_REQUIRED
1789      : list->repeated.count > 0
1790	&& list->repeated.element[0].presence == FCT_REQUIRED)
1791    {
1792      initial_splitelement (list, 1);
1793      ASSERT (list->initial.count > 0);
1794      ASSERT (list->initial.element[0].repcount == 1);
1795      ASSERT (list->initial.element[0].presence == FCT_REQUIRED);
1796      list->initial.element[0].presence = FCT_OPTIONAL;
1797
1798      /* We might need to merge list->initial.element[0] and
1799	 list->initial.element[1].  */
1800      normalize_outermost_list (list);
1801    }
1802
1803  VERIFY_LIST (list);
1804
1805  return list;
1806#endif
1807}
1808
1809
1810/* Create the union of two argument list constraints.  NULL stands for an
1811   impossible situation, i.e. a contradiction.  */
1812/* Memory effects: list1 and list2 are freed if non-NULL.  The result,
1813   if non-NULL, is freshly allocated.  */
1814static struct format_arg_list *
1815union (struct format_arg_list *list1, struct format_arg_list *list2)
1816{
1817  if (list1 != NULL)
1818    {
1819      if (list2 != NULL)
1820	return make_union_list (list1, list2);
1821      else
1822	return list1;
1823    }
1824  else
1825    {
1826      if (list2 != NULL)
1827	return list2;
1828      else
1829	return NULL;
1830    }
1831}
1832
1833
1834/* =========== Adding specific constraints to a format_arg_list =========== */
1835
1836
1837/* Test whether arguments 0..n are required arguments in a list.  */
1838static bool
1839is_required (const struct format_arg_list *list, unsigned int n)
1840{
1841  unsigned int s;
1842  unsigned int t;
1843
1844  /* We'll check whether the first n+1 presence flags are FCT_REQUIRED.  */
1845  t = n + 1;
1846
1847  /* Walk the list->initial segment.  */
1848  for (s = 0;
1849       s < list->initial.count && t >= list->initial.element[s].repcount;
1850       t -= list->initial.element[s].repcount, s++)
1851    if (list->initial.element[s].presence != FCT_REQUIRED)
1852      return false;
1853
1854  if (t == 0)
1855    return true;
1856
1857  if (s < list->initial.count)
1858    {
1859      if (list->initial.element[s].presence != FCT_REQUIRED)
1860	return false;
1861      else
1862	return true;
1863    }
1864
1865  /* Walk the list->repeated segment.  */
1866  if (list->repeated.count == 0)
1867    return false;
1868
1869  for (s = 0;
1870       s < list->repeated.count && t >= list->repeated.element[s].repcount;
1871       t -= list->repeated.element[s].repcount, s++)
1872    if (list->repeated.element[s].presence != FCT_REQUIRED)
1873      return false;
1874
1875  if (t == 0)
1876    return true;
1877
1878  if (s < list->repeated.count)
1879    {
1880      if (list->repeated.element[s].presence != FCT_REQUIRED)
1881	return false;
1882      else
1883	return true;
1884    }
1885
1886  /* The list->repeated segment consists only of FCT_REQUIRED.  So,
1887     regardless how many more passes through list->repeated would be
1888     needed until t becomes 0, the result is true.  */
1889  return true;
1890}
1891
1892
1893/* Add a constraint to an argument list, namely that the arguments 0...n are
1894   present.  NULL stands for an impossible situation, i.e. a contradiction.  */
1895/* Memory effects: list is freed.  The result is freshly allocated.  */
1896static struct format_arg_list *
1897add_required_constraint (struct format_arg_list *list, unsigned int n)
1898{
1899  unsigned int i, rest;
1900
1901  if (list == NULL)
1902    return NULL;
1903
1904  VERIFY_LIST (list);
1905
1906  if (list->repeated.count == 0 && list->initial.length <= n)
1907    {
1908      /* list is already constrained to have at most length n.
1909	 Contradiction.  */
1910      free_list (list);
1911      return NULL;
1912    }
1913
1914  initial_splitelement (list, n + 1);
1915
1916  for (i = 0, rest = n + 1; rest > 0; )
1917    {
1918      list->initial.element[i].presence = FCT_REQUIRED;
1919      rest -= list->initial.element[i].repcount;
1920      i++;
1921    }
1922
1923  VERIFY_LIST (list);
1924
1925  return list;
1926}
1927
1928
1929/* Add a constraint to an argument list, namely that the argument n is
1930   never present.  NULL stands for an impossible situation, i.e. a
1931   contradiction.  */
1932/* Memory effects: list is freed.  The result is freshly allocated.  */
1933static struct format_arg_list *
1934add_end_constraint (struct format_arg_list *list, unsigned int n)
1935{
1936  unsigned int s, i;
1937  enum format_cdr_type n_presence;
1938
1939  if (list == NULL)
1940    return NULL;
1941
1942  VERIFY_LIST (list);
1943
1944  if (list->repeated.count == 0 && list->initial.length <= n)
1945    /* list is already constrained to have at most length n.  */
1946    return list;
1947
1948  s = initial_splitelement (list, n);
1949  n_presence =
1950    (s < list->initial.count
1951     ? /* n < list->initial.length */ list->initial.element[s].presence
1952     : /* n >= list->initial.length */ list->repeated.element[0].presence);
1953
1954  for (i = s; i < list->initial.count; i++)
1955    {
1956      list->initial.length -= list->initial.element[i].repcount;
1957      free_element (&list->initial.element[i]);
1958    }
1959  list->initial.count = s;
1960
1961  for (i = 0; i < list->repeated.count; i++)
1962    free_element (&list->repeated.element[i]);
1963  if (list->repeated.element != NULL)
1964    free (list->repeated.element);
1965  list->repeated.element = NULL;
1966  list->repeated.allocated = 0;
1967  list->repeated.count = 0;
1968  list->repeated.length = 0;
1969
1970  if (n_presence == FCT_REQUIRED)
1971    return backtrack_in_initial (list);
1972  else
1973    return list;
1974}
1975
1976
1977/* Add a constraint to an argument list, namely that the argument n is
1978   of a given type.  NULL stands for an impossible situation, i.e. a
1979   contradiction.  Assumes a preceding add_required_constraint (list, n).  */
1980/* Memory effects: list is freed.  The result is freshly allocated.  */
1981static struct format_arg_list *
1982add_type_constraint (struct format_arg_list *list, unsigned int n,
1983		     enum format_arg_type type)
1984{
1985  unsigned int s;
1986  struct format_arg newconstraint;
1987  struct format_arg tmpelement;
1988
1989  if (list == NULL)
1990    return NULL;
1991
1992  /* Through the previous add_required_constraint, we can assume
1993     list->initial.length >= n+1.  */
1994
1995  s = initial_unshare (list, n);
1996
1997  newconstraint.presence = FCT_OPTIONAL;
1998  newconstraint.type = type;
1999  if (!make_intersected_element (&tmpelement,
2000				 &list->initial.element[s], &newconstraint))
2001    return add_end_constraint (list, n);
2002  free_element (&list->initial.element[s]);
2003  list->initial.element[s].type = tmpelement.type;
2004  list->initial.element[s].list = tmpelement.list;
2005
2006  VERIFY_LIST (list);
2007
2008  return list;
2009}
2010
2011
2012/* Add a constraint to an argument list, namely that the argument n is
2013   of a given list type.  NULL stands for an impossible situation, i.e. a
2014   contradiction.  Assumes a preceding add_required_constraint (list, n).  */
2015/* Memory effects: list is freed.  The result is freshly allocated.  */
2016static struct format_arg_list *
2017add_listtype_constraint (struct format_arg_list *list, unsigned int n,
2018			 enum format_arg_type type,
2019			 struct format_arg_list *sublist)
2020{
2021  unsigned int s;
2022  struct format_arg newconstraint;
2023  struct format_arg tmpelement;
2024
2025  if (list == NULL)
2026    return NULL;
2027
2028  /* Through the previous add_required_constraint, we can assume
2029     list->initial.length >= n+1.  */
2030
2031  s = initial_unshare (list, n);
2032
2033  newconstraint.presence = FCT_OPTIONAL;
2034  newconstraint.type = type;
2035  newconstraint.list = sublist;
2036  if (!make_intersected_element (&tmpelement,
2037				 &list->initial.element[s], &newconstraint))
2038    return add_end_constraint (list, n);
2039  free_element (&list->initial.element[s]);
2040  list->initial.element[s].type = tmpelement.type;
2041  list->initial.element[s].list = tmpelement.list;
2042
2043  VERIFY_LIST (list);
2044
2045  return list;
2046}
2047
2048
2049/* ============= Subroutines used by the format string parser ============= */
2050
2051static void
2052add_req_type_constraint (struct format_arg_list **listp,
2053			 unsigned int position, enum format_arg_type type)
2054{
2055  *listp = add_required_constraint (*listp, position);
2056  *listp = add_type_constraint (*listp, position, type);
2057}
2058
2059
2060static void
2061add_req_listtype_constraint (struct format_arg_list **listp,
2062			     unsigned int position, enum format_arg_type type,
2063			     struct format_arg_list *sublist)
2064{
2065  *listp = add_required_constraint (*listp, position);
2066  *listp = add_listtype_constraint (*listp, position, type, sublist);
2067}
2068
2069
2070/* Create an endless repeated list whose elements are lists constrained
2071   by sublist.  */
2072/* Memory effects: sublist is freed.  The result is freshly allocated.  */
2073static struct format_arg_list *
2074make_repeated_list_of_lists (struct format_arg_list *sublist)
2075{
2076  if (sublist == NULL)
2077    /* The list cannot have a single element.  */
2078    return make_empty_list ();
2079  else
2080    {
2081      struct format_arg_list *listlist;
2082
2083      listlist =
2084	(struct format_arg_list *) xmalloc (sizeof (struct format_arg_list));
2085
2086      listlist->initial.count = 0;
2087      listlist->initial.allocated = 0;
2088      listlist->initial.element = NULL;
2089      listlist->initial.length = 0;
2090      listlist->repeated.count = 1;
2091      listlist->repeated.allocated = 1;
2092      listlist->repeated.element =
2093	(struct format_arg *) xmalloc (1 * sizeof (struct format_arg));
2094      listlist->repeated.element[0].repcount = 1;
2095      listlist->repeated.element[0].presence = FCT_OPTIONAL;
2096      listlist->repeated.element[0].type = FAT_LIST;
2097      listlist->repeated.element[0].list = sublist;
2098      listlist->repeated.length = 1;
2099
2100      VERIFY_LIST (listlist);
2101
2102      return listlist;
2103    }
2104}
2105
2106
2107/* Create an endless repeated list which represents the union of a finite
2108   number of copies of L, each time shifted by period:
2109     ()
2110     L
2111     L and (*^period L)
2112     L and (*^period L) and (*^{2 period} L)
2113     L and (*^period L) and (*^{2 period} L) and (*^{3 period} L)
2114     ...
2115 */
2116/* Memory effects: sublist is freed.  The result is freshly allocated.  */
2117static struct format_arg_list *
2118make_repeated_list (struct format_arg_list *sublist, unsigned int period)
2119{
2120  struct segment tmp;
2121  struct segment *srcseg;
2122  struct format_arg_list *list;
2123  unsigned int p, n, i, si, ti, j, sj, tj, splitindex, newcount;
2124  bool ended;
2125
2126  VERIFY_LIST (sublist);
2127
2128  ASSERT (period > 0);
2129
2130  if (sublist->repeated.count == 0)
2131    {
2132      /* L is a finite list.  */
2133
2134      if (sublist->initial.length < period)
2135	/* L and (*^period L) is a contradition, so we need to consider
2136	   only 1 and 0 iterations.  */
2137	return make_union_with_empty_list (sublist);
2138
2139      srcseg = &sublist->initial;
2140      p = period;
2141    }
2142  else
2143    {
2144      /* L is an infinite list.  */
2145      /* p := lcm (period, period of L)  */
2146      unsigned int Lp = sublist->repeated.length;
2147      unsigned int m = period / gcd (period, Lp); /* = lcm(period,Lp) / Lp */
2148
2149      unfold_loop (sublist, m);
2150      p = m * Lp;
2151
2152      /* Concatenate the initial and the repeated segments into a single
2153	 segment.  */
2154      tmp.count = sublist->initial.count + sublist->repeated.count;
2155      tmp.allocated = tmp.count;
2156      tmp.element =
2157	(struct format_arg *)
2158	xmalloc (tmp.allocated * sizeof (struct format_arg));
2159      for (i = 0; i < sublist->initial.count; i++)
2160	tmp.element[i] = sublist->initial.element[i];
2161      for (j = 0; j < sublist->repeated.count; i++, j++)
2162	tmp.element[i] = sublist->initial.element[j];
2163      tmp.length = sublist->initial.length + sublist->repeated.length;
2164
2165      srcseg = &tmp;
2166    }
2167
2168  n = srcseg->length;
2169
2170  /* Example: n = 7, p = 2
2171     Let L = (A B C D E F G).
2172
2173     L                 =    A     B     C     D      E      F      G
2174     L & L<<p          =    A     B    C&A   D&B    E&C    F&D    G&E
2175     L & L<<p & L<<2p  =    A     B    C&A   D&B   E&C&A  F&D&B  G&E&C
2176     ...               =    A     B    C&A   D&B   E&C&A  F&D&B G&E&C&A
2177
2178     Thus the result has an initial segment of length n - p and a period
2179     of p, and can be computed by floor(n/p) intersection operations.
2180     Or by a single incremental intersection operation, going from left
2181     to right.  */
2182
2183  list = (struct format_arg_list *) xmalloc (sizeof (struct format_arg_list));
2184  list->initial.count = 0;
2185  list->initial.allocated = 0;
2186  list->initial.element = NULL;
2187  list->initial.length = 0;
2188  list->repeated.count = 0;
2189  list->repeated.allocated = 0;
2190  list->repeated.element = NULL;
2191  list->repeated.length = 0;
2192
2193  /* Sketch:
2194     for (i = 0; i < p; i++)
2195       list->initial.element[i] = srcseg->element[i];
2196     list->initial.element[0].presence = FCT_OPTIONAL;  // union with empty list
2197     for (i = p, j = 0; i < n; i++, j++)
2198       list->initial.element[i] = srcseg->element[i] & list->initial.element[j];
2199   */
2200
2201  ended = false;
2202
2203  i = 0, ti = 0, si = 0;
2204  while (i < p)
2205    {
2206      unsigned int k = MIN (srcseg->element[si].repcount - ti, p - i);
2207
2208      /* Ensure room in list->initial.  */
2209      grow_initial_alloc (list);
2210      copy_element (&list->initial.element[list->initial.count],
2211		    &srcseg->element[si]);
2212      list->initial.element[list->initial.count].repcount = k;
2213      list->initial.count++;
2214      list->initial.length += k;
2215
2216      i += k;
2217      ti += k;
2218      if (ti == srcseg->element[si].repcount)
2219	{
2220	  ti = 0;
2221	  si++;
2222	}
2223    }
2224
2225  ASSERT (list->initial.count > 0);
2226  if (list->initial.element[0].presence == FCT_REQUIRED)
2227    {
2228      initial_splitelement (list, 1);
2229      ASSERT (list->initial.element[0].presence == FCT_REQUIRED);
2230      ASSERT (list->initial.element[0].repcount == 1);
2231      list->initial.element[0].presence = FCT_OPTIONAL;
2232    }
2233
2234  j = 0, tj = 0, sj = 0;
2235  while (i < n)
2236    {
2237      unsigned int k =
2238	MIN (srcseg->element[si].repcount - ti,
2239	     list->initial.element[sj].repcount - tj);
2240
2241      /* Ensure room in list->initial.  */
2242      grow_initial_alloc (list);
2243      if (!make_intersected_element (&list->initial.element[list->initial.count],
2244				     &srcseg->element[si],
2245				     &list->initial.element[sj]))
2246	{
2247	  if (list->initial.element[list->initial.count].presence == FCT_REQUIRED)
2248	    {
2249	      /* Contradiction.  Backtrack.  */
2250	      list = backtrack_in_initial (list);
2251	      ASSERT (list != NULL); /* at least the empty list is valid */
2252	      return list;
2253	    }
2254	  else
2255	    {
2256	      /* The list ends here.  */
2257	      ended = true;
2258	      break;
2259	    }
2260	}
2261      list->initial.element[list->initial.count].repcount = k;
2262      list->initial.count++;
2263      list->initial.length += k;
2264
2265      i += k;
2266      ti += k;
2267      if (ti == srcseg->element[si].repcount)
2268	{
2269	  ti = 0;
2270	  si++;
2271	}
2272
2273      j += k;
2274      tj += k;
2275      if (tj == list->initial.element[sj].repcount)
2276	{
2277	  tj = 0;
2278	  sj++;
2279	}
2280    }
2281  if (!ended)
2282    ASSERT (list->initial.length == n);
2283
2284  /* Add optional exit points at 0, period, 2*period etc.
2285     FIXME: Not sure this is correct in all cases.  */
2286  for (i = 0; i < list->initial.length; i += period)
2287    {
2288      si = initial_unshare (list, i);
2289      list->initial.element[si].presence = FCT_OPTIONAL;
2290    }
2291
2292  if (!ended)
2293    {
2294      /* Now split off the repeated part.  */
2295      splitindex = initial_splitelement (list, n - p);
2296      newcount = list->initial.count - splitindex;
2297      if (newcount > list->repeated.allocated)
2298	{
2299	  list->repeated.allocated = newcount;
2300	  list->repeated.element =
2301	    (struct format_arg *) xmalloc (newcount * sizeof (struct format_arg));
2302	}
2303      for (i = splitindex, j = 0; i < n; i++, j++)
2304	list->repeated.element[j] = list->initial.element[i];
2305      list->repeated.count = newcount;
2306      list->repeated.length = p;
2307      list->initial.count = splitindex;
2308      list->initial.length = n - p;
2309    }
2310
2311  VERIFY_LIST (list);
2312
2313  return list;
2314}
2315
2316
2317/* ================= Handling of format string directives ================= */
2318
2319/* Possible signatures of format directives.  */
2320static const enum format_arg_type I [1] = { FAT_INTEGER_NULL };
2321static const enum format_arg_type II [2] = {
2322  FAT_INTEGER_NULL, FAT_INTEGER_NULL
2323};
2324static const enum format_arg_type IIC [3] = {
2325  FAT_INTEGER_NULL, FAT_INTEGER_NULL, FAT_CHARACTER_NULL
2326};
2327static const enum format_arg_type ICCI [4] = {
2328  FAT_INTEGER_NULL, FAT_CHARACTER_NULL, FAT_CHARACTER_NULL, FAT_INTEGER_NULL
2329};
2330static const enum format_arg_type IIIC [4] = {
2331  FAT_INTEGER_NULL, FAT_INTEGER_NULL, FAT_INTEGER_NULL, FAT_CHARACTER_NULL
2332};
2333static const enum format_arg_type IICCI [5] = {
2334  FAT_INTEGER_NULL, FAT_INTEGER_NULL, FAT_CHARACTER_NULL, FAT_CHARACTER_NULL,
2335  FAT_INTEGER_NULL
2336};
2337static const enum format_arg_type IIICC [5] = {
2338  FAT_INTEGER_NULL, FAT_INTEGER_NULL, FAT_INTEGER_NULL, FAT_CHARACTER_NULL,
2339  FAT_CHARACTER_NULL
2340};
2341static const enum format_arg_type IIIICCC [7] = {
2342  FAT_INTEGER_NULL, FAT_INTEGER_NULL, FAT_INTEGER_NULL, FAT_INTEGER_NULL,
2343  FAT_CHARACTER_NULL, FAT_CHARACTER_NULL, FAT_CHARACTER_NULL
2344};
2345static const enum format_arg_type THREE [3] = {
2346  FAT_CHARACTER_INTEGER_NULL, FAT_CHARACTER_INTEGER_NULL,
2347  FAT_CHARACTER_INTEGER_NULL
2348};
2349
2350
2351/* Check the parameters.  For V params, add the constraint to the argument
2352   list.  Return false and fill in *invalid_reason if the format string is
2353   invalid.  */
2354static bool
2355check_params (struct format_arg_list **listp,
2356	      unsigned int paramcount, struct param *params,
2357	      unsigned int t_count, const enum format_arg_type *t_types,
2358	      unsigned int directives, char **invalid_reason)
2359{
2360  unsigned int orig_paramcount = paramcount;
2361  unsigned int orig_t_count = t_count;
2362
2363  for (; paramcount > 0 && t_count > 0;
2364	 params++, paramcount--, t_types++, t_count--)
2365    {
2366      switch (*t_types)
2367	{
2368	case FAT_CHARACTER_INTEGER_NULL:
2369	  break;
2370	case FAT_CHARACTER_NULL:
2371	  switch (params->type)
2372	    {
2373	    case PT_NIL: case PT_CHARACTER: case PT_V:
2374	      break;
2375	    case PT_INTEGER: case PT_ARGCOUNT:
2376	      /* wrong param type */
2377	      *invalid_reason =
2378		xasprintf (_("In the directive number %u, parameter %u is of type '%s' but a parameter of type '%s' is expected."), directives, orig_paramcount - paramcount + 1, "integer", "character");
2379	      return false;
2380	    }
2381	  break;
2382	case FAT_INTEGER_NULL:
2383	  switch (params->type)
2384	    {
2385	    case PT_NIL: case PT_INTEGER: case PT_ARGCOUNT: case PT_V:
2386	      break;
2387	    case PT_CHARACTER:
2388	      /* wrong param type */
2389	      *invalid_reason =
2390		xasprintf (_("In the directive number %u, parameter %u is of type '%s' but a parameter of type '%s' is expected."), directives, orig_paramcount - paramcount + 1, "character", "integer");
2391	      return false;
2392	    }
2393	  break;
2394	default:
2395	  abort ();
2396	}
2397      if (params->type == PT_V)
2398	{
2399	  int position = params->value;
2400	  if (position >= 0)
2401	    add_req_type_constraint (listp, position, *t_types);
2402	}
2403    }
2404
2405  for (; paramcount > 0; params++, paramcount--)
2406    switch (params->type)
2407      {
2408      case PT_NIL:
2409	break;
2410      case PT_CHARACTER: case PT_INTEGER: case PT_ARGCOUNT:
2411	/* too many params for directive */
2412	*invalid_reason =
2413	  xasprintf (ngettext ("In the directive number %u, too many parameters are given; expected at most %u parameter.",
2414			       "In the directive number %u, too many parameters are given; expected at most %u parameters.",
2415			       orig_t_count),
2416		     directives, orig_t_count);
2417	return false;
2418      case PT_V:
2419	/* Force argument to be NIL.  */
2420	{
2421	  int position = params->value;
2422	  if (position >= 0)
2423	    {
2424	      struct format_arg_list *empty_list = make_empty_list ();
2425	      add_req_listtype_constraint (listp, position,
2426					   FAT_LIST, empty_list);
2427	      free_list (empty_list);
2428	    }
2429	}
2430	break;
2431      }
2432
2433  return true;
2434}
2435
2436
2437/* ======================= The format string parser ======================= */
2438
2439/* Parse a piece of format string, until the matching terminating format
2440   directive is encountered.
2441   format is the remainder of the format string.
2442   position is the position in this argument list, if known, or -1 if unknown.
2443   list represents the argument list constraints at the current parse point.
2444   NULL stands for a contradiction.
2445   escape represents the union of the argument list constraints at all the
2446   currently pending FORMAT-UP-AND-OUT points. NULL stands for a contradiction
2447   or an empty union.
2448   All four are updated upon valid return.
2449   *separatorp is set to true if the parse terminated due to a ~; separator,
2450   more precisely to 2 if with colon, or to 1 if without colon.
2451   spec is the global struct spec.
2452   terminator is the directive that terminates this parse.
2453   separator specifies if ~; separators are allowed.
2454   If the format string is invalid, false is returned and *invalid_reason is
2455   set to an error message explaining why.  */
2456static bool
2457parse_upto (const char **formatp,
2458	    int *positionp, struct format_arg_list **listp,
2459	    struct format_arg_list **escapep, int *separatorp,
2460	    struct spec *spec, char terminator, bool separator,
2461	    char **invalid_reason)
2462{
2463  const char *format = *formatp;
2464  int position = *positionp;
2465  struct format_arg_list *list = *listp;
2466  struct format_arg_list *escape = *escapep;
2467
2468  for (; *format != '\0'; )
2469    if (*format++ == '~')
2470      {
2471	bool colon_p = false;
2472	bool atsign_p = false;
2473	unsigned int paramcount = 0;
2474	struct param *params = NULL;
2475
2476	/* Count number of directives.  */
2477	spec->directives++;
2478
2479	/* Parse parameters.  */
2480	for (;;)
2481	  {
2482	    enum param_type type = PT_NIL;
2483	    int value = 0;
2484
2485	    if (c_isdigit (*format))
2486	      {
2487		type = PT_INTEGER;
2488		do
2489		  {
2490		    value = 10 * value + (*format - '0');
2491		    format++;
2492		  }
2493		while (c_isdigit (*format));
2494	      }
2495	    else if (*format == '+' || *format == '-')
2496	      {
2497		bool negative = (*format == '-');
2498		type = PT_INTEGER;
2499		format++;
2500		if (!c_isdigit (*format))
2501		  {
2502		    *invalid_reason =
2503		      (*format == '\0'
2504		       ? INVALID_UNTERMINATED_DIRECTIVE ()
2505		       : xasprintf (_("In the directive number %u, '%c' is not followed by a digit."), spec->directives, format[-1]));
2506		    return false;
2507		  }
2508		do
2509		  {
2510		    value = 10 * value + (*format - '0');
2511		    format++;
2512		  }
2513		while (c_isdigit (*format));
2514		if (negative)
2515		  value = -value;
2516	      }
2517	    else if (*format == '\'')
2518	      {
2519		type = PT_CHARACTER;
2520		format++;
2521		if (*format == '\0')
2522		  {
2523		    *invalid_reason = INVALID_UNTERMINATED_DIRECTIVE ();
2524		    return false;
2525		  }
2526		format++;
2527	      }
2528	    else if (*format == 'V' || *format == 'v')
2529	      {
2530		type = PT_V;
2531		format++;
2532		value = position;
2533		/* Consumes an argument.  */
2534		if (position >= 0)
2535		  position++;
2536	      }
2537	    else if (*format == '#')
2538	      {
2539		type = PT_ARGCOUNT;
2540		format++;
2541	      }
2542
2543	    params =
2544	      (struct param *)
2545	      xrealloc (params, (paramcount + 1) * sizeof (struct param));
2546	    params[paramcount].type = type;
2547	    params[paramcount].value = value;
2548	    paramcount++;
2549
2550	    if (*format == ',')
2551	      format++;
2552	    else
2553	      break;
2554	  }
2555
2556	/* Parse modifiers.  */
2557	for (;;)
2558	  {
2559	    if (*format == ':')
2560	      {
2561		format++;
2562		colon_p = true;
2563	      }
2564	    else if (*format == '@')
2565	      {
2566		format++;
2567		atsign_p = true;
2568	      }
2569	    else
2570	      break;
2571	  }
2572
2573	/* Parse directive.  */
2574	switch (*format++)
2575	  {
2576	  case 'A': case 'a': /* 22.3.4.1 FORMAT-ASCII */
2577	  case 'S': case 's': /* 22.3.4.2 FORMAT-S-EXPRESSION */
2578	    if (!check_params (&list, paramcount, params, 4, IIIC,
2579			       spec->directives, invalid_reason))
2580	      return false;
2581	    if (position >= 0)
2582	      add_req_type_constraint (&list, position++, FAT_OBJECT);
2583	    break;
2584
2585	  case 'C': case 'c': /* FORMAT-CHARACTER */
2586	    if (!check_params (&list, paramcount, params, 1, I,
2587			       spec->directives, invalid_reason))
2588	      return false;
2589	    if (paramcount == 0
2590		|| (paramcount == 1 && params[0].type == PT_NIL))
2591	      if (position >= 0)
2592		add_req_type_constraint (&list, position++, FAT_CHARACTER);
2593	    break;
2594
2595	  case 'D': case 'd': /* 22.3.2.2 FORMAT-DECIMAL */
2596	  case 'B': case 'b': /* 22.3.2.3 FORMAT-BINARY */
2597	  case 'O': case 'o': /* 22.3.2.4 FORMAT-OCTAL */
2598	  case 'X': case 'x': /* 22.3.2.5 FORMAT-HEXADECIMAL */
2599	    if (!check_params (&list, paramcount, params, 4, ICCI,
2600			       spec->directives, invalid_reason))
2601	      return false;
2602	    if (position >= 0)
2603	      add_req_type_constraint (&list, position++, FAT_INTEGER);
2604	    break;
2605
2606	  case 'R': case 'r': /* 22.3.2.1 FORMAT-RADIX */
2607	    if (!check_params (&list, paramcount, params, 5, IICCI,
2608			       spec->directives, invalid_reason))
2609	      return false;
2610	    if (position >= 0)
2611	      add_req_type_constraint (&list, position++, FAT_INTEGER);
2612	    break;
2613
2614	  case 'P': case 'p': /* 22.3.8.3 FORMAT-PLURAL */
2615	    if (!check_params (&list, paramcount, params, 0, NULL,
2616			       spec->directives, invalid_reason))
2617	      return false;
2618	    if (colon_p)
2619	      {
2620		/* Go back by 1 argument.  */
2621		if (position > 0)
2622		  position--;
2623	      }
2624	    if (position >= 0)
2625	      add_req_type_constraint (&list, position++, FAT_OBJECT);
2626	    break;
2627
2628	  case 'F': case 'f': /* 22.3.3.1 FORMAT-FIXED-FLOAT */
2629	    if (!check_params (&list, paramcount, params, 5, IIICC,
2630			       spec->directives, invalid_reason))
2631	      return false;
2632	    if (position >= 0)
2633	      add_req_type_constraint (&list, position++, FAT_REAL);
2634	    break;
2635
2636	  case 'E': case 'e': /* 22.3.3.2 FORMAT-EXPONENTIAL-FLOAT */
2637	  case 'G': case 'g': /* 22.3.3.3 FORMAT-GENERAL-FLOAT */
2638	    if (!check_params (&list, paramcount, params, 7, IIIICCC,
2639			       spec->directives, invalid_reason))
2640	      return false;
2641	    if (position >= 0)
2642	      add_req_type_constraint (&list, position++, FAT_REAL);
2643	    break;
2644
2645	  case '$': /* 22.3.3.4 FORMAT-DOLLARS-FLOAT */
2646	    if (!check_params (&list, paramcount, params, 4, IIIC,
2647			       spec->directives, invalid_reason))
2648	      return false;
2649	    if (position >= 0)
2650	      add_req_type_constraint (&list, position++, FAT_REAL);
2651	    break;
2652
2653	  case 'I': case 'i': /* FORMAT-FIXED-FLOAT-COMPLEX */
2654	    if (!check_params (&list, paramcount, params, 5, IIICC,
2655			       spec->directives, invalid_reason))
2656	      return false;
2657	    if (position >= 0)
2658	      add_req_type_constraint (&list, position++, FAT_COMPLEX);
2659	    break;
2660
2661	  case 'Y': case 'y': /* FORMAT-PRETTY */
2662	    if (!check_params (&list, paramcount, params, 0, NULL,
2663			       spec->directives, invalid_reason))
2664	      return false;
2665	    if (position >= 0)
2666	      add_req_type_constraint (&list, position++, FAT_OBJECT);
2667	    break;
2668
2669	  case '%': /* 22.3.1.2 FORMAT-TERPRI */
2670	  case '&': /* 22.3.1.3 FORMAT-FRESH-LINE */
2671	  case '_': /* FORMAT-SPACE */
2672	  case '/': /* FORMAT-TAB */
2673	  case '|': /* 22.3.1.4 FORMAT-PAGE */
2674	  case '~': /* 22.3.1.5 FORMAT-TILDE */
2675	    if (!check_params (&list, paramcount, params, 1, I,
2676			       spec->directives, invalid_reason))
2677	      return false;
2678	    break;
2679
2680	  case '!': /* FORMAT-FORCE-OUTPUT */
2681	  case '\n': /* 22.3.9.3 #\Newline */
2682	  case 'Q': case 'q': /* FORMAT-IMPLEMENTATION */
2683	    if (!check_params (&list, paramcount, params, 0, NULL,
2684			       spec->directives, invalid_reason))
2685	      return false;
2686	    break;
2687
2688	  case 'T': case 't': /* FORMAT-TABULATE */
2689	    if (!check_params (&list, paramcount, params, 3, IIC,
2690			       spec->directives, invalid_reason))
2691	      return false;
2692	    break;
2693
2694	  case '*': /* 22.3.7.1 FORMAT-GOTO */
2695	    if (!check_params (&list, paramcount, params, 1, I,
2696			       spec->directives, invalid_reason))
2697	      return false;
2698	    {
2699	      int n; /* value of first parameter */
2700	      if (paramcount == 0
2701		  || (paramcount >= 1 && params[0].type == PT_NIL))
2702		n = (atsign_p ? 0 : 1);
2703	      else if (paramcount >= 1 && params[0].type == PT_INTEGER)
2704		n = params[0].value;
2705	      else
2706		{
2707		  /* Unknown argument, leads to an unknown position.  */
2708		  position = -1;
2709		  break;
2710		}
2711	      if (n < 0)
2712		{
2713		  /* invalid argument */
2714		  *invalid_reason =
2715		    xasprintf (_("In the directive number %u, the argument %d is negative."), spec->directives, n);
2716		  return false;
2717		}
2718	      if (atsign_p)
2719		{
2720		  /* Absolute goto.  */
2721		  position = n;
2722		}
2723	      else if (colon_p)
2724		{
2725		  /* Backward goto.  */
2726		  if (n > 0)
2727		    {
2728		      if (position >= 0)
2729			{
2730			  if (position >= n)
2731			    position -= n;
2732			  else
2733			    position = 0;
2734			}
2735		      else
2736			position = -1;
2737		   }
2738		}
2739	      else
2740		{
2741		  /* Forward goto.  */
2742		  if (position >= 0)
2743		    position += n;
2744		}
2745	    }
2746	    break;
2747
2748	  case '?': case 'K': case 'k': /* 22.3.7.6 FORMAT-INDIRECTION */
2749	    if (!check_params (&list, paramcount, params, 0, NULL,
2750			       spec->directives, invalid_reason))
2751	      return false;
2752	    if (position >= 0)
2753	      add_req_type_constraint (&list, position++, FAT_FORMATSTRING);
2754	    if (atsign_p)
2755	      position = -1;
2756	    else
2757	      if (position >= 0)
2758		{
2759		  struct format_arg_list *sublist = make_unconstrained_list ();
2760		  add_req_listtype_constraint (&list, position++,
2761					       FAT_LIST, sublist);
2762		  free_list (sublist);
2763		}
2764	    break;
2765
2766	  case '(': /* 22.3.8.1 FORMAT-CASE-CONVERSION */
2767	    if (!check_params (&list, paramcount, params, 0, NULL,
2768			       spec->directives, invalid_reason))
2769	      return false;
2770	    *formatp = format;
2771	    *positionp = position;
2772	    *listp = list;
2773	    *escapep = escape;
2774	    {
2775	      if (!parse_upto (formatp, positionp, listp, escapep,
2776			       NULL, spec, ')', false,
2777			       invalid_reason))
2778		return false;
2779	    }
2780	    format = *formatp;
2781	    position = *positionp;
2782	    list = *listp;
2783	    escape = *escapep;
2784	    break;
2785
2786	  case ')': /* 22.3.8.2 FORMAT-CASE-CONVERSION-END */
2787	    if (terminator != ')')
2788	      {
2789		*invalid_reason =
2790		  xasprintf (_("Found '~%c' without matching '~%c'."), ')', '(');
2791		return false;
2792	      }
2793	    if (!check_params (&list, paramcount, params, 0, NULL,
2794			       spec->directives, invalid_reason))
2795	      return false;
2796	    *formatp = format;
2797	    *positionp = position;
2798	    *listp = list;
2799	    *escapep = escape;
2800	    return true;
2801
2802	  case '[': /* 22.3.7.2 FORMAT-CONDITIONAL */
2803	    if (atsign_p && colon_p)
2804	      {
2805		*invalid_reason =
2806		  xasprintf (_("In the directive number %u, both the @ and the : modifiers are given."), spec->directives);
2807		return false;
2808	      }
2809	    else if (atsign_p)
2810	      {
2811		struct format_arg_list *nil_list;
2812		struct format_arg_list *union_list;
2813
2814		if (!check_params (&list, paramcount, params, 0, NULL,
2815				   spec->directives, invalid_reason))
2816		  return false;
2817
2818		*formatp = format;
2819		*escapep = escape;
2820
2821		/* First alternative: argument is NIL.  */
2822		nil_list = (list != NULL ? copy_list (list) : NULL);
2823		if (position >= 0)
2824		  {
2825		    struct format_arg_list *empty_list = make_empty_list ();
2826		    add_req_listtype_constraint (&nil_list, position,
2827						 FAT_LIST, empty_list);
2828		    free_list (empty_list);
2829		  }
2830
2831		/* Second alternative: use sub-format.  */
2832		{
2833		  int sub_position = position;
2834		  struct format_arg_list *sub_list =
2835		    (list != NULL ? copy_list (list) : NULL);
2836		  if (!parse_upto (formatp, &sub_position, &sub_list, escapep,
2837				   NULL, spec, ']', false,
2838				   invalid_reason))
2839		    return false;
2840		  if (sub_list != NULL)
2841		    {
2842		      if (position >= 0)
2843			{
2844			  if (sub_position == position + 1)
2845			    /* new position is branch independent */
2846			    position = position + 1;
2847			  else
2848			    /* new position is branch dependent */
2849			    position = -1;
2850			}
2851		    }
2852		  else
2853		    {
2854		      if (position >= 0)
2855			position = position + 1;
2856		    }
2857		  union_list = union (nil_list, sub_list);
2858		}
2859
2860		format = *formatp;
2861		escape = *escapep;
2862
2863		if (list != NULL)
2864		  free_list (list);
2865		list = union_list;
2866	      }
2867	    else if (colon_p)
2868	      {
2869		int union_position;
2870		struct format_arg_list *union_list;
2871
2872		if (!check_params (&list, paramcount, params, 0, NULL,
2873				   spec->directives, invalid_reason))
2874		  return false;
2875
2876		if (position >= 0)
2877		  add_req_type_constraint (&list, position++, FAT_OBJECT);
2878
2879		*formatp = format;
2880		*escapep = escape;
2881		union_position = -2;
2882		union_list = NULL;
2883
2884		/* First alternative.  */
2885		{
2886		  int sub_position = position;
2887		  struct format_arg_list *sub_list =
2888		    (list != NULL ? copy_list (list) : NULL);
2889		  int sub_separator = 0;
2890		  if (position >= 0)
2891		    {
2892		      struct format_arg_list *empty_list = make_empty_list ();
2893		      add_req_listtype_constraint (&sub_list, position - 1,
2894						   FAT_LIST, empty_list);
2895		      free_list (empty_list);
2896		    }
2897		  if (!parse_upto (formatp, &sub_position, &sub_list, escapep,
2898				   &sub_separator, spec, ']', true,
2899				   invalid_reason))
2900		    return false;
2901		  if (!sub_separator)
2902		    {
2903		      *invalid_reason =
2904			xasprintf (_("In the directive number %u, '~:[' is not followed by two clauses, separated by '~;'."), spec->directives);
2905		      return false;
2906		    }
2907		  if (sub_list != NULL)
2908		    union_position = sub_position;
2909		  union_list = union (union_list, sub_list);
2910		}
2911
2912		/* Second alternative.  */
2913		{
2914		  int sub_position = position;
2915		  struct format_arg_list *sub_list =
2916		    (list != NULL ? copy_list (list) : NULL);
2917		  if (!parse_upto (formatp, &sub_position, &sub_list, escapep,
2918				   NULL, spec, ']', false,
2919				   invalid_reason))
2920		    return false;
2921		  if (sub_list != NULL)
2922		    {
2923		      if (union_position == -2)
2924			union_position = sub_position;
2925		      else if (sub_position < 0
2926			       || sub_position != union_position)
2927			union_position = -1;
2928		    }
2929		  union_list = union (union_list, sub_list);
2930		}
2931
2932		format = *formatp;
2933		escape = *escapep;
2934
2935		if (union_position != -2)
2936		  position = union_position;
2937		if (list != NULL)
2938		  free_list (list);
2939		list = union_list;
2940	      }
2941	    else
2942	      {
2943		int arg_position;
2944		int union_position;
2945		struct format_arg_list *union_list;
2946		bool last_alternative;
2947
2948		if (!check_params (&list, paramcount, params, 1, I,
2949				   spec->directives, invalid_reason))
2950		  return false;
2951
2952		/* If there was no first parameter, an argument is consumed.  */
2953		arg_position = -1;
2954		if (!(paramcount >= 1 && params[0].type != PT_NIL))
2955		  if (position >= 0)
2956		    {
2957		      arg_position = position;
2958		      add_req_type_constraint (&list, position++, FAT_OBJECT);
2959		    }
2960
2961		*formatp = format;
2962		*escapep = escape;
2963
2964		union_position = -2;
2965		union_list = NULL;
2966		last_alternative = false;
2967		for (;;)
2968		  {
2969		    /* Next alternative.  */
2970		    int sub_position = position;
2971		    struct format_arg_list *sub_list =
2972		      (list != NULL ? copy_list (list) : NULL);
2973		    int sub_separator = 0;
2974		    if (!parse_upto (formatp, &sub_position, &sub_list, escapep,
2975				     &sub_separator, spec, ']', !last_alternative,
2976				     invalid_reason))
2977		      return false;
2978		    /* If this alternative is chosen, the argument arg_position
2979		       is an integer, namely the index of this alternative.  */
2980		    if (!last_alternative && arg_position >= 0)
2981		      add_req_type_constraint (&sub_list, arg_position,
2982					       FAT_INTEGER);
2983		    if (sub_list != NULL)
2984		      {
2985			if (union_position == -2)
2986			  union_position = sub_position;
2987			else if (sub_position < 0
2988				 || sub_position != union_position)
2989			  union_position = -1;
2990		      }
2991		    union_list = union (union_list, sub_list);
2992		    if (sub_separator == 2)
2993		      last_alternative = true;
2994		    if (!sub_separator)
2995		      break;
2996		  }
2997		if (!last_alternative)
2998		  {
2999		    /* An implicit default alternative.  */
3000		    if (union_position == -2)
3001		      union_position = position;
3002		    else if (position < 0 || position != union_position)
3003		      union_position = -1;
3004		    if (list != NULL)
3005		      union_list = union (union_list, copy_list (list));
3006		  }
3007
3008		format = *formatp;
3009		escape = *escapep;
3010
3011		if (union_position != -2)
3012		  position = union_position;
3013		if (list != NULL)
3014		  free_list (list);
3015		list = union_list;
3016	      }
3017	    break;
3018
3019	  case ']': /* 22.3.7.3 FORMAT-CONDITIONAL-END */
3020	    if (terminator != ']')
3021	      {
3022		*invalid_reason =
3023		  xasprintf (_("Found '~%c' without matching '~%c'."), ']', '[');
3024		return false;
3025	      }
3026	    if (!check_params (&list, paramcount, params, 0, NULL,
3027			       spec->directives, invalid_reason))
3028	      return false;
3029	    *formatp = format;
3030	    *positionp = position;
3031	    *listp = list;
3032	    *escapep = escape;
3033	    return true;
3034
3035	  case '{': /* 22.3.7.4 FORMAT-ITERATION */
3036	    if (!check_params (&list, paramcount, params, 1, I,
3037			       spec->directives, invalid_reason))
3038	      return false;
3039	    *formatp = format;
3040	    {
3041	      int sub_position = 0;
3042	      struct format_arg_list *sub_list = make_unconstrained_list ();
3043	      struct format_arg_list *sub_escape = NULL;
3044	      struct spec sub_spec;
3045	      sub_spec.directives = 0;
3046	      sub_spec.list = sub_list;
3047	      if (!parse_upto (formatp, &sub_position, &sub_list, &sub_escape,
3048			       NULL, &sub_spec, '}', false,
3049			       invalid_reason))
3050		return false;
3051	      spec->directives += sub_spec.directives;
3052
3053	      /* If the sub-formatstring is empty, except for the terminating
3054		 ~} directive, a formatstring argument is consumed.  */
3055	      if (*format == '~' && sub_spec.directives == 1)
3056		if (position >= 0)
3057		  add_req_type_constraint (&list, position++, FAT_FORMATSTRING);
3058
3059	      if (colon_p)
3060		{
3061		  /* Each iteration uses a new sublist.  */
3062		  struct format_arg_list *listlist;
3063
3064		  /* ~{ catches ~^.  */
3065		  sub_list = union (sub_list, sub_escape);
3066
3067		  listlist = make_repeated_list_of_lists (sub_list);
3068
3069		  sub_list = listlist;
3070		}
3071	      else
3072		{
3073		  /* Each iteration's arguments are all concatenated in a
3074		     single list.  */
3075		  struct format_arg_list *looplist;
3076
3077		  /* FIXME: This is far from correct.  Test cases:
3078		     abc~{~^~}
3079		     abc~{~S~^~S~}
3080		     abc~{~D~^~C~}
3081		     abc~{~D~^~D~}
3082		     abc~{~D~^~S~}
3083		     abc~{~D~^~C~}~:*~{~S~^~D~}
3084		   */
3085
3086		  /* ~{ catches ~^.  */
3087		  sub_list = union (sub_list, sub_escape);
3088
3089		  if (sub_list == NULL)
3090		    looplist = make_empty_list ();
3091		  else
3092		    if (sub_position < 0 || sub_position == 0)
3093		      /* Too hard to track the possible argument types
3094			 when the iteration is performed 2 times or more.
3095			 So be satisfied with the constraints of executing
3096			 the iteration 1 or 0 times.  */
3097		      looplist = make_union_with_empty_list (sub_list);
3098		    else
3099		      looplist = make_repeated_list (sub_list, sub_position);
3100
3101		  sub_list = looplist;
3102		}
3103
3104	      if (atsign_p)
3105		{
3106		  /* All remaining arguments are used.  */
3107		  if (list != NULL && position >= 0)
3108		    {
3109		      shift_list (sub_list, position);
3110		      list = make_intersected_list (list, sub_list);
3111		    }
3112		  position = -1;
3113		}
3114	      else
3115		{
3116		  /* The argument is a list.  */
3117		  if (position >= 0)
3118		    add_req_listtype_constraint (&list, position++,
3119						 FAT_LIST, sub_list);
3120		}
3121	    }
3122	    format = *formatp;
3123	    break;
3124
3125	  case '}': /* 22.3.7.5 FORMAT-ITERATION-END */
3126	    if (terminator != '}')
3127	      {
3128		*invalid_reason =
3129		  xasprintf (_("Found '~%c' without matching '~%c'."), '}', '{');
3130		return false;
3131	      }
3132	    if (!check_params (&list, paramcount, params, 0, NULL,
3133			       spec->directives, invalid_reason))
3134	      return false;
3135	    *formatp = format;
3136	    *positionp = position;
3137	    *listp = list;
3138	    *escapep = escape;
3139	    return true;
3140
3141	  case '^': /* 22.3.9.2 FORMAT-UP-AND-OUT */
3142	    if (!check_params (&list, paramcount, params, 3, THREE,
3143			       spec->directives, invalid_reason))
3144	      return false;
3145	    if (position >= 0 && list != NULL && is_required (list, position))
3146	      /* This ~^ can never be executed.  Ignore it.  */
3147	      break;
3148	    if (list != NULL)
3149	      {
3150		struct format_arg_list *this_escape = copy_list (list);
3151		if (position >= 0)
3152		  this_escape = add_end_constraint (this_escape, position);
3153		escape = union (escape, this_escape);
3154	      }
3155	    if (position >= 0)
3156	      list = add_required_constraint (list, position);
3157	    break;
3158
3159	  case ';': /* 22.3.9.1 FORMAT-SEPARATOR */
3160	    if (!separator)
3161	      {
3162		*invalid_reason =
3163		  xasprintf (_("In the directive number %u, '~;' is used in an invalid position."), spec->directives);
3164		return false;
3165	      }
3166	    if (terminator == '>')
3167	      {
3168		if (!check_params (&list, paramcount, params, 1, I,
3169				   spec->directives, invalid_reason))
3170		   return false;
3171	      }
3172	    else
3173	      {
3174		if (!check_params (&list, paramcount, params, 0, NULL,
3175				   spec->directives, invalid_reason))
3176		   return false;
3177	      }
3178	    *formatp = format;
3179	    *positionp = position;
3180	    *listp = list;
3181	    *escapep = escape;
3182	    *separatorp = (colon_p ? 2 : 1);
3183	    return true;
3184
3185	  default:
3186	    --format;
3187	    *invalid_reason =
3188	      (*format == '\0'
3189	       ? INVALID_UNTERMINATED_DIRECTIVE ()
3190	       : INVALID_CONVERSION_SPECIFIER (spec->directives, *format));
3191	    return false;
3192	  }
3193
3194	free (params);
3195      }
3196
3197  *formatp = format;
3198  *positionp = position;
3199  *listp = list;
3200  *escapep = escape;
3201  if (terminator != '\0')
3202    {
3203      *invalid_reason =
3204	xasprintf (_("Found '~%c' without matching '~%c'."), terminator - 1, terminator);
3205      return false;
3206    }
3207  return true;
3208}
3209
3210
3211/* ============== Top level format string handling functions ============== */
3212
3213static void *
3214format_parse (const char *format, bool translated, char **invalid_reason)
3215{
3216  struct spec spec;
3217  struct spec *result;
3218  int position = 0;
3219  struct format_arg_list *escape;
3220
3221  spec.directives = 0;
3222  spec.list = make_unconstrained_list ();
3223  escape = NULL;
3224
3225  if (!parse_upto (&format, &position, &spec.list, &escape,
3226		   NULL, &spec, '\0', false,
3227		   invalid_reason))
3228    /* Invalid format string.  */
3229    return NULL;
3230
3231  /* Catch ~^ here.  */
3232  spec.list = union (spec.list, escape);
3233
3234  if (spec.list == NULL)
3235    {
3236      /* Contradictory argument type information.  */
3237      *invalid_reason =
3238	xstrdup (_("The string refers to some argument in incompatible ways."));
3239      return NULL;
3240    }
3241
3242  /* Normalize the result.  */
3243  normalize_list (spec.list);
3244
3245  result = (struct spec *) xmalloc (sizeof (struct spec));
3246  *result = spec;
3247  return result;
3248}
3249
3250static void
3251format_free (void *descr)
3252{
3253  struct spec *spec = (struct spec *) descr;
3254
3255  free_list (spec->list);
3256}
3257
3258static int
3259format_get_number_of_directives (void *descr)
3260{
3261  struct spec *spec = (struct spec *) descr;
3262
3263  return spec->directives;
3264}
3265
3266static bool
3267format_check (void *msgid_descr, void *msgstr_descr, bool equality,
3268	      formatstring_error_logger_t error_logger,
3269	      const char *pretty_msgstr)
3270{
3271  struct spec *spec1 = (struct spec *) msgid_descr;
3272  struct spec *spec2 = (struct spec *) msgstr_descr;
3273  bool err = false;
3274
3275  if (equality)
3276    {
3277      if (!equal_list (spec1->list, spec2->list))
3278	{
3279	  if (error_logger)
3280	    error_logger (_("format specifications in 'msgid' and '%s' are not equivalent"),
3281			  pretty_msgstr);
3282	  err = true;
3283	}
3284    }
3285  else
3286    {
3287      struct format_arg_list *intersection =
3288	make_intersected_list (copy_list (spec1->list),
3289			       copy_list (spec2->list));
3290
3291      if (!(intersection != NULL
3292	    && (normalize_list (intersection),
3293		equal_list (intersection, spec2->list))))
3294	{
3295	  if (error_logger)
3296	    error_logger (_("format specifications in '%s' are not a subset of those in 'msgid'"),
3297			  pretty_msgstr);
3298	  err = true;
3299	}
3300    }
3301
3302  return err;
3303}
3304
3305
3306struct formatstring_parser formatstring_scheme =
3307{
3308  format_parse,
3309  format_free,
3310  format_get_number_of_directives,
3311  format_check
3312};
3313
3314
3315/* ============================= Testing code ============================= */
3316
3317#undef union
3318
3319#ifdef TEST
3320
3321/* Test program: Print the argument list specification returned by
3322   format_parse for strings read from standard input.  */
3323
3324#include <stdio.h>
3325#include "getline.h"
3326
3327static void print_list (struct format_arg_list *list);
3328
3329static void
3330print_element (struct format_arg *element)
3331{
3332  switch (element->presence)
3333    {
3334    case FCT_REQUIRED:
3335      break;
3336    case FCT_OPTIONAL:
3337      printf (". ");
3338      break;
3339    default:
3340      abort ();
3341    }
3342
3343  switch (element->type)
3344    {
3345    case FAT_OBJECT:
3346      printf ("*");
3347      break;
3348    case FAT_CHARACTER_INTEGER_NULL:
3349      printf ("ci()");
3350      break;
3351    case FAT_CHARACTER_NULL:
3352      printf ("c()");
3353      break;
3354    case FAT_CHARACTER:
3355      printf ("c");
3356      break;
3357    case FAT_INTEGER_NULL:
3358      printf ("i()");
3359      break;
3360    case FAT_INTEGER:
3361      printf ("i");
3362      break;
3363    case FAT_REAL:
3364      printf ("r");
3365      break;
3366    case FAT_COMPLEX:
3367      printf ("C");
3368      break;
3369    case FAT_LIST:
3370      print_list (element->list);
3371      break;
3372    case FAT_FORMATSTRING:
3373      printf ("~");
3374      break;
3375    default:
3376      abort ();
3377    }
3378}
3379
3380static void
3381print_list (struct format_arg_list *list)
3382{
3383  unsigned int i, j;
3384
3385  printf ("(");
3386
3387  for (i = 0; i < list->initial.count; i++)
3388    for (j = 0; j < list->initial.element[i].repcount; j++)
3389      {
3390	if (i > 0 || j > 0)
3391	  printf (" ");
3392	print_element (&list->initial.element[i]);
3393      }
3394
3395  if (list->repeated.count > 0)
3396    {
3397      printf (" |");
3398      for (i = 0; i < list->repeated.count; i++)
3399	for (j = 0; j < list->repeated.element[i].repcount; j++)
3400	  {
3401	    printf (" ");
3402	    print_element (&list->repeated.element[i]);
3403	  }
3404    }
3405
3406  printf (")");
3407}
3408
3409static void
3410format_print (void *descr)
3411{
3412  struct spec *spec = (struct spec *) descr;
3413
3414  if (spec == NULL)
3415    {
3416      printf ("INVALID");
3417      return;
3418    }
3419
3420  print_list (spec->list);
3421}
3422
3423int
3424main ()
3425{
3426  for (;;)
3427    {
3428      char *line = NULL;
3429      size_t line_size = 0;
3430      int line_len;
3431      char *invalid_reason;
3432      void *descr;
3433
3434      line_len = getline (&line, &line_size, stdin);
3435      if (line_len < 0)
3436	break;
3437      if (line_len > 0 && line[line_len - 1] == '\n')
3438	line[--line_len] = '\0';
3439
3440      invalid_reason = NULL;
3441      descr = format_parse (line, false, &invalid_reason);
3442
3443      format_print (descr);
3444      printf ("\n");
3445      if (descr == NULL)
3446	printf ("%s\n", invalid_reason);
3447
3448      free (invalid_reason);
3449      free (line);
3450    }
3451
3452  return 0;
3453}
3454
3455/*
3456 * For Emacs M-x compile
3457 * Local Variables:
3458 * compile-command: "/bin/sh ../libtool --mode=link gcc -o a.out -static -O -g -Wall -I.. -I../lib -I../intl -DHAVE_CONFIG_H -DTEST format-scheme.c ../lib/libgettextlib.la"
3459 * End:
3460 */
3461
3462#endif /* TEST */
3463