/*
 * Copyright (c) 2002, The Tendra Project <http://www.ten15.org/>
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice unmodified, this list of conditions, and the following
 *    disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 *
 *    		 Crown Copyright (c) 1997
 *
 *    This TenDRA(r) Computer Program is subject to Copyright
 *    owned by the United Kingdom Secretary of State for Defence
 *    acting through the Defence Evaluation and Research Agency
 *    (DERA).  It is made available to Recipients with a
 *    royalty-free licence for its use, reproduction, transfer
 *    to other parties and amendment for any purpose not excluding
 *    product development provided that any such use et cetera
 *    shall be deemed to be acceptance of the following conditions:-
 *
 *        (1) Its Recipients shall ensure that this Notice is
 *        reproduced upon any copies or amended versions of it;
 *
 *        (2) Any amended version of it shall be clearly marked to
 *        show both the nature of and the organisation responsible
 *        for the relevant amendment or amendments;
 *
 *        (3) Its onward transfer from a recipient to another
 *        party shall be deemed to be that party's acceptance of
 *        these conditions;
 *
 *        (4) DERA gives no warranty or assurance as to its
 *        quality or suitability for any purpose and DERA accepts
 *        no liability whatsoever in relation to any use to which
 *        it may be put.
 *
 * $TenDRA: tendra/src/tools/disp/sort.c,v 1.11 2005/11/05 12:03:15 stefanf Exp $
 */


#include "config.h"
#include "fmm.h"
#include "msgcat.h"
#include "tdf_types.h"
#include "tdf_stream.h"

#include "types.h"
#include "ascii.h"
#include "basic.h"
#include "binding.h"
#include "capsule.h"
#include "file.h"
#include "sort.h"
#include "tree.h"
#include "tdf.h"
#include "unit.h"


/*
 *    WARN ABOUT UNDECLARED TOKENS
 */

BoolT warn_undeclared = FALSE;


/*
 *    DECODING TOKENS
 *
 *    Simple TOKENs are represented by TDF integers.  They may also be
 *    tokenised themselves.
 */

