/*
 * $Id: trans.eden,v 1.1 2002/02/27 16:28:29 cssbz Exp $
 */

/* trans.e - this file contains the six scripts utils.e, blocks.e,
   ops.e, agents.e, parsers.e and program.e collected into one script.

   It is automatically included from the lib-tkeden directory by the
   tkeden translator code.

   Chris Brown, 2000.

 */


/* utils.e - contains utility functions */

varcount = 0;

func makevarname {
    return "var_" // str (varcount++);
}

func getvar {
	para instr;
	tempvr = "ERROR";
	execute ("tempvr = " // instr // ";");
	return tempvr;
}

func isdefined {
    para x;
    auto i;
    if (x == @)
        return 0;

    if (type  (x) == "list")
        for (i = 1; i <= x#; i++)
            if (!isdefined (x [i]))
                return 0;

    return 1;
}

func make_str {
    para data;
    auto outstr, i;

    if (type (data) != "list")
        return str (data);

    if (data# < 1)
        return "[]";

    if (type (data [1]) == "string")
        outstr = "[\"" // str (data [1]) // "\"";
    else
        outstr = "[" // make_str (data [1]);

    for (i = 2; i <= data#; i++)
        if (type (data [i]) == "string")
            outstr = outstr // ", \"" // str(data [i]) // "\"";
        else
            outstr = outstr // ", " // make_str (data [i]);

    return outstr // "]";
}

func stripspace {
    para instr;
    auto begin, end;
    
    if (instr == "")
        return "";
    
    begin = 1;
    while (begin <= instr# && issp (instr[begin])) begin++;

    end = instr#;
    while (end >= 0 && issp (instr[end])) end--;

    return substr (instr, begin, end);
}

func isspace {
    para instr;
    auto i;
    for (i = 1; i <= instr#; i++)
        if (!issp (instr [i]))
	    return 0;

    return 1;
}

func issp {
    para c;
    return (c == ' ' || c == '\t' || c == '\n' || c == '\r');
}

func escapequotes {
    para instr;
    auto i, outstr;
    outstr = "";

    for (i = 1; i <= instr#; i++) {
        if (instr [i] == '"')
	    outstr = outstr // str('\\');

        outstr = outstr // str(instr [i]);
    }

    return outstr;
}

func issuffix {
	para instr, suffix;
	auto i;

	if (instr# < suffix#)
		return 0;

	for (i = 0; i < suffix#; i++)
		if (instr [instr# - i] != suffix [suffix# - i])
			return 0;

	return 1;
}

func tail {
	para inlist;
	auto ret, i;
	ret = [];
	for (i = 2; i <= inlist#; i++)
		ret = ret // [inlist [i]];

	return ret;
}

func cutquotes {
    para instr;
    auto i, outstr;
    outstr = "";

    for (i = 1; i <= instr#; i++)
        if (instr [i] != '"')
            outstr = outstr // str(instr [i]);

    return outstr;
}

func applytoeach {
    para f, l;
    auto i, result;

    result = [];

    for (i = 1; i <= l#; i++)
        result = result // [f (l [i])];

    return result;
}

func getline {
    auto result, c;

    result = "";

    while ((c = getchar ()) != 10)
        result = result // char (c);

    return result;
}

func _str {
    return "\"" // $1 // "\"";
}

func isdigit {
	para sym;
	return ('0' <= sym && sym <= '9');
}

func ischar {
	para sym;
	return (('A' <= sym && sym <= 'Z') || ('a' <= sym && sym <= 'z'));
}

func isalphanum {
	para c;
	return (ischar (c) || isdigit (c) || (c == '_'));
}	

func converttonum {
	para instr;
	auto i, radix, sum;
	i = instr#;
	radix = 1;
	sum = 0;

	while (i >= 1) {
		if (!isdigit(instr [i]) && (instr [i] != ' '))
			return instr;

		if (isdigit (instr [i])) {
			sum += ((instr [i] - '0') * radix);
			radix = radix * 10;
		}
		
		i--;
	}

	return sum;
}


/* blocks.e - contains functions for string searching while ignoring blocks */

/* list of all registered blocks */
scope_blocks = [];

/* function to register blocks */
proc addblocks {
    scope_blocks = scope_blocks // $;
}


/* some built-in blocks */
bras = [["(", ")"], ["bras"]];
sq_bras = [["[", "]"], ["sq_bras"]];

addblocks ("bras", "sq_bras");

/* find
   instr: a string
   str: a string
   start: an index into instr
   returns: the index of the first occurrence of str in instr after start
*/

func find {
	para instr, str, start;
	auto i, j, flag;
	
	for (i = start; i <= instr# - str# + 1; i++) {
		flag = 1;

		for (j = 1; j <= str# && flag == 1; j++)
			if (str[j] != instr[i + j - 1])
				flag = 0;

		if (flag == 1)
			return i;
	}

	return 0;
}


/* findfirst
   instr: a string
   strings: a list of strings
   start: an index into instr
   returns: the element of strings that first occurs
       (after index start) in instr together with its index
*/
func findfirst {
	para instr, strings, start;
	auto i, j, string, position;

	string = "";
	position = 0;
	
	for (i = 1; i <= strings#; i++) {
		j = find (instr, strings [i], start);
		if (j == 0)
			continue;

		if (j < position || position == 0) {
			position = j;
			string = strings [i];
		}
	}

	return [string, position];
}


/* to search while ignoring blocks, a stack is maintained of the symbols
   that we are looking for
   thestack = [";", ["var"]], [..], .. [symbol to find, [symbols to ignore]]
*/

proc emptystack {
	thestack = [];
	pointer = 0;
}

proc push {
	para item;
	pointer++;

	if (pointer > thestack#)
		thestack = thestack // [item];
	else
		thestack [pointer] = item;
}

func pop {
	if (pointer < 1)
		return [];

	pointer--;
	return thestack [pointer + 1];
}


/* getblockfromstartsym
   instr: the starting symbol of a block
   returns: the block with this starting symbol
*/
func getblockfromstartsym {
	para instr;
	auto i, b;
	
	for (i = 1; i <= scope_blocks#; i++) {
		b = getvar (scope_blocks [i]);
		if (b [1][1] == instr)
			return b;
	}

	writeln ("unknown block \"" // instr // "\"");
	return [];
}

/* getblockfromname
   name: the name of a block
   returns: the block, if it is a block, otherwise []
*/
func getblockfromname {
	para name;
	auto b;

	b = getvar (name);
	if (b# != 2 || b[1]# < 2) {
		writeln ("unknown block \"" // name // "\"");
		return [];
	} else
		return b;
}


/* getstartsyms
   blocks: a list of block names
   returns: a list containing the start symbol for each block
*/
func getstartsyms {
	para blocks;
	auto i, b, out;

	out = [];

	for (i = 1; i <= blocks#; i++) {
		b = getblockfromname (blocks [i]);
		if (b != [])
			out = out // [b [1][1]];
	}

	return out;
}


/* extract - major export
   instr: a string
   match: a string
   ignore: a list of block names
   start: an index into instr
   returns: the first occurrence in instr after start of match
   that is not within any of the blocks in ignore
*/
func extract {
	para instr, match, ignore, start;
	auto pos, first, new_symbol, old_symbol, cur_match, cur_ignore, i;

    /* cur_match stores the string we are looking for
       cur_ignore stores the strings that mark the start
       of the blocks that we want to ignore */
	pos = start;
	cur_match = match;
	cur_ignore = getstartsyms (ignore);
	emptystack ();

	while (1) {
	    /* search for the string we are looking for and also the symbols to ignore */
		first = findfirst (instr, [cur_match] // cur_ignore, pos);
		/* nothing found */
		if (first == ["", 0])
			return 0;

        /* position to start from is set to after that which we have just read */
		pos = first [2] + first [1]#;

        /* if we encountered a block we are ignoring */
		if (first [1] != cur_match) {
		    /* save what we were looking for */
			push ([cur_match, cur_ignore]);

            /* find the block's end symbol and start looking for it*/
			new_symbol = getblockfromstartsym (first [1]);
			if (new_symbol == [])
				return 0;

			/* might have to match more than 2 symbols, e.g proc ; ; not just proc ; */

			cur_match = new_symbol [1][2];
			cur_ignore = getstartsyms (new_symbol [2]);

            /* save the additional symbols to be found later */
			for (i = new_symbol[1]#; i > 2; i--)
				push ([new_symbol [1][i], cur_ignore]);

		} else {
		    /* we found what we were looking for */
            /* find out the last thing we were looking for,
               before we were interrupted */
			old_symbol = pop ();

			if (old_symbol == []) {
			    /* this is what we started off looking for, and it  is found*/
				return (first [2]);
			} else {
		        /* there is more to find, continue looking */
		        cur_match = old_symbol [1];
				cur_ignore = old_symbol [2];
			}
		}
	}
}


/* ops.e - implements the string operations that an agent can perform */

/* pivot finds a sub-string, ignoring given blocks, and returns the
   sub-strings on either side of it */
func pivot {
	para instr, pivot, ignore;
	auto i;

	i = extract (instr, pivot, ignore, 1);
	if (i == 0)
		return [];
	else
		return [substr (instr, 1, i - 1), substr (instr, i + pivot#, instr#)];
}

/* rev_pivot is pivot but searches from the end of the string backwards */
func rev_pivot {
	para instr, pivot, ignore;
	auto str, i, j;

	i = extract (instr, pivot, ignore, 1);
	if (i == 0)
		return [];

	while (i != 0) {
		j = i;
		i = extract (instr, pivot, ignore, j + pivot#);
	}

	return [substr (instr, 1, j - 1), substr (instr, j + pivot#, instr#)];
}

/* charmatch
   c: a character
   charset: a list of lists, each representing characters to match
   returns: whether c matches any of the lists in charset
*/

func charmatch {
	para c, charset;

    /* one element lists simply contain a character to match */
	if (charset# == 1 && char (c) == char (charset [1]))
		return 1;

	/* two element lists contain an interval of characters */
	if (charset# == 2 && char (c) >= char (charset [1]) && char (c) <= char (charset [2]))
		return 1;

	return 0;
}


/* chars_finite_begin
   instr: a string
   chars: a list of character matches as accepted by charmatch
   count: a number
   returns: the first count characters if they match chars else []
*/

func chars_finite_begin {
	para instr, chars, count;
	auto i, j, match;

	if (count > instr#)
		return [];

	for (i = 1; i <= count; i++) {
            match = 0;

		for (j = 1; j <= chars#; j++)
			if (charmatch (instr [i], chars [j]))
				match = 1;

		if (!match)
			return [];
	}

	return [substr (instr, 1, count), substr (instr, count + 1, instr#)];
}

/* chars_finite_end
   instr: a string
   chars: a list of character matches as accepted by charmatch
   count: a number
   returns: the last count characters if they match chars else []
*/

func chars_finite_end {
	para instr, chars, count;
	auto i, j, match;

	if (count > instr#)
		return [];

	for (i = instr#; i >= instr# - count; i--) {
        	match = 0;

		for (j = 1; j <= chars#; j++)
			if (charmatch (instr [i], chars [j]))
				match = 1;

		if (!match)
			return [];
	}

	return [substr (instr, 1, instr# - count), substr (instr, instr# - count + 1, instr#)];
}


/* chars_begin
   instr: a string
   chars: a list of character matches as accepted by charmatch
   returns: the biggest prefix of instr s.t. all its character match chars
*/

func chars_begin {
	para instr, chars;
	auto i, j;

	i = 1;

	while (i <= instr#) {
        	match = 0;

		for (j = 1; j <= chars#; j++)
			if (charmatch (instr [i], chars [j]))
				match = 1;

		if (!match)
			break;

		i++;
	}

	return [substr (instr, 1, i - 1), substr (instr, i, instr#)];
}

/* chars_end
   instr: a string
   chars: a list of character matches as accepted by charmatch
   returns: the biggest suffix of instr s.t. all its character match chars
*/

func chars_end {
	para instr, chars;
	auto i, j, match;

	i = instr#;

	while (i >= 1) {
        	match = 0;

		for (j = 1; j <= chars#; j++)
			if (charmatch (instr [i], chars [j]))
				match = 1;

		if (!match)
			break;

		i--;
	}

	return [substr (instr, 1, i), substr (instr, i + 1, instr#)];
}


/* read_prefix matches a prefix to a sort of regular expresion
   it returns the prefix found and the remainder */

func read_prefix {
	para instr, chars, count;

	if (chars == []) {
		if (count == "*")
			return [instr, ""];
		else if (count <= instr#)
			return [substr (instr, 1, count), substr (instr, count + 1, instr#)];
		else
			return [];

	} else {
		if (count == "*")
			return chars_begin (instr, chars);
		else
			return chars_finite_begin (instr, chars, count);
	}
}


/* read_suffix matches a suffix to a sort of regular expresion
   it returns the suffix found and the remainder */

func read_suffix {
	para instr, chars, count;

	if (chars == []) {
		if (count == "*")
			return ["", instr];
		else if (count <= instr#)
			return [substr (instr, 1, instr# - count), substr (instr, instr# - count + 1, instr#)];
		else
			return [];

	} else {
		if (count == "*")
			return chars_end (instr, chars);
		else
			return chars_finite_end (instr, chars, count);
	}
}

/* read_all attempts to match a string to a sort of regular expresion
   it returns either the string, or [] if it did not match */

func read_all {
	para instr, chars;
	auto result;

	if (chars == [])
		return [instr];

	result = chars_finite_begin (instr, chars, instr#);

	if (result == [])
		return [];
	else
		return [result [1]];
}


/* prefix checks a string for a literal prefix */

func prefix {
	para instr, prefix;
	auto i;

	if (prefix# > instr#)
		return [];

	for (i = 1; i <= prefix#; i++)
		if (prefix [i] != instr [i])
			return [];

	return [substr (instr, prefix# + 1, instr#)];
}

/* prefix checks a string for a literal prefix */

func suffix {
	para instr, suffix;
	auto i;

	if (suffix# > instr#)
		return [];

	for (i = 0; i < suffix#; i++)
		if (suffix [suffix# - i] != instr [instr# - i])
			return [];

	return [substr (instr, 1, instr# - suffix#)];
}

/* split divides a string into chunks using a separator, ignoring all
       occurrences of the separator within the given blocks */

func split {
	para instr, split, ignore;
	auto i, j, list;

	i = 1;
	list = [];

	while (1) {
		j = extract (instr, split, ignore, i);

		if (j == 0)
			return list // [substr (instr, i, instr#)];

		list = list // [substr (instr, i, j - 1)];
		i = j + split#;
	}
}


/* agents.e - contains functions to perform the actions of an agent */


/* format
   instr: a string containing format specifiers "%%" and "$$",
       e.g. "a + %%"
   plist: a list containing the names of variables
   returns: a list. first element contains the string with instances
       of "%%" replaced by EDEN variable names and instances of "$$"
       replaced by "%%". second element contains the variable names
       corresponding to instances of "$$"
*/

func format {
    para instr, plist;
    auto pcount, outstr, i, varname, varval, literals;

    outstr = "";
    literals = [];
    pcount = 1;

    for(i = 1; i <= instr#; i++) {
        /* check for "%%" */
        if (instr [i] == '%' && instr [i+1] == '%') {
            if (pcount <= plist#) {
                /* get the EDEN variable name */
                varname = getvar (plist [pcount]);
                if (varname != @)
                    outstr = outstr // str (varname);
                else
                    /* undefined */
                    outstr = outstr // "ERROR";

                pcount++;
            } else
                /* not enough variables specified */
                outstr = outstr // "ERROR";

            i++;

        /* check for "$$" */
        } else if (instr [i] == '$' && instr [i+1] == '$') {
            if (pcount <= plist#) {
                /* get the EDEN variable name */
                varname = getvar (plist [pcount]);
/*		writeln (varname);
		writeln (plist [pcount]); */
                if (varname != @)
                    /* add to return list */
                    literals = literals // [str (varname)];
                else
                    literals = literals // ["ERROR"];

                /* replace with "%%" */
                outstr = outstr // "%%";

                pcount++;
            } else
                outstr = outstr // "ERROR";

            i++;

        /* check for "##" */
        } else if (instr [i] == '#' && instr [i+1] == '#') {
            if (pcount <= plist#) {
                /* get the EDEN variable name */
                varname = getvar (plist [pcount]);
                if (varname != @)
                    outstr = outstr // "\"" // escapequotes (str (varname)) // "\"";
                else
                    /* undefined */
                    outstr = outstr // "ERROR";

                pcount++;
            } else
                /* not enough variables specified */
                outstr = outstr // "ERROR";

            i++;

        } else
            /* not a "%%" or a "$$" or a "##" */
            outstr = outstr // str (instr[i]);
    }

    return [outstr, literals];
}


/* operation - performs a string operation
   instr: a string
   op_name: an operation
   op_value: its parameter(s)
   ignore: the blocks to ignore
   returns: the resulting sub-strings and an optional
       extra value returned only by read_begin/end operations
*/

func operation {
    para instr, op_name, op_value, ignore;
    auto result, match;
    match = "";

    switch (op_name) {
    case "prefix":
        result = prefix (instr, op_value);
        break;

    case "suffix":
        result = suffix (instr, op_value);
        break;

    case "pivot":
        result = pivot (instr, op_value, ignore);
        break;

    case "rev_pivot":
        result = rev_pivot (instr, op_value, ignore);
        break;

    case "split":
        result = split (instr, op_value, ignore);
        break;

    case "read_prefix":
        if (type (op_value) != "list" || op_value# < 2)
            return ["badop"];

        result = read_prefix (instr, op_value [1], op_value [2]);

        /* store the actual reg exp matched for possible use and remove it from */
        /* result without removing the unmatched remainder of the string */

        if (result != []) {
            match = result [1];
            result = [result [2]];
        }
        break;

    case "read_suffix":
        if (type (op_value) != "list" || op_value# < 2)
            return ["badop"];

        result = read_suffix (instr, op_value [1], op_value [2]);

        /* store the actual reg exp matched for possible use and remove it from */
        /* result without removing the unmatched remainder of the string */

        if (result != []) {
            match = result [2];
            result = [result [1]];
        }
        break;

    case "read_all":
        result = read_all (instr, op_value);
        break;

    case "literal":
        if (instr != op_value)
            result = [];
        else
            result = [instr];
        break;

    default:
        return ["badop"];
    }

    return [result, match];
}


/* automatically defined script variables */

v_substrs = [];
v_string = "";
v_paras = "";
v_match = "";


/* run_agent - perform an agent's actions
   instr: input string
   templ_name: agent template
   varnames: input variables
   returns: list of lists. for each child:
       [output string, child template, output variables]
*/

func run_agent {
    para instr, templ_name, varnames;
    auto agent, paracount, result, i, ret, op_name, op_value, success_templ, fail_templ, ignore, pass_paras, extra;

    /* load data for agent into local variables */

    agent = getvar (templ_name);
    if (!isdefined (agent))
        return ["undefined"];

    /* check it is a valid agent template */
    if (type (agent) != "list" || agent# < 2)
        return ["badagent"];

    /* get the operation name and value, i.e. pivot and "=" */
    paracount = 1;
    op_name = agent [paracount++];
    op_value = agent [paracount++];

    /* get the agents to create on success */

    if (op_name != "literal" && op_name != "read_all") {
        success_templ = agent [paracount++];
        if (type (success_templ) == "string")
            success_templ = [success_templ];
    } else
        /* literal and read-all operations do not have children */
        success_templ = [];

    ignore = [];
    script = [];
    fail_templ = "";

    /* get tagged values */
    while (paracount <= agent#) {
        /* check this is a valid tag */
        if (type (agent [paracount]) != "list" || agent# < 2)
            return ["badagent"];

        switch (agent [paracount][1]) {
        case "ignore":
            /* blocks to ignore */
            ignore = agent [paracount][2];
            break;

        case "fail":
            /* child to create on failure */
            fail_templ = agent [paracount][2];
            break;

        case "script":
            /* script to run */
            script = [];
            for (i = 2; i <= agent [paracount]#; i++)
                script = script // [agent [paracount][i]];

            break;

        default:
        }

        paracount++;
    }


    /* strip whitespace from beginning and end of string */
    instr = stripspace (instr);

    /* agent data should now be loaded */

    /* perform agent's operation */
    result = operation (instr, op_name, op_value, ignore);

    /* badly formed operation */
    if (result == "badop")
        return ["badagent"];

    /* some operations supply additional information for use by script */

    v_match = result [2];
    result = result [1];

    /* did not match */
    if (result == []) {
        if (fail_templ == "")
            /* if no fail template then parsing has failed */
            return ["fail"];
        else
            /* else pass string, and all variables to next agent */
            return [[instr, fail_templ, varnames]];
    }


    /* did match */

    /* make a child based on success_templ for each of the results from a split operation */

    if (op_name == "split")
        for (i = 1; i < result#; i++)
            success_templ = success_templ // [success_templ [1]];


    /* execute script */

    /* set some variables for use by script instructions */

    v_string = instr;
    v_substrs = result;
    v_paras = varnames;

    pass_paras = execscript (script, success_templ#);

    /* make sure there are parameters for every child */
    while (success_templ# > pass_paras#)
        pass_paras = pass_paras // [[]];

    /* prepare return value with output strings,
        child agents and their parameters */

    ret = [];
    for (i = 1; i <= success_templ#; i++)
        ret = ret // [[result [i], success_templ [i], pass_paras [i]]];

    return ret;
}



/* execscript - runs an agent's script
   n_scriptlist: the script instructions
   n_subcount: the number of children
   returns: the parameters for the children

   the variables all start with t_ or n_ to reduce the chance that a
   script variable will share the same name and mess the function up
*/

laterlist = [];

func execscript {
    para n_scriptlist, n_subcount;
    auto t_i, t_j, t_s, t_format, t_ret, t_paras, t_later, t_script, t_vname1, t_vname2, t_mkstr;
    t_later = [];
    t_ret = [];

    for (t_s = 1; t_s <= n_scriptlist#; t_s++) {
        /* each script instruction */
        t_script = n_scriptlist [t_s];

        switch (t_script [1]) {

        case "declare":
            /* for each script variable, a local EDEN string variable is
               created to hold the name of a persistent, uniquely named
               EDEN variable */

            for (t_i = 2; t_i <= t_script#; t_i++)
                execute (t_script [t_i] // " = \"" // makevarname () // "\";");

            break;

        case "setparas":
            for (t_i = 2; t_i <= t_script#; t_i++) {
                /* ensure the parameters list contains an element for each child */
                while (t_ret# < t_i - 1)
                    t_ret = t_ret // [[]];

                /* add the EDEN variable names of the script variables indicated to
                   the list of each childs parameters */
                for (t_j = 1; t_j <= t_script [t_i]#; t_j++)
                    t_ret [t_i - 1] = t_ret [t_i - 1] // [getvar (t_script [t_i][t_j])];
            }
        break;

        case "allparas":
            if (n_subcount < 1)
                break;

            /* t_vname1 holds the name of the list of all variables */
            t_vname1 = makevarname ();

            /* t_vname2 holds the name of the first parameter variable */
            t_vname2 = makevarname ();

            /* create a script variable with the given name to the list of all variables */
            execute (t_script [2] // " = \"" // t_vname1 // "\";");

            /* start to build up the list of variables */
            t_mkstr = t_vname1 // " is [" // t_vname2;

            /* if there is no list of child parameters yet, initialise one */
            if (t_ret# < 1)
                t_ret = [[t_vname2]];

            /* for each child */
            for (t_i = 2; t_i <= n_subcount; t_i++) {
                /* make a new EDEN variable and add it to the list of variables*/
                t_vname2 = makevarname ();
                t_mkstr = t_mkstr // ", " // t_vname2;

                /* ensure the parameters list contains an element for each child */
                while (t_ret# < t_i)
                    t_ret = t_ret // [[]];

                /* add the new variable to the childs parameter list */
                t_ret [t_i] = t_ret [t_i] // [t_vname2];
            }

            /* create the list of variables */            
            t_mkstr = t_mkstr // "];";
            execute (t_mkstr);
            break;

        case "execute":
            /* extract the variable names */
            t_paras = [];
            for (t_i = 3; t_i <= t_script#; t_i++)
                t_paras = t_paras // [t_script [t_i]];

            /* format once to substitute for "%%"s */
            t_format = format (t_script [2], t_paras);

            /* format again to substitute for "$$"s */
            t_format = format (t_format [1], t_format [2]);

            /* execute command */
            execute (t_format [1]);
            break;

        case "later":
            /* extract the variable names */
            t_paras = [];
            for (t_i = 3; t_i <= t_script#; t_i++)
                t_paras = t_paras // [t_script [t_i]];

            /* format once to substitute for "%%"s but do not substitute
               for "$$"s until later, when the variables will have been defined*/

            t_format = format (t_script [2], t_paras);

            /* save command to be executed later */
            t_later = t_later // [t_format];
            break;

        default:
        }
    }

    /* add commands for later to the global list of things to do later */
    if (t_later != [])
        laterlist = [t_later] // laterlist;

    return t_ret;
}


/* parsers.e - functions that automate the process of creating agents
   to act on strings in order to parse them */

/* removes the first element of a list */

func removehead {
    para listptr;
    auto temp, i, item;

    if (*listptr == [])
        return [];

    temp = [];
    item = (*listptr) [1];

    for (i = 2; i <= (*listptr)#; i++)
        temp = temp // [(*listptr) [i]];

    *listptr = temp;

    return item;
}


/* does the parser say what it is doing?
      0 - quiet
      1 - noisy but fast
      2 - noisy and wait for keypresses at each step
*/

verbose_parser = 0;

/* the main parser - depth first agent execution */

proc quiet_dfparse {
    para instr, start_agent, varnames;
    auto item, children, list, i, j, fstr, correct;

    /* initialise the commands that the agents may ask us to run later*/
    laterlist = [];

    /* initialise the list of agents to be run to the first */
    list = [[instr, start_agent, varnames]];

    /* get the next agent */
    while ((item = removehead (&list)) != []) {
        /* run it */
        children = run_agent (item [1], item [2], item [3]);

        /* make sure it ran ok */
        if (children == ["badagent"]) {
            writeln ("bad agent, \"" // item [2] // "\"");
            return;

        } else if (children == ["undefined"]) {
            writeln ("agent is undefined, \"" // item [2] // "\"");
            return;

        /* correct any syntax errors */
        } else if (children == ["fail"]) {
            writeln ("failed to match string \"" // item [1] // "\" with agent \"" // item [2] // "\"");
            writeln ("enter correct string or q to cancel:");
            correct = getline ();
            writeln ();

            if (correct == "q")
                return;

            list = [[correct, item [2], item [3]]] // list;

        } else {
        /* add its children to the list of agents to be run */
            list = children // list;
        }
    }

    /* execute the later list */

/*writeln ("laterlist");*/
    /* for each agent */
    for (i = 1; i <= laterlist#; i++)
        /* for each command */
        for (j = 1; j <= laterlist[i]#; j++) {
            /* substitute in any variables that have only just been defined */
            fstr = format (laterlist [i][j][1], laterlist [i][j][2]);
            execute (fstr [1]);
        }

    /* reset the later list */
    laterlist = [];
}

/* a parser that prints out lots of information about its agents
   is identical to dfparse except it has writelns and a getchar */

proc verbose_dfparse {
    para instr, start_agent, varnames;
    auto item, children, list, i, j, fstr, correct;

    laterlist = [];

    list = [[instr, start_agent, varnames]];

    while ((item = removehead (&list)) != []) {
        writeln ();
        writeln ("waiting to act:");
        writeln (list);
        writeln ("acting this step:");
        writeln ("string: " // item[1]);
        writeln ("variable names: " // str (item[3]));
        writeln ("agent: " // item[2]);        
        writeln ();

        children = run_agent (item [1], item [2], item [3]);

        if (children == ["badagent"]) {
            writeln ("bad agent, \"" // item [2] // "\"");
            return;

        } else if (children == ["fail"]) {
            writeln ("failed to match string \"" // item [1] // "\" with agent \"" // item [2] // "\"");
            writeln ("enter correct string or q to cancel:");
            correct = getline ();
            writeln ();

            if (correct == "q")
                return;

            list = [[correct, item [2], item [3]]] // list;

        } else if (children == ["undefined"]) {
            writeln ("agent is undefined, \"" // item [2] // "\"");
            return;

        } else {
            writeln ("success, resulting agent(s):");
            for (i = 1; i <= children#; i++)
                writeln (children [i]);

            list = children // list;
        }

        writeln ();

        /* wait for the user before next agent? */

        if (verbose_parser == 2) {
            a = getchar (); 
        
            /* has the user had enough? */
            if (a == 'q')
                return;
        }
    }

    for (i = 1; i <= laterlist#; i++)
        for (j = 1; j <= laterlist[i]#; j++) {
            fstr = format (laterlist [i][j][1], laterlist [i][j][2]);
            execute (fstr [1]);
        }

    laterlist = [];
}

dfparse is verbose_parser ? verbose_dfparse : quiet_dfparse;

/* a parser with breadth first agent execution - identical to dfparse
   except that the child agents are added to the end of the "to run"
   list, not the beginning */

proc bfparse {
    para instr, start_agent, varnames;
    auto item, children, list, i, j, fstr, correct;

    laterlist = [];

    list = [[instr, start_agent, varnames]];

    while ((item = removehead (&list)) != []) {
        children = run_agent (item [1], item [2], item [3]);

        if (children == ["badagent"]) {
            writeln ("bad agent, \"" // item [2] // "\"");
            return;

        } else if (children == ["fail"]) {
            writeln ("failed to match string \"" // item [1] // "\" with agent \"" // item [2] // "\"");
            writeln ("enter correct string or q to cancel:");
            correct = getline ();
            writeln ();

            if (correct == "q")
                return;

            list = [[correct, item [2], item [3]]] // list;

        } else if (children == ["undefined"]) {
            writeln ("agent is undefined, \"" // item [2] // "\"");
            return;

        } else {
            list = list // children;
        }
    }

    for (i = 1; i <= laterlist#; i++)
        for (j = 1; j <= laterlist[i]#; j++) {
            fstr = format (laterlist [i][j][1], laterlist [i][j][2]);
            execute (fstr [1]);
        }

    laterlist = [];
}


splitdata = [];
parser_buffer = "";
firstagent = "";

func setup_parser {
	para datavar;
	auto data;

	data = getvar (datavar);
	if (type (data) != "list" || data# < 2)
		return 0;

	if (data# > 2)
		splitdata = [[data [1], getstartsyms (data [3])]];
	else
		splitdata = [[data [1], []]];

	firstagent = data [2];

	parser_buffer = "";
}

proc parsechar {
	para inchar;
	auto i, cur_match, cur_ignore, new_symbol;

	parser_buffer = parser_buffer // str (inchar);

	cur_match = splitdata [1][1];
	cur_ignore = splitdata [1][2];

	for (i = 1; i <= cur_ignore#; i++)
		if (issuffix (parser_buffer, cur_ignore [i])) {
			
			new_symbol = getblockfromstartsym (cur_ignore [i]);
			if (new_symbol == [])
				return 0;

			/* might have to match more than 2 symbols, e.g proc ; ; not just proc ; */

			cur_match = new_symbol [1][2];
			cur_ignore = getstartsyms (new_symbol [2]);
			new_data = [[cur_match, cur_ignore]];

			for (i = new_symbol[1]#; i > 2; i--)
				new_data = new_data // [[new_symbol [1][i], cur_ignore]];

			splitdata = new_data // splitdata;
			return;
		}

	if (issuffix (parser_buffer, cur_match)) {
		if (splitdata# == 1) {
			flush_parser ();
		} else {
			splitdata = tail (splitdata);
		}
	}
}


proc flush_parser {
	if (!isspace (parser_buffer))
		dfparse (parser_buffer, firstagent, []);

	parser_buffer = "";
}

/* program.e - contains useful agent templates */

nothing = ["literal", ""];
anything = ["read_all", []];
alphanum = ["read_all", [["a", "z"], ["A", "Z"], ["_"], ["0", "9"]]];
number = ["read_all", [["0", "9"]]];
float_num = ["pivot", ".", ["number", "number"], ["fail", "number"]];
ident = ["read_prefix", [[["a", "z"], ["A", "Z"], ["_"]], 1], "alphanum"];

func ident_fail {
    para fail;
    return ident_ex ([["fail", fail]]);
}

func ident_ex {
    para extra;
    return ["read_prefix", [[["a", "z"], ["A", "Z"], ["_"]], 1], "alphanum"] // extra;
}

func number_fail {
    para fail;
    return ["read_all", [["0", "9"]], ["fail", fail]];
}
