###############################################################################
#
#	File:     coerce.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"
# include "parm.h"

# include "stree/ststructs.mh"

# include "sigs.h"

# extern int indx_ValueOf;

#
#  Return an expression which corresponds to p coerced to a value 
# signature (if remotely possible).  If this is clearly impossible
# just return p.  It is assumed that p's signature is known.
#  Note that the only correctness claim for this procedure is
# that if the coercion is possible it is done correctly.  No
# attempt is made to determine whether the resulting expression
# will be signature correct.  This is left up to checksigs.
# The resulting expression may no longer have known signature.
#  The expression tree p may be destructively updated in order
# to propagate coercions into LET blocks.  This is necessary
# in that it reduces the likelihood of bogus import rule violations.
# It also enhances the effectiveness of allocate.c in allocating
# variables to registers.
#  We claim that there exists a subtle argument that shows that the
# destructive update cannot update signatures, and is thus safe.
#
procedure coerce(orig_p)
    local  nappl, p, nop  # New application node 
    p := fix_p(orig_p)
    if (p . signature = ERR_SIG) then return(p)

    if (p . kind = BLOCKDENOTATION) then {
	replace_last(p . bld_den_seq, coerce(last(p . bld_den_seq)))
	p . signature :=  nil
	p . sig_done := SIG_UNKNOWN
	return(p)
    } else if (p . kind = USELIST) then {
	replace_last(p . usl_den_seq, coerce(last(p . usl_den_seq)))
	p . signature := nil
	p . sig_done := SIG_UNKNOWN
	return(p)
    }

    case (p . signature . kind)  of {
	 VALSIGNATURE:
	    return(p)
	 VARSIGNATURE:
	    {
		nop := mknode([LETTERID, indx_ValueOf])
		nop . sel_type := p . signature . var_denotation
		nop . id_def_found := TRUE
		nappl := mknode([APPLICATION, nop, mklist([p])])
		nappl . vlineno := nop . vlineno = p . vlineno
		nappl . pre_num := nop . pre_num = p . pre_num
		nappl . post_num := nop . post_num := p . post_num
		return(nappl)
	    }
	 FUNCSIGNATURE:
	    if(length(p.signature.fsig_param_list) = 0) then {
		nappl := mknode([APPLICATION, p, emptylist()])
		nappl . vlineno := p . vlineno
		nappl . pre_num := p . pre_num
		nappl . post_num := p . post_num
		return(nappl)
	    } else {
		# clearly hopeless 
		return(p)
	    }
	default:
	    # again hopeless 
	    return(p)
    }
end