object *
de_token_aux(sortname s, char *nm)
{
	word *w;
	long bits, t;
	object *obj = null;
	int ap = 1, simple = 1;
	int just_tok = (s == sort_unknown ? 1 : 0);

	/* Find the token number */
	long n = de_token ();
	if (n == token_make_tok) {
		t = tdf_int ();
	} else {
		simple = 0;
	}

	/* Look up simple tokens */
	if (simple) {
		SET (t);
		obj = find_binding (crt_binding, var_token, t);
		if (obj == null) {
			obj = new_object (var_token);
			set_binding (crt_binding, var_token, t, obj);
		}

		/* Check token sort */
		if (res_sort (obj) == sort_unknown) {
			sortname is = implicit_sort (obj);
			if (is == sort_unknown && warn_undeclared) {
				MSG_token_used_before_it_is_declared (
							 object_name (var_token, t));
			}
			if (is != sort_unknown && is != s) {
				sortid es;
				out ("<error>");
				es = find_sort (s);
				MSG_implicit_sort_error (
							 object_name (var_token, t), es.name);
			}
			implicit_sort (obj) = s;
		} else if (res_sort (obj) != s && !just_tok) {
			sortid es;
			out ("<error>");
			es = find_sort (s);
			MSG_sort_error (object_name (var_token, t), es.name);
		}

		/* Output token name if appropriate */
		if (!dumb_mode) {
			if (obj->named) {
				if (obj->name.simple) {
					out_string (obj->name.val.str);
					ap = 0;
				}
			} else {
				char buff [50];
				IGNORE sprintf (buff, "~token_%ld", obj->id);
				out_string (buff);
				ap = 0;
			}
		}
	}

	/* Output "apply_token" if appropriate */
	if (ap) {
		if (just_tok) {
			out_string ("make_token");
		} else {
			out_string ("apply_");
			out_string (nm);
			out_string ("_token");
		}
		w = new_word (VERT_BRACKETS);
		if (simple) {
			SET (t);
			out_object (t, obj, var_token);
		} else {
			if (n == token_token_apply_token) {
				object *subobj = de_token_aux (sort_token, "token");
				if (subobj) obj = subobj->aux;
			} else {
				/* use_tokdef */
				long len = tdf_int ();
				tdf_skip_bits (tdfr, len);
				out_string ("use_tokdef(....)");
				IGNORE new_word (SIMPLE);
			}
		}
	} else {
		/* Applications of named tokens are indicated by "*" */
		out_string ("*");
	}

	/* Quit here if just reading token */
	if (just_tok) {
		if (ap) {
			SET (w);
			end_word (w);
		} else {
			IGNORE new_word (SIMPLE);
		}
		return (obj);
	}

	/* Read length of token arguments */
	bits = tdf_int ();

	/* Deal with tokens without arguments */
	if (bits == 0) {
		if (obj && res_sort (obj) != sort_unknown) {
			char *ps = arg_sorts (obj);
			if (ps && *ps) {
				if (simple) {
					SET (t);
					MSG_token_arguments_missing_token (
								 object_name (var_token, t));
				} else {
					MSG_token_arguments_missing ();
				}
			}
		}
		if (ap) {
			SET (w);
			end_word (w);
		} else {
			IGNORE new_word (SIMPLE);
		}
		return (obj);
	}

	/* Deal with tokens with arguments */
	if (obj && res_sort (obj) != sort_unknown && !is_foreign (obj)) {
		/* Known token - decode arguments */
		if (arg_sorts (obj)) {
			tdf_pos pos;

			pos = tdf_stream_tell (tdfr);
			if (!ap) w = new_word (VERT_BRACKETS);
			decode (arg_sorts (obj));
			if (tdf_stream_tell(tdfr) != pos + bits) {
				if (simple) {
					SET (t);
					MSG_token_arguments_length_wrong_token (
								 object_name (var_token, t));
				} else {
					MSG_token_arguments_length_wrong ();
				}
			}
		} else {
			if (ap) {
				SET (w);
				end_word (w);
			} else {
				IGNORE new_word (SIMPLE);
			}
			return (obj);
		}
	} else {
		/* Unknown token - step over arguments */
		if (!ap) w = new_word (VERT_BRACKETS);
		out ("....");
		tdf_skip_bits (tdfr, bits);
	}
	SET (w);
	end_word (w);
	return (obj);
}


/*
 *    DECODING SIMPLE LABELS
 */

void
de_make_label(long lab_no)
{
	if (dumb_mode) {
		word *w;
		out_string ("label");
		w = new_word (HORIZ_BRACKETS);
		out_int (lab_no);
		end_word (w);
	} else {
		out_string ("~label_");
		out_int (lab_no);
	}
	if (lab_no < 0 || lab_no >= max_lab_no) {
		MSG_label_number_out_of_range (lab_no);
	}
	return;
}


/*
 *    FORMATTING SIZE FOR TDF STRINGS
 *
 *    A string will be split by de_format_string into sections of length
 *    at most STRING_WIDTH.
 */

#define STRING_WIDTH		40


/*
 *    DECODING FORMATTED STRINGS
 *
 *    A TDF string is read and output in a formatted form.
 */

void
de_tdfstring_format(void)
{
	TDFSTRING ts;
	word *ptr1;
	size_t n;
	char *s;

	tdf_de_tdfstring(tdfr, &ts);

	if (ts.size != 8) {
		char sbuff [100];
		IGNORE sprintf (sbuff, "make_string_%ld", (long)ts.size);
		out_string (sbuff);
		ptr1 = new_word (HORIZ_BRACKETS);
	}
	if (ts.size > 8) {
		TDFINTL i;
		for (i = 0; i < ts.number; i++)
			out_int (ts.ints.longs[i]);
	} else {
		s = tdf_string_format (&ts);
		n = strlen (s);
		if (n == 0) {
			out ("\"\"");
			return;
		}
		while (n) {
			size_t m = (n < STRING_WIDTH ? n : STRING_WIDTH);
			char *w = xmalloc_nof (char, m + 3);
			IGNORE memcpy (w + 1, s, (size_t) m);
			w [0] = QUOTE;
			w [m + 1] = QUOTE;
			w [m + 2] = 0;
			out (w);
			n -= m;
			s += m;
		}
	}
	if (ts.size != 8) {
		SET (ptr1);
		end_word (ptr1);
	}
	if (ts.number)
		xfree (ts.ints.chars);
	return;
}


