###############################################################################
#
#	File:     mkappl2.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"
#DJDSTOP
# 
# # define DEBUG
# # undef DEBUG
# # include "parm.h"
# 
# # include <stdio.h>
# 
# # include "stree/ststructs.mh"
# 
# extern FILE * unparse_file;
# 
# # ifdef BAD
# 	extern boolean BADflag;
# # endif
# 
# NODE * cor_cond();
# 
# NODE * cand_cond();
# 
# NODE ** outermost_op();
# 
# /*
#  *  mkappl2(h,t)
#  *
#  *  input:  A denotation represented as 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 tree of applications and conditionals (which reflect the
#  *          precedence of operations in the denotation), in the form of
#  *          an arg list for a higher level application.
#  *          The outermost node always has a ref count of zero.
#  */
# 
# NODE * mkappl2(h,t)
# NODE    ** h,
#         ** t;
# {
#     NODE ** op,        /* "outermost" operator (i.e. the operation performed
#                           last) in the denotation                          */
#          * result,
#          * left_arg,   /* a tree of applications which is the left arg of op */
# 	 * right_arg,
# 	 ** rest = t+1; /* start of arguments for next applications  */
# 
# 
# #   ifdef DEBUG
#         /* test for empty array */
#             if ( h == t + 1 ) {
#                 dbgmsg("\nmkappl2: empty array - %o, %o\n", h, t);
#                 abort();
#             }
# #   endif
# 
# 
#     /* If there is just a single primary, convert it into
#        an arg list and return.                           */
#         if ( h == t ) {
#             /* is it already a list? */
# 		if ( is_list(*h) ) {
# 		    /* Copy it and return the copy. */
#                         return ( copylist(*h) );
# 		} else {
# 		    return ( mklist(*h, -1) );
# 		}
#         }
# 
# 
#     /* Find the "outermost" operator and assume its args are
#        the sequences of primaries to its right and left.
#        Build a tree representing the application of that operator
#        to it args.                                          */
# 
#         /* Find the outermost operator */
# 	    op = outermost_op( h,t );
# 
# 	if( op == NIL ) {
# 	    /* Couldn't find a reasonable one */
# 	    if (!is_list(*h)) {
# 		/* Interpret it as curried application */
# 		    rest = h+2;
# 		    right_arg = mkappl2( h+1, h+1);
# 		    lock(right_arg);
# 		    left_arg = emptylist();
# 		    lock(left_arg);
# 		    op = h;
# 	    } else {
# 		/* no way to deal with this mess */
# 		yyperror("Improperly bracketed expression");
# 		return( mklist(emptylist(), -1) );
# 	    }
# 	} else {
# 
# 	  /* Construct the left argument tree */
#             if ( op == h )
#                 left_arg = emptylist();
#             else
#                 left_arg = mkappl2( h, op-1 );
#             lock(left_arg);
# 
# 	  /* Construct the right argument tree */
#             if ( op == t )
#                 right_arg = emptylist();
#             else
#                 right_arg = mkappl2( op+1, t );
# 	    lock(right_arg);
# 	}
# 
# 	/* Construct the application of op to args,
# 	    or conditional in the case of "cand" and "cor" */
#             switch ( (*op) -> kind ) {
#                 case WORDCAND:
#                     /* Check that there are only two args */
#                         single_arg(left_arg); single_arg(right_arg);
#                     result = cand_cond(left_arg, right_arg);
#                     vfree(unlock(left_arg));  vfree(unlock(right_arg));
#                     break;
#                 case WORDCOR:
#                     /* Check that there are only two args */
#                         single_arg(left_arg); single_arg(right_arg);
#                     result = cor_cond(left_arg, right_arg);
#                     vfree(unlock(left_arg));  vfree(unlock(right_arg));
#                     break;
#                 default:
#                     unlock(left_arg); unlock(right_arg);
# 		    result = mknode(APPLICATION, *op, conc(left_arg,right_arg));
# 		    /* add curried applications */
# 			while (rest <= t) {
# 			    result = mknode(APPLICATION, result,
# 					    mkappl2( rest, rest ));
# 			    rest++;
# 			}
#             }
# 
# 
# #           ifdef BAD
# 		if (BADflag)
# 		    flcheck(0,0);
# 		else
# 		    flcheck(0,1);
# #           endif
#         /* Make it into an arg list and return it */
#             return ( mklist(result, -1) );
# }
# #DJDSTART
#
#  mkappl2(a,h,t)
#
#  input:  A denotation represented as 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 tree of applications and conditionals (which reflect the
#          precedence of operations in the denotation), in the form of
#          an arg list for a higher level application.
#          The outermost node always has a ref count of zero.
#

procedure mkappl2(array,head,tail)
    local op,result,left_arg, right_arg,rest, temp
    rest := tail + 1  # was + 1
    yyinfo("mkappl2 head = " || head || " tail = " || tail)
    # If there is just a single primary, convert it into
    #   an arg list and return.
    nct_dbg("aa0000001")
    if ( head = tail )  then {
	# is it already a list?
	    if ( is_list(fix_p(array[head])) ) then {
		# Copy it and return the copy.
		nct_dbg("aa0000001A head = " || dump_info(head))
		return ( copylist(fix_p(array[head])) )
	    } else {
#		nct_dbg("aa0000001B" || dump_info(head) || dump_info(array(head)))
		return ( mklist([array[head]]) ) # CHG DJD
	    }
        }

    nct_dbg("aa0000002")


    # Find the "outermost" operator and assume its args are
    #   the sequences of primaries to its right and left.
    #   Build a tree representing the application of that operator
    #   to it args.

    # Find the outermost operator
    op := outermost_op(array, head,tail )
    nct_dbg("aa0000003")

    if( /op  ) then {
	# Couldn't find a reasonable one
	if (not(is_list(fix_p(array[head])))) then {
	    nct_dbg("aa0000004")

	    # Interpret it as curried application
	    rest := head+2
	    right_arg := mkappl2(array, head+1, head+1)
	    lock(right_arg)
	    left_arg := emptylist()
	    lock(left_arg)
	    op := head
	    nct_dbg("aa0000005")

	} else {
	    nct_dbg("aa0000006")

	    # no way to deal with this mess
	    yyperror("Improperly bracketed expression")
	    return( mklist([emptylist()]) )
	}
    } else {
	nct_dbg("aa0000007")

	# Construct the left argument tree
	if ( op = head ) then
	    left_arg := emptylist()
	else
	    left_arg := mkappl2(array, head, op-1 )
	lock(left_arg)

	# Construct the right argument tree
	if ( op = tail ) then
	    right_arg := emptylist()
	else
	    right_arg := mkappl2(array, op+1, tail )
	lock(right_arg)
	nct_dbg("aa0000008")

    }

    # Construct the application of op to args,
    #    or conditional in the case of "cand" and "cor"
    temp := fix_p(array[op])
#    temp := fix_p(temp)

    nct_dbg("aa0000009" || temp.kind)

    case  ( temp.kind ) of {
	WORDCAND: {
	    nct_dbg("aa0000010 WORDCAND")

	    # Check that there are only two args
	    single_arg(left_arg)
	    single_arg(right_arg)
	    result := cand_cond(left_arg, right_arg)
	    vfree(unlock(left_arg))
	    vfree(unlock(right_arg))
	}
	WORDCOR: {
	    nct_dbg("aa0000010 WORDCOR")
	    # Check that there are only two args
	    single_arg(left_arg)
	    single_arg(right_arg)
	    result := cor_cond(left_arg, right_arg)
	    vfree(unlock(left_arg))
	    vfree(unlock(right_arg))
	}
	default: {
	    nct_dbg("aa0000010 default")

	    unlock(left_arg)
	    unlock(right_arg)
	    result := mknode([APPLICATION,temp, conc(left_arg,right_arg)])
	    # add curried applications
	    while (rest <= tail) do {
		result := mknode([APPLICATION, result,
				  mkappl2(array, rest, rest )])
		rest +:= 1
	    }
	}
    }
    nct_dbg("aa0000011")

    # Make it into an arg list and return it
    return ( mklist([result] ))
#    return ( mklist([result, end_of_args) )  # CHG DJD
end
