###############################################################################
#
#	File:     mkappl.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.
#
###############################################################################

#DJDSTOP
# include "parm.h"

# include "stree/ststructs.mh"

# include "stree/Array.h"

# ifdef BAD
    extern boolean BADflag;
# endif

/*
 * mkappl(l)
 *
 * input: A denotation in the form of a list of primaries.
 *
 * output: The denotation in the form of a tree of applications
 *         and conditionals. A heuristic (described elsewhere)
 *         is applied to decide how to parse the list if args
 *         are not fully bracketed.
 *         The input list l is destroyed and replaced by the
 *         empty list.
 */

NODE * mkappl(l)
NODE * l;
{   Array *  array;      /* array of pointers to primaries */
    NODE *  tree,       /* the result tree */
         *  sl;         /* a singleton list containing the tree */

#   ifdef DEBUG
        if ( !is_list(l) || is_empty(l) ) {
            dbgmsg("\nmkappl: arg not a list: %o\n", l);
            abort();
        }
#   endif


    /* Convert l into an array. */
        array = l.list_to_array();

    /* Construct a singleton list containing (hopefully) the tree of
       applications and conditionals.                               */
        sl = mkappl2( array->a_body, &array->a_body[array->a_size-1] );
        lock(sl);

    /* Return the tree, freeing the array and the list. */
	if (is_empty(sl)) {
	    yyperror("Empty argument list without operator");
	    tree = lock(sl);
	} else {
	    tree = lock( sl.first() );
	}

#       ifdef BAD
            if (BADflag)
                flcheck(0,0);
            else
                flcheck(0,1);
#       endif

        free_array(array);  vfree( unlock(sl) );

#       ifdef BAD
            if (BADflag)
                flcheck(0,0);
            else
                flcheck(0,1);
#       endif

        return ( unlock(tree) );

}
#DJDSTART

#
# * mkappl(l)
# *
# * input: A denotation in the form of a list of primaries.
# *
# * output: The denotation in the form of a tree of applications
# *         and conditionals. A heuristic (described elsewhere)
# *         is applied to decide how to parse the list if args
# *         are not fully bracketed.
# *         The input list l is destroyed and replaced by the
# *         empty list.
# 

procedure mkappl(l)
    local array, tree, sl, i
#      # array of pointers to primaries 
#    NODE *  tree,       # the result tree 
#         *  sl;         # a singleton list containing the tree 

    # Convert l into an array. 
    array := l.list_to_array()

    # Construct a singleton list containing (hopefully) the tree of
	#  applications and conditionals.    
    yyinfo("mkappl size = " || array.a_size)
    i := 1
    while (i <= array.a_size) do {
	yyinfo("type body i = " || i || type(array.a_body[i]))
	i +:= 1
    } 

    sl := mkappl2( array.a_body , 1, array.a_size   )
    lock(sl)

    # Return the tree, freeing the array and the list. 
    if (is_empty(sl)) then {
	yyperror("Empty argument list without operator")
	tree := lock(sl)
    } else {
	tree := lock( sl.first() )
    }
    free_array(array)
    vfree( unlock(sl) )
    return ( unlock(tree) )

end