/*
 *    DECODING THE EXP "solve" (OR "labelled")
 *
 *    This is tricky because it is encoded as :
 *
 *		    A1, ..., An, B, C1, ..., Cn
 *
 *    where n is a TDF integer, Ai is given by the decode string str1,
 *    B is given by str2, and Ci is given by str3, but we want to print
 *    it in the order :
 *
 *		      B, A1, C1, ..., An, Cn
 *
 *    so there is a certain amount of to-ing and fro-ing.
 */

void
de_solve_fn(char *nm, char *str1, char *str2, char *str3, int ntwice)
{
	long i, n;
	word *ptr1, *ptr2;
	tdf_pos posn1, posn2;

	int tempflag = printflag;

	out_string (nm);
	ptr1 = new_word (VERT_BRACKETS);

	/* Read the number of statements A1, ..., An */
	check_list ();
	n = tdf_int ();

	/* Record the position of A1 */
	posn1 = tdf_stream_tell (tdfr);

	/* Step over A1, ..., An */
	printflag = 0;
	for (i = 0; i < n; i++) decode (str1);
	printflag = tempflag;

	/* Decode B */
	decode (str2);

	if (ntwice) {
		/* Read and check the number of statements C1, ..., Cn */
		long m;
		check_list ();
		m = tdf_int ();
		if (m != n) MSG_illegal_construct (nm);
	}

	for (i = 0; i < n; i++) {
		ptr2 = new_word (VERT_BRACKETS);

		/* Record the position of Ci */
		posn2 = tdf_stream_tell (tdfr);

		/* Go back and read Ai */
		tdf_stream_seek(tdfr, posn1);
		decode (str1);

		/* Record the position of A(i+1) */
		posn1 = tdf_stream_tell (tdfr);

		/* Go forward and read Ci */
		tdf_stream_seek(tdfr, posn2);
		decode (str3);

		end_word (ptr2);
	}
	end_word (ptr1);
	return;
}


/*
 *    DECODING THE EXP "case"
 *
 *    Only the layout makes this a special case.  The general form is :
 *
 *		      A, L1, B1, ..., Ln, Bn
 *
 *    where A is given by the decode string str1, Li is a label and Bi
 *    is given by str2.
 */

void
de_case_fn(char *nm, char *str1, char *str2)
{
	long i, n;
	word *ptr1, *ptr2, *ptr3;

	out_string (nm);
	ptr1 = new_word (VERT_BRACKETS);
	decode (str1);
	ptr2 = new_word (VERT_BRACKETS);
	check_list ();
	n = tdf_int ();
	for (i = 0; i < n; i++) {
		ptr3 = new_word (HORIZ_NONE);
		IGNORE de_label ();
		out (":");
		format (HORIZ_BRACKETS, "", str2);
		end_word (ptr3);
	}
	end_word (ptr2);
	end_word (ptr1);
	return;
}


/*
 *    DECODING THE EXP "make_proc"
 *
 *    The general form is :
 *
 *			A, B1, ..., Bn, C
 *
 *    where A is given by the decode string str1, B by str2 and C by str3.
 *    However each Bi is grouped as a "make_proc_arg".
 */

void
de_mk_proc_fn(char *nm, char *str1, char *str2, char *str3)
{
	long i, n;
	word *ptr;
	out_string (nm);
	ptr = new_word (VERT_BRACKETS);
	decode (str1);
	check_list ();
	n = tdf_int ();
	if (n == 0) {
		out ("empty");
	} else {
		for (i = 0; i < n; i++) {
			out_string (nm);
			format (VERT_BRACKETS, "_arg", str2);
		}
	}
	decode (str3);
	end_word (ptr);
	return;
}