$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 ) 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
		    }
		}
	    }
	ASGNLEVEL:
	    {
	    yyinfo("ASSGNLEVEL")
		p := head
		repeat {
		    if (precedence(array[p]) = lowest_prec) then {
			op := p
			break
		    }
		}
	    }
	DEREFLEVEL:
	    {
	    yyinfo("DEREFLEVEL")
		p := head
		repeat {
		    if (precedence(array[p] = lowest_prec)) then {
			op := p
			break
		    }
		}
	    }
	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
    
