###############################################################################
#
#	File:     outermost_op.icn
#
#	Subject:  russell language support procedures
#
#	Author:   Dennis J Darland
#
#	Date:     October - Novmber, 2015
#
###############################################################################
#
# Copyright 1986-1989 Hans-Juergen Boehm, Alan J. Demers, Kumar Srikantan,
# Vernon Lee, and Lucy Hederman.
# Copyright Digital Equipment Corporation & INRIA 1988, 1989.
# Copyright (c) 1990-1993 by Xerox Corporation.  All rights reserved.
#
# This material is provided as is, with no warranty expressed or implied.
# Any use is at your own risk.
# 
# Permission is hereby granted to copy this compiler for any non-commercial
# purpose, provided the above notices are retained on all copies.  Further
# restrictions apply to the DEC/INRIA BigNum package.  These are stated in
# the file runtime/BigNum/doc/bnbody.tex.
#
# This work uses the BigNum package developed jointly by INRIA and
# Digital PRL.  It has been modified by Hans-J. Boehm in August 1990
# and February 1993 at Xerox PARC.  When you receive this software,
# please send mail to librarian@prl.dec.com to inform them that you
# have a copy of the package.
###############################################################################
#
#   NOTE From Dennis J. Darland (11/2/2015)
#
#   I obtained the "c" language source code for "russell" copyrighted above
#   in the 1990's. I have made efforts to get it to work over the years, but
#   always failed. It has many hardware and OS dependancies. Now (October 2015
#   forward, I am tring to port to the language "Unicon". Practically every
#   line of code will need to be changed, as someing as simple as the
#   assignment operator is different. Also I will not use the BigNum package
#   mentioned above. Also I am doing this not for profit, and am sharing
#   freely. I am not at all confident that I will get it working well, but
#   believe in open source, so am sharing my work as I make progress.
#   Unicon is also much more portable.
#
###############################################################################

$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 = "|| dump_info(p) || " head = " || dump_info(head) || " tail = " || dump_info(tail))
    yyinfo("array = " || dump_info((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(fix_p(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(fix_p(array[head])) then has_left_arg := TRUE
	    else has_left_arg := FALSE
	    
	    if op = tail then has_right_arg := FALSE
	    else if is_list(fix_p(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
    
