$include "defs.icn"
$include "global_vars.icn"
#
# outermost_op(h,t)
#
# input: A denotation in the form of an array of pointers to primaries.
#        h points to the start of the array, t to the end. The array
#        should not be empty.
#
# output: A pointer to the outermost operator in the array, as determined
#         by the heuristic.
#
# heuristic: 1) If the denotation contains primaries of less than
#               "infinite" precedence, then the outermost operator
#               is the leftmost primary in the rightmost sequence of
    #               of primaries of lowest precedence.
#               In the case where the lowest precedence is that of the
#               exponentiation operator, the outermost operator is just
#               the leftmost operator of lowest precedence.
#            2) If the denotation does not contain any primaries of less
#               than infinite precedence, then the outermost operator
#               is the only primary which is not bracketed (i.e. is not
#               a list of primaries), and it may have no more than one
#               right arg and one left arg.
#            3) If there is no such primary, then this routine fails.
#               Mkappl2 will usually use the first primary in this case.
#
# 	WARNING: This is a HORRIBLE algorithm.  But we don't have the
#		time to fix it.
#

procedure outermost_op(array, head, tail)
    local    op, lowest_prec, i, p ,has_left_arg, has_right_arg, len,in_seq
    # # of primaries in array
    # Determine the lowest precedence in the denotation
    lowest_prec := INFINITE
    p := head
    yyinfo("outermost_op p = "|| p || " head = " || head || " tail = " || tail)
    yyinfo("array = " || type(array))
    while (p ~= tail + 1 ) do { # was +1 DJD
#            for (p = h; p != t+1; p++)
	yyinfo("type(array(p) = " || type(array[p]))
	i := precedence(array[p])
	yyinfo("i = " || i)
	if ( i < lowest_prec ) then
	    lowest_prec := i
	p +:= 1
    }
    yyinfo("lower_prec = " || lowest_prec)
    case ( lowest_prec ) of {
	INFINITE:
	    # Find unbracketed primary and check if ok
	{
	    yyinfo("INFINITE")
	    op := nil
	    p := head
	    while p ~= tail + 1 do {
#                    for (p = h; p != t+1; p++)
		if ( not (is_list(array[p])) ) then
		    op := p
		p +:= 1
	    }
	    if ( /op ) then {
		# there's no reasonable operator, return the NIL
		return nil
	    }

	    len := tail - head + 1
	    if op = head then has_left_arg := FALSE
	    else if is_list(array[head]) then has_left_arg := TRUE
	    else has_left_arg := FALSE

	    if op = tail then has_right_arg := FALSE
	    else if is_list(array[tail]) then has_right_arg := TRUE
	    else has_right_arg := FALSE

	    if ( not(    has_left_arg &  has_right_arg & len == 3) |
		not(has_left_arg &  has_right_arg & len == 2) |
		(has_left_arg & !has_right_arg & len == 2)
		)  then {
		    # Cant uniquely determine operator
		    op := nil
		    return nil
		}
	}
	EXPLEVEL:
	    {
		yyinfo("EXPLEVEL")
		p := head
		repeat {
		    if (precedence(array[p] = lowest_prec)) then {
			op := p
			break
		    }
		    p +:= 1
		}
	    }
	ASGNLEVEL:
	    {
		yyinfo("ASSGNLEVEL")
		p := head
		repeat {
		    if (precedence(array[p]) = lowest_prec) then {
			op := p
			break
		    }
		    p +:= 1

		}
	    }
	DEREFLEVEL:
	    {
		yyinfo("DEREFLEVEL")
		p := head
		repeat {
		    if (precedence(array[p] = lowest_prec)) then {
			op := p
			break
		    }
		    p +:= 1

		}
	    }
	default: {
	    yyinfo("default")
            # Find leftmost primary in rightmost sequence
	    in_seq := FALSE
	    p := head
	    while (p ~= tail + 1 ) do {
#	    for (p = h; p != t+1; p++) {
		if ( precedence(array[p]) = lowest_prec ) then {
		    if ( in_seq ~= TRUE ) then
			op := p
		} else
		    in_seq := FALSE
		p +:= 1
	    }
	}
    }

    return ( op )

end