WebSVN – tendra.SVN – Diff – /branches/tendra5/src/producers/common/construct/operator.c

+/*
+ * Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.org/>.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ * 3. Neither the name of The TenDRA Project nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific, prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * $Id$
+ */
 /*
     		 Crown Copyright (c) 1997
     This TenDRA(r) Computer Program is subject to Copyright
     owned by the United Kingdom Secretary of State for Defence
     acting through the Defence Evaluation and Research Agency
     (DERA).  It is made available to Recipients with a
     royalty-free licence for its use, reproduction, transfer
     to other parties and amendment for any purpose not excluding
     product development provided that any such use et cetera
     shall be deemed to be acceptance of the following conditions:-
         (1) Its Recipients shall ensure that this Notice is
         reproduced upon any copies or amended versions of it;
         (2) Any amended version of it shall be clearly marked to
         show both the nature of and the organisation responsible
         for the relevant amendment or amendments;
         (3) Its onward transfer from a recipient to another
         party shall be deemed to be that party's acceptance of
         these conditions;
         (4) DERA gives no warranty or assurance as to its
         quality or suitability for any purpose and DERA accepts
         no liability whatsoever in relation to any use to which
         it may be put.
 */
 /*
     FIND AN EXPRESSION RELATION
     This routine returns the lexical token number of associated with
     the test ntst.  The default value returned is lex.
 */
-int ntest_token
+int
-    PROTO_N ( ( ntst, lex ) )
-    PROTO_T ( NTEST ntst X int lex )
+ntest_token(NTEST ntst, int lex)
+{
-    switch ( ntst ) {
+	switch (ntst) {
+	case ntest_eq:
+		lex = lex_eq;
+		break;
-	case ntest_eq : lex = lex_eq ; break ;
+	case ntest_not_eq:
-	case ntest_not_eq : lex = lex_not_Heq_H1 ; break ;
+		lex = lex_not_Heq_H1;
+		break;
+	case ntest_less:
+		lex = lex_less;
+		break;
-	case ntest_less : lex = lex_less ; break ;
+	case ntest_less_eq:
-	case ntest_less_eq : lex = lex_less_Heq ; break ;
+		lex = lex_less_Heq;
+		break;
+	case ntest_greater:
+		lex = lex_greater;
+		break;
-	case ntest_greater : lex = lex_greater ; break ;
+	case ntest_greater_eq:
-	case ntest_greater_eq : lex = lex_greater_Heq ; break ;
+		lex = lex_greater_Heq;
+		break;
-    }
+	}
-    return ( lex ) ;
+	return (lex);
+}
 /*
     FIND THE TOKEN NUMBER FOR AN OPERATION
     This routine returns the lexical token number associated with the
     expression e.  The default value returned is lex.
 */
-int op_token
+int
-    PROTO_N ( ( e, lex ) )
-    PROTO_T ( EXP e X int lex )
+op_token(EXP e, int lex)
 {
-    if ( !IS_NULL_exp ( e ) ) {
+	if (!IS_NULL_exp(e)) {
-	switch ( TAG_exp ( e ) ) {
+		switch (TAG_exp(e)) {
-	    case exp_negate_tag : lex = lex_minus ; break ;
+		case exp_negate_tag:
+			lex = lex_minus;
+			break;
+		case exp_compl_tag:
-	    case exp_compl_tag : lex = lex_compl_H1 ; break ;
+			lex = lex_compl_H1;
+			break;
+		case exp_not_tag:
-	    case exp_not_tag : lex = lex_not_H1 ; break ;
+			lex = lex_not_H1;
+			break;
-	    case exp_abs_tag : lex = lex_abs ; break ;
+		case exp_abs_tag:
+			lex = lex_abs;
+			break;
-	    case exp_plus_tag : lex = lex_plus ; break ;
+		case exp_plus_tag:
+			lex = lex_plus;
+			break;
-	    case exp_minus_tag : lex = lex_minus ; break ;
+		case exp_minus_tag:
+			lex = lex_minus;
+			break;
-	    case exp_mult_tag : lex = lex_star ; break ;
+		case exp_mult_tag:
+			lex = lex_star;
+			break;
-	    case exp_div_tag : lex = lex_div ; break ;
+		case exp_div_tag:
+			lex = lex_div;
+			break;
-	    case exp_rem_tag : lex = lex_rem ; break ;
+		case exp_rem_tag:
+			lex = lex_rem;
+			break;
+		case exp_and_tag:
-	    case exp_and_tag : lex = lex_and_H1 ; break ;
+			lex = lex_and_H1;
+			break;
+		case exp_or_tag:
-	    case exp_or_tag : lex = lex_or_H1 ; break ;
+			lex = lex_or_H1;
+			break;
+		case exp_xor_tag:
-	    case exp_xor_tag : lex = lex_xor_H1 ; break ;
+			lex = lex_xor_H1;
+			break;
+		case exp_log_and_tag:
-	    case exp_log_and_tag : lex = lex_logical_Hand_H1 ; break ;
+			lex = lex_logical_Hand_H1;
+			break;
+		case exp_log_or_tag:
-	    case exp_log_or_tag : lex = lex_logical_Hor_H1 ; break ;
+			lex = lex_logical_Hor_H1;
+			break;
-	    case exp_lshift_tag : lex = lex_lshift ; break ;
+		case exp_lshift_tag:
+			lex = lex_lshift;
+			break;
-	    case exp_rshift_tag : lex = lex_rshift ; break ;
+		case exp_rshift_tag:
+			lex = lex_rshift;
+			break;
-	    case exp_max_tag : lex = lex_max ; break ;
+		case exp_max_tag:
+			lex = lex_max;
+			break;
-	    case exp_min_tag : lex = lex_min ; break ;
+		case exp_min_tag:
+			lex = lex_min;
+			break;
-	    case exp_test_tag : {
+		case exp_test_tag: {
-		NTEST ntst = DEREF_ntest ( exp_test_tst ( e ) ) ;
+			NTEST ntst = DEREF_ntest(exp_test_tst(e));
-		lex = ntest_token ( ntst, lex ) ;
+			lex = ntest_token(ntst, lex);
-		break ;
+			break;
-	    }
+		}
-	    case exp_compare_tag : {
+		case exp_compare_tag: {
-		NTEST ntst = DEREF_ntest ( exp_compare_tst ( e ) ) ;
+			NTEST ntst = DEREF_ntest(exp_compare_tst(e));
-		lex = ntest_token ( ntst, lex ) ;
+			lex = ntest_token(ntst, lex);
-		break ;
+			break;
-	    }
+		}
-	    case exp_paren_tag : {
+		case exp_paren_tag: {
-		EXP a = DEREF_exp ( exp_paren_arg ( e ) ) ;
+			EXP a = DEREF_exp(exp_paren_arg(e));
-		lex = op_token ( a, lex ) ;
+			lex = op_token(a, lex);
-		break ;
+			break;
-	    }
+		}
-	    case exp_copy_tag : {
+		case exp_copy_tag: {
-		EXP a = DEREF_exp ( exp_copy_arg ( e ) ) ;
+			EXP a = DEREF_exp(exp_copy_arg(e));
-		lex = op_token ( a, lex ) ;
+			lex = op_token(a, lex);
-		break ;
+			break;
-	    }
+		}
-	}
+		}
-    }
+	}
-    return ( lex ) ;
+	return (lex);
 }
 /*
     APPLY A UNARY OPERATOR
     This routine applies the unary operator op to the argument a.  The
 /*
     APPLY A BINARY OPERATOR
     This routine applies the binary operator op to the arguments a and b.
 #if LANGUAGE_CPP
-	case lex_arrow_Hstar :
+	case lex_arrow_Hstar:
-	case lex_dot_Hstar : {
+	case lex_dot_Hstar:
-	    /* Construct 'a->*b' and 'a.*b' */
+		/* Construct 'a->*b' and 'a.*b' */
-	    e = make_member_exp ( op, a, b ) ;
+		e = make_member_exp(op, a, b);
-	    break ;
+		break;
-	}
 #endif
-	default : {
+	default:
-	    /* Illegal operations */
+		/* Illegal operations */
-	    FAIL ( Unexpected binary operation ) ;
+		FAIL(Unexpected binary operation);
-	    e = make_error_exp ( 0 ) ;
+		e = make_error_exp(0);
-	    break ;
+		break;
+	}
-    }
-    suppress_quality-- ;
+	suppress_quality--;
-    return ( e ) ;
+	return (e);
+}
 /*
     APPLY AN N-ARY OPERATOR
     This routine applies the n-ary operator op to the arguments p.  The
     type t2 gives the destination for any cast operator.
 */
-EXP apply_nary
+EXP
-    PROTO_N ( ( op, p, t1, t2, cpy ) )
-    PROTO_T ( int op X LIST ( EXP ) p X TYPE t1 X TYPE t2 X int cpy )
+apply_nary(int op, LIST(EXP)p, TYPE t1, TYPE t2, int cpy)
 {
-    EXP e ;
+	EXP e;
-    suppress_quality++ ;
+	suppress_quality++;
-    switch ( op ) {
+	switch (op) {
-	case lex_comma : {
+	case lex_comma: {
-	    /* Construct 'p0, p1, ..., pn' */
+		/* Construct 'p0, p1, ..., pn' */
+		if (cpy) {
-	    if ( cpy ) p = copy_exp_list ( p, t1, t2 ) ;
+			p = copy_exp_list(p, t1, t2);
+		}
-	    e = make_comma_exp ( p ) ;
+		e = make_comma_exp(p);
-	    break ;
+		break;
 	}
-	case lex_cond_Hop : {
+	case lex_cond_Hop: {
-	    /* Construct 'p0 ? p1 : p2' */
+		/* Construct 'p0 ? p1 : p2' */
-	    EXP c, a, b ;
+		EXP c, a, b;
-	    c = DEREF_exp ( HEAD_list ( p ) ) ;
+		c = DEREF_exp(HEAD_list(p));
-	    p = TAIL_list ( p ) ;
+		p = TAIL_list(p);
-	    a = DEREF_exp ( HEAD_list ( p ) ) ;
+		a = DEREF_exp(HEAD_list(p));
-	    p = TAIL_list ( p ) ;
+		p = TAIL_list(p);
-	    b = DEREF_exp ( HEAD_list ( p ) ) ;
+		b = DEREF_exp(HEAD_list(p));
-	    if ( cpy ) {
+		if (cpy) {
-		c = copy_exp ( c, type_bool, type_bool ) ;
+			c = copy_exp(c, type_bool, type_bool);
-		a = copy_exp ( a, t1, t2 ) ;
+			a = copy_exp(a, t1, t2);
-		b = copy_exp ( b, t1, t2 ) ;
+			b = copy_exp(b, t1, t2);
-	    }
+		}
-	    e = make_cond_exp ( c, a, b ) ;
+		e = make_cond_exp(c, a, b);
-	    break ;
+		break;
 	}
-	case lex_func_Hop : {
+	case lex_func_Hop: {
-	    /* Construct 'p0 ( p1, ..., pn )' */
+		/* Construct 'p0 ( p1, ..., pn )' */
-	    EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
+		EXP a = DEREF_exp(HEAD_list(p));
-	    p = TAIL_list ( p ) ;
+		p = TAIL_list(p);
-	    if ( cpy ) {
+		if (cpy) {
-		a = copy_func_exp ( a, t1, t2 ) ;
+			a = copy_func_exp(a, t1, t2);
-		p = copy_exp_list ( p, t1, t2 ) ;
+			p = copy_exp_list(p, t1, t2);
-	    }
-	    e = make_func_exp ( a, p, 1 ) ;
-	    break ;
-	}
+		}
-	case lex_cast : {
-	    /* Construct 't2 ( p0, ..., pn )' */
-	    if ( cpy ) p = copy_exp_list ( p, t1, t2 ) ;
-	    e = make_func_cast_exp ( t2, p ) ;
+		e = make_func_exp(a, p, 1);
-	    break ;
+		break;
+	}
+	case lex_cast:
+		/* Construct 't2 ( p0, ..., pn )' */
+		if (cpy) {
+			p = copy_exp_list(p, t1, t2);
+		}
+		e = make_func_cast_exp(t2, p);
+		break;
-	case lex_static_Hcast : {
+	case lex_static_Hcast: {
-	    /* Construct 't2 ( p0, ..., pn )' */
+		/* Construct 't2 ( p0, ..., pn )' */
-	    ERROR err = NULL_err ;
+		ERROR err = NULL_err;
+		if (cpy) {
-	    if ( cpy ) p = copy_exp_list ( p, t1, t2 ) ;
+			p = copy_exp_list(p, t1, t2);
+		}
-	    p = convert_args ( p ) ;
+		p = convert_args(p);
-	    e = convert_constr ( t2, p, &err, CAST_STATIC ) ;
+		e = convert_constr(t2, p, &err, CAST_STATIC);
-	    if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
+		if (!IS_NULL_err(err)) {
+			report(crt_loc, err);
+		}
-	    break ;
+		break;
+	}
 #if LANGUAGE_CPP
-	case lex_new :
+	case lex_new:
-	case lex_new_Hfull : {
+	case lex_new_Hfull: {
-	    /* Construct 'new ( p3, ..., pn ) ( t0 [ p1 ] ) ( p2 )' */
+		/* Construct 'new ( p3, ..., pn ) ( t0 [ p1 ] ) ( p2 )' */
-	    EXP a ;
+		EXP a;
-	    TYPE s ;
+		TYPE s;
-	    int b = 0 ;
+		int b = 0;
-	    if ( op == lex_new_Hfull ) b = 1 ;
+		if (op == lex_new_Hfull) {
+			b = 1;
+		}
+		if (cpy) {
-	    if ( cpy ) p = copy_exp_list ( p, t1, t2 ) ;
+			p = copy_exp_list(p, t1, t2);
+		}
-	    a = DEREF_exp ( HEAD_list ( p ) ) ;
+		a = DEREF_exp(HEAD_list(p));
-	    p = TAIL_list ( p ) ;
+		p = TAIL_list(p);
-	    s = DEREF_type ( exp_type ( a ) ) ;
+		s = DEREF_type(exp_type(a));
-	    a = DEREF_exp ( HEAD_list ( p ) ) ;
+		a = DEREF_exp(HEAD_list(p));
-	    p = TAIL_list ( p ) ;
+		p = TAIL_list(p);
-	    if ( !IS_NULL_exp ( a ) ) {
+		if (!IS_NULL_exp(a)) {
-		/* Array dimension */
+			/* Array dimension */
-		NAT n ;
+			NAT n;
-		MAKE_nat_calc ( a, n ) ;
+			MAKE_nat_calc(a, n);
-		MAKE_type_array ( cv_none, s, n, s ) ;
+			MAKE_type_array(cv_none, s, n, s);
-	    }
+		}
-	    a = DEREF_exp ( HEAD_list ( p ) ) ;
+		a = DEREF_exp(HEAD_list(p));
-	    p = TAIL_list ( p ) ;
+		p = TAIL_list(p);
-	    e = make_new_exp ( s, 0, b, p, a ) ;
+		e = make_new_exp(s, 0, b, p, a);
-	    break ;
-	}
-	case lex_compute : {
-	    /* Construct new-initialiser, '( p0, ..., pn )' */
-	    if ( cpy ) p = copy_exp_list ( p, t1, t2 ) ;
-	    e = make_new_init ( t2, p, 1 ) ;
-	    break ;
+		break;
+	}
+	case lex_compute:
+		/* Construct new-initialiser, '( p0, ..., pn )' */
+		if (cpy) {
+			p = copy_exp_list(p, t1, t2);
+		}
+		e = make_new_init(t2, p, 1);
+		break;
 #endif
-	default : {
+	default:
-	    /* Illegal operations */
+		/* Illegal operations */
-	    FAIL ( Unexpected nary operation ) ;
+		FAIL(Unexpected nary operation);
-	    e = make_error_exp ( 0 ) ;
+		e = make_error_exp(0);
-	    break ;
+		break;
+	}
-    }
-    suppress_quality-- ;
+	suppress_quality--;
-    return ( e ) ;
+	return (e);
+}
 /*
     CONVERT AN OPERAND TO A BUILT-IN OPERATOR
     This routine converts the nth operand a to the built-in operator op
     to type t.
 */
-static EXP convert_builtin
+static EXP
-    PROTO_N ( ( t, a, op, n ) )
-    PROTO_T ( TYPE t X EXP a X int op X unsigned n )
+convert_builtin(TYPE t, EXP a, int op, unsigned n)
 {
-    ERROR err = NULL_err ;
+	ERROR err = NULL_err;
-    if ( IS_type_compound ( t ) ) {
+	if (IS_type_compound(t)) {
-	a = convert_class ( t, a, &err ) ;
+		a = convert_class(t, a, &err);
-    } else {
+	} else {
-	a = init_assign ( t, cv_none, a, &err ) ;
+		a = init_assign(t, cv_none, a, &err);
-    }
+	}
-    if ( !IS_NULL_err ( err ) ) {
+	if (!IS_NULL_err(err)) {
-	err = init_error ( err, 0 ) ;
+		err = init_error(err, 0);
-	err = concat_error ( err, ERR_expr_convert_op ( n, op ) ) ;
+		err = concat_error(err, ERR_expr_convert_op(n, op));
-	report ( crt_loc, err ) ;
+		report(crt_loc, err);
-    }
+	}
-    return ( a ) ;
+	return (a);
+}
 /*
     APPLY A BUILT-IN OPERATOR
     This routine applies the built-in operator id to the arguments args.
 */
-EXP apply_builtin
+EXP
-    PROTO_N ( ( id, args ) )
-    PROTO_T ( IDENTIFIER id X LIST ( EXP ) args )
+apply_builtin(IDENTIFIER id, LIST(EXP) args)
+{
-    EXP e ;
+	EXP e;
-    TYPE t ;
+	TYPE t;
-    int op ;
+	int op;
-    EXP a, b ;
+	EXP a, b;
-    HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
+	HASHID nm = DEREF_hashid(id_name(id));
-    LIST ( TYPE ) ts = DEREF_list ( id_builtin_ptypes ( id ) ) ;
+	LIST(TYPE) ts = DEREF_list(id_builtin_ptypes(id));
+	/* Find operator */
+	if (IS_hashid_op(nm)) {
+		op = DEREF_int(hashid_op_lex(nm));
+	} else {
+		op = lex_func_Hop;
+	}
+	/* Shouldn't have no arguments */
+	if (IS_NULL_list(args)) {
+		e = make_error_exp(0);
+		return (e);
+	}
-    /* Find operator */
-    if ( IS_hashid_op ( nm ) ) {
-	op = DEREF_int ( hashid_op_lex ( nm ) ) ;
-    } else {
-	op = lex_func_Hop ;
-    }
-    /* Shouldn't have no arguments */
-    if ( IS_NULL_list ( args ) ) {
-	e = make_error_exp ( 0 ) ;
-	return ( e ) ;
-    }
-    /* Convert first argument */
+	/* Convert first argument */
-    DESTROY_CONS_exp ( destroy, a, args, args ) ;
+	DESTROY_CONS_exp(destroy, a, args, args);
-    t = DEREF_type ( HEAD_list ( ts ) ) ;
+	t = DEREF_type(HEAD_list(ts));
-    a = convert_builtin ( t, a, op, ( unsigned ) 1 ) ;
+	a = convert_builtin(t, a, op,(unsigned)1);
-    /* Allow for 'operator ()' */
-    if ( op == lex_func_Hop ) {
-	overload_depth++ ;
-	e = make_func_exp ( a, args, 0 ) ;
-	overload_depth-- ;
-	return ( e ) ;
-    }
-    /* Allow for unary operators */
+	/* Allow for 'operator ()' */
-    if ( IS_NULL_list ( args ) ) {
+	if (op == lex_func_Hop) {
-	overload_depth++ ;
+		overload_depth++;
-	e = apply_unary ( op, a, NULL_type, NULL_type, 0 ) ;
+		e = make_func_exp(a, args, 0);
-	overload_depth-- ;
+		overload_depth--;
-	return ( e ) ;
+		return (e);
-    }
+	}
-    /* Convert second argument */
+	/* Allow for unary operators */
-    DESTROY_CONS_exp ( destroy, b, args, args ) ;
+	if (IS_NULL_list(args)) {
+		overload_depth++;
-    t = DEREF_type ( HEAD_list ( TAIL_list ( ts ) ) ) ;
+		e = apply_unary(op, a, NULL_type, NULL_type, 0);
-    b = convert_builtin ( t, b, op, ( unsigned ) 1 ) ;
+		overload_depth--;
+		return (e);
+	}
+	/* Convert second argument */
+	DESTROY_CONS_exp(destroy, b, args, args);
+	t = DEREF_type(HEAD_list(TAIL_list(ts)));
+	b = convert_builtin(t, b, op,(unsigned)1);
-    /* Allow for binary operators */
+	/* Allow for binary operators */
-    if ( IS_NULL_list ( args ) ) {
+	if (IS_NULL_list(args)) {
-	overload_depth++ ;
+		overload_depth++;
-	e = apply_binary ( op, a, b, NULL_type, NULL_type, 0 ) ;
+		e = apply_binary(op, a, b, NULL_type, NULL_type, 0);
-	overload_depth-- ;
+		overload_depth--;
-	return ( e ) ;
+		return (e);
-    }
+	}
-    /* Shouldn't have more than two arguments */
+	/* Shouldn't have more than two arguments */
-    DESTROY_list ( args, SIZE_exp ) ;
+	DESTROY_list(args, SIZE_exp);
-    e = make_error_exp ( 0 ) ;
+	e = make_error_exp(0);
-    return ( e ) ;
+	return (e);
+}
 /*
     OVERLOAD DEPTH FLAG
     This flag is used to keep track of the depth of overloaded operator
     resolutions.
 */
-int overload_depth = 0 ;
+int overload_depth = 0;
-int overload_warn = 1 ;
+int overload_warn = 1;
 /*
     OPERATOR OVERLOADING ROUTINES
     only covers genuine overloading operators such as 'operator +', the
     allocation operators such as 'operator new' are handled by the routine
     check_allocator and alloc is set accordingly.
 */
-TYPE check_operator
+TYPE
-    PROTO_N ( ( t, id, mem, alloc ) )
-    PROTO_T ( TYPE t X IDENTIFIER id X int mem X int *alloc )
+check_operator(TYPE t, IDENTIFIER id, int mem, int *alloc)
+{
-    int op ;
+	int op;
-    int ell ;
+	int ell;
-    HASHID nm ;
+	HASHID nm;
-    int dargs = 0 ;
+	int dargs = 0;
-    unsigned n, m ;
+	unsigned n, m;
-    unsigned npars ;
+	unsigned npars;
-    LIST ( TYPE ) ptypes ;
+	LIST(TYPE) ptypes;
-    /* Allow for template types */
+	/* Allow for template types */
-    if ( IS_type_templ ( t ) ) {
+	if (IS_type_templ(t)) {
-	TYPE s = DEREF_type ( type_templ_defn ( t ) ) ;
+		TYPE s = DEREF_type(type_templ_defn(t));
-	s = check_operator ( s, id, mem, alloc ) ;
+		s = check_operator(s, id, mem, alloc);
-	COPY_type ( type_templ_defn ( t ), s ) ;
+		COPY_type(type_templ_defn(t), s);
-	return ( t ) ;
+		return (t);
-    }
+	}
-    /* Find the operator */
+	/* Find the operator */
-    nm = DEREF_hashid ( id_name ( id ) ) ;
+	nm = DEREF_hashid(id_name(id));
-    op = DEREF_int ( hashid_op_lex ( nm ) ) ;
+	op = DEREF_int(hashid_op_lex(nm));
-    switch ( op ) {
+	switch (op) {
-	case lex_new :
+	case lex_new:
-	case lex_new_Harray : {
+	case lex_new_Harray:
-	    /* Check for allocation operators */
+		/* Check for allocation operators */
-	    *alloc = 1 ;
+		*alloc = 1;
-	    t = check_allocator ( t, id, mem, 0 ) ;
+		t = check_allocator(t, id, mem, 0);
-	    return ( t ) ;
+		return (t);
-	}
-	case lex_delete :
+	case lex_delete:
-	case lex_delete_Harray : {
+	case lex_delete_Harray:
-	    /* Check for deallocation operators */
+		/* Check for deallocation operators */
-	    *alloc = 2 ;
+		*alloc = 2;
-	    t = check_allocator ( t, id, mem, 0 ) ;
+		t = check_allocator(t, id, mem, 0);
-	    return ( t ) ;
+		return (t);
-	}
-	default : {
+	default:
-	    *alloc = 0 ;
+		*alloc = 0;
-	    break ;
+		break;
 	}
-    }
-    /* Decompose function type */
+	/* Decompose function type */
-    ptypes = DEREF_list ( type_func_ptypes ( t ) ) ;
+	ptypes = DEREF_list(type_func_ptypes(t));
-    npars = LENGTH_list ( ptypes ) ;
+	npars = LENGTH_list(ptypes);
-    ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
+	ell = DEREF_int(type_func_ellipsis(t));
-    if ( ell ) {
+	if (ell) {
-	/* Set number of parameters to dummy large value */
+		/* Set number of parameters to dummy large value */
-	npars = 10000 ;
+		npars = 10000;
-    }
+	}
-    /* Check function arguments */
+	/* Check function arguments */
-    if ( mem ) {
+	if (mem) {
-	/* Member functions have implicit extra parameter */
+		/* Member functions have implicit extra parameter */
-	npars++ ;
+		npars++;
-	n = 0 ;
+		n = 0;
-	m = 1 ;
+		m = 1;
-    } else {
+	} else {
-	/* Should have an overloadable parameter */
+		/* Should have an overloadable parameter */
-	LIST ( TYPE ) p = ptypes ;
+		LIST(TYPE) p = ptypes;
-	while ( !IS_NULL_list ( p ) ) {
+		while (!IS_NULL_list(p)) {
-	    TYPE a = DEREF_type ( HEAD_list ( p ) ) ;
+			TYPE a = DEREF_type(HEAD_list(p));
-	    unsigned ca = type_category ( &a ) ;
+			unsigned ca = type_category(&a);
-	    if ( IS_TYPE_OVERLOAD ( ca ) ) break ;
+			if (IS_TYPE_OVERLOAD(ca)) {
+				break;
+			}
-	    p = TAIL_list ( p ) ;
+			p = TAIL_list(p);
-	}
+		}
-	if ( IS_NULL_list ( p ) ) {
+		if (IS_NULL_list(p)) {
-	    report ( crt_loc, ERR_over_oper_type ( nm ) ) ;
+			report(crt_loc, ERR_over_oper_type(nm));
-	}
+		}
-	n = 1 ;
+		n = 1;
-	m = 2 ;
+		m = 2;
-    }
+	}
-    /* Check number of arguments */
+	/* Check number of arguments */
-    switch ( op ) {
+	switch (op) {
-	case lex_compl_H1 :
+	case lex_compl_H1:
-	case lex_not_H1 :
+	case lex_not_H1:
-	case lex_abs :
+	case lex_abs:
-	case lex_alignof :
+	case lex_alignof:
-	case lex_sizeof :
+	case lex_sizeof:
-	case lex_typeid :
+	case lex_typeid:
-	case lex_vtable : {
+	case lex_vtable:
-	    /* Unary operators */
+		/* Unary operators */
-	    if ( npars != 1 ) {
+		if (npars != 1) {
-		ERROR err = ERR_over_unary_pars ( nm, n, n ) ;
+			ERROR err = ERR_over_unary_pars(nm, n, n);
-		report ( crt_loc, err ) ;
+			report(crt_loc, err);
-	    }
+		}
-	    break ;
+		break;
-	}
-	case lex_plus :
+	case lex_plus:
-	case lex_minus :
+	case lex_minus:
-	case lex_star :
+	case lex_star:
-	case lex_and_H1 : {
+	case lex_and_H1:
-	    /* Either unary or binary operators */
+		/* Either unary or binary operators */
-	    if ( npars != 1 && npars != 2 ) {
+		if (npars != 1 && npars != 2) {
-		ERROR err = ERR_over_binary_pars_p1 ( nm, n, m, m ) ;
+			ERROR err = ERR_over_binary_pars_p1(nm, n, m, m);
-		report ( crt_loc, err ) ;
+			report(crt_loc, err);
-	    }
+		}
-	    break ;
+		break;
-	}
-	default : {
+	default:
-	    /* Binary operators */
+		/* Binary operators */
-	    if ( npars != 2 ) {
+		if (npars != 2) {
-		ERROR err = ERR_over_binary_pars_p2 ( nm, m, m ) ;
+			ERROR err = ERR_over_binary_pars_p2(nm, m, m);
-		report ( crt_loc, err ) ;
+			report(crt_loc, err);
-	    }
+		}
-	    break ;
+		break;
-	}
-	case lex_assign : {
+	case lex_assign:
-	    /* Assignment */
+		/* Assignment */
-	    if ( !mem ) report ( crt_loc, ERR_over_ass_mem ( nm ) ) ;
-	    if ( npars != 2 ) {
-		ERROR err = ERR_over_ass_pars ( nm, m, m ) ;
-		report ( crt_loc, err ) ;
-	    }
-	    break ;
-	}
-	case lex_func_Hop : {
-	    /* Function call (can have default arguments) */
-	    if ( !mem ) report ( crt_loc, ERR_over_call_mem ( nm ) ) ;
-	    dargs = 1 ;
-	    break ;
-	}
-	case lex_array_Hop : {
-	    /* Subscripting */
-	    if ( !mem ) report ( crt_loc, ERR_over_sub_mem ( nm ) ) ;
-	    if ( npars != 2 ) {
-		ERROR err = ERR_over_sub_pars ( nm, m, m ) ;
-		report ( crt_loc, err ) ;
-	    }
-	    break ;
-	}
-	case lex_arrow : {
-	    /* Class member access */
-	    if ( !mem ) report ( crt_loc, ERR_over_ref_mem ( nm ) ) ;
-	    if ( npars != 1 ) {
-		ERROR err = ERR_over_ref_pars ( nm, n, n ) ;
-		report ( crt_loc, err ) ;
-	    }
-	    break ;
+		if (!mem) {
-	}
-	case lex_plus_Hplus :
-	case lex_minus_Hminus : {
-	    /* Increment and decrement */
-	    if ( npars == 1 ) {
-		/* One argument form is fine */
-		/* EMPTY */
-	    } else if ( npars == 2 ) {
-		/* Two argument form needs checking */
-		TYPE a ;
-		TYPE b = type_sint ;
-		LIST ( TYPE ) p = ptypes ;
-		if ( !mem ) p = TAIL_list ( p ) ;
-		a = DEREF_type ( HEAD_list ( p ) ) ;
-		if ( !eq_type_unqual ( a, b ) && !is_templ_type ( a ) ) {
-		    /* Second argument should be 'int' */
-		    report ( crt_loc, ERR_over_inc_pars_p2 ( nm, b ) ) ;
+			report(crt_loc, ERR_over_ass_mem(nm));
+		}
+		if (npars != 2) {
+			ERROR err = ERR_over_ass_pars(nm, m, m);
+			report(crt_loc, err);
+		}
+		break;
+	case lex_func_Hop:
+		/* Function call (can have default arguments) */
-	    } else {
+		if (!mem) {
+			report(crt_loc, ERR_over_call_mem(nm));
+		}
+		dargs = 1;
+		break;
+	case lex_array_Hop:
+		/* Subscripting */
+		if (!mem) {
+			report(crt_loc, ERR_over_sub_mem(nm));
+		}
+		if (npars != 2) {
+			ERROR err = ERR_over_sub_pars(nm, m, m);
+			report(crt_loc, err);
+		}
+		break;
+	case lex_arrow:
-		/* Anything else is illegal */
+		/* Class member access */
+		if (!mem) {
+			report(crt_loc, ERR_over_ref_mem(nm));
+		}
+		if (npars != 1) {
-		ERROR err = ERR_over_inc_pars ( nm, n, m, m ) ;
+			ERROR err = ERR_over_ref_pars(nm, n, n);
-		report ( crt_loc, err ) ;
+			report(crt_loc, err);
-	    }
+		}
-	    break ;
+		break;
+	case lex_plus_Hplus:
+	case lex_minus_Hminus:
+		/* Increment and decrement */
+		if (npars == 1) {
+			/* One argument form is fine */
+			/* EMPTY */
+		} else if (npars == 2) {
+			/* Two argument form needs checking */
+			TYPE a;
+			TYPE b = type_sint;
+			LIST(TYPE) p = ptypes;
+			if (!mem) {
+				p = TAIL_list(p);
+			}
+			a = DEREF_type(HEAD_list(p));
+			if (!eq_type_unqual(a, b) && !is_templ_type(a)) {
+				/* Second argument should be 'int' */
+				report(crt_loc, ERR_over_inc_pars_p2(nm, b));
+			}
+		} else {
+			/* Anything else is illegal */
+			ERROR err = ERR_over_inc_pars(nm, n, m, m);
+			report(crt_loc, err);
-	}
+		}
+		break;
-	case lex_cond_Hop : {
+	case lex_cond_Hop:
-	    /* Tertiary operators */
+		/* Tertiary operators */
-	    if ( npars != 3 ) {
+		if (npars != 3) {
-		unsigned p = n + 2 ;
+			unsigned p = n + 2;
-		ERROR err = ERR_over_binary_pars_p2 ( nm, p, p ) ;
+			ERROR err = ERR_over_binary_pars_p2(nm, p, p);
-		report ( crt_loc, err ) ;
+			report(crt_loc, err);
-	    }
+		}
-	    break ;
+		break;
+	}
-    }
-    /* Check for default arguments */
+	/* Check for default arguments */
-    if ( !dargs && check_func_dargs ( t, 0, 0 ) ) {
+	if (!dargs && check_func_dargs(t, 0, 0)) {
-	report ( crt_loc, ERR_over_oper_default ( nm ) ) ;
+		report(crt_loc, ERR_over_oper_default(nm));
-    }
+	}
-    return ( t ) ;
+	return (t);
 }
 /*
     LISTS OF BUILT-IN OPERATORS
     These values are used in the allocation and deallocation of built-in
     operators.
 */
-static IDENTIFIER unary_free = NULL_id ;
+static IDENTIFIER unary_free = NULL_id;
-static IDENTIFIER unary_all = NULL_id ;
+static IDENTIFIER unary_all = NULL_id;
-static IDENTIFIER binary_free = NULL_id ;
+static IDENTIFIER binary_free = NULL_id;
-static IDENTIFIER binary_all = NULL_id ;
+static IDENTIFIER binary_all = NULL_id;
-static IDENTIFIER nary_free = NULL_id ;
+static IDENTIFIER nary_free = NULL_id;
-static IDENTIFIER nary_all = NULL_id ;
+static IDENTIFIER nary_all = NULL_id;
 /*
     CONSTRUCT A BUILT-IN UNARY OPERATOR
     This routine constructs the built-in unary operator 'r nm ( a )'.
 */
-static IDENTIFIER unary_builtin
+static IDENTIFIER
-    PROTO_N ( ( nm, a, r ) )
-    PROTO_T ( HASHID nm X TYPE a X TYPE r )
+unary_builtin(HASHID nm, TYPE a, TYPE r)
+{
-    LIST ( TYPE ) p ;
+	LIST(TYPE) p;
-    IDENTIFIER id = unary_free ;
+	IDENTIFIER id = unary_free;
-    if ( IS_NULL_id ( id ) ) {
+	if (IS_NULL_id(id)) {
-	/* Allocate new identifier */
+		/* Allocate new identifier */
-	NAMESPACE ns = NULL_nspace ;
+		NAMESPACE ns = NULL_nspace;
-	CONS_type ( a, NULL_list ( TYPE ), p ) ;
+		CONS_type(a, NULL_list(TYPE), p);
-	MAKE_id_builtin ( nm, dspec_none, ns, builtin_loc, r, p, id ) ;
+		MAKE_id_builtin(nm, dspec_none, ns, builtin_loc, r, p, id);
-	COPY_id ( id_alias ( id ), unary_all ) ;
+		COPY_id(id_alias(id), unary_all);
-	unary_all = id ;
+		unary_all = id;
-    } else {
+	} else {
-	/* Use existing identifier */
+		/* Use existing identifier */
-	COPY_hashid ( id_name ( id ), nm ) ;
+		COPY_hashid(id_name(id), nm);
-	COPY_ulong ( id_dump ( id ), LINK_NONE ) ;
+		COPY_ulong(id_dump(id), LINK_NONE);
-	COPY_type ( id_builtin_ret ( id ), r ) ;
+		COPY_type(id_builtin_ret(id), r);
-	p = DEREF_list ( id_builtin_ptypes ( id ) ) ;
+		p = DEREF_list(id_builtin_ptypes(id));
-	COPY_type ( HEAD_list ( p ), a ) ;
+		COPY_type(HEAD_list(p), a);
-	unary_free = DEREF_id ( id_alias ( id ) ) ;
+		unary_free = DEREF_id(id_alias(id));
-    }
+	}
-    return ( id ) ;
+	return (id);
+}
 /*
     CONSTRUCT A BUILT-IN BINARY OPERATOR
     This routine constructs the built-in binary operator 'r nm ( a, b )'.
 */
-static IDENTIFIER binary_builtin
+static IDENTIFIER
-    PROTO_N ( ( nm, a, b, r ) )
-    PROTO_T ( HASHID nm X TYPE a X TYPE b X TYPE r )
+binary_builtin(HASHID nm, TYPE a, TYPE b, TYPE r)
+{
-    LIST ( TYPE ) p ;
+	LIST(TYPE) p;
-    IDENTIFIER id = binary_free ;
+	IDENTIFIER id = binary_free;
-    if ( IS_NULL_id ( id ) ) {
+	if (IS_NULL_id(id)) {
-	/* Allocate new identifier */
+		/* Allocate new identifier */
-	NAMESPACE ns = NULL_nspace ;
+		NAMESPACE ns = NULL_nspace;
-	CONS_type ( b, NULL_list ( TYPE ), p ) ;
+		CONS_type(b, NULL_list(TYPE), p);
-	CONS_type ( a, p, p ) ;
+		CONS_type(a, p, p);
-	MAKE_id_builtin ( nm, dspec_none, ns, builtin_loc, r, p, id ) ;
+		MAKE_id_builtin(nm, dspec_none, ns, builtin_loc, r, p, id);
-	COPY_id ( id_alias ( id ), binary_all ) ;
+		COPY_id(id_alias(id), binary_all);
-	binary_all = id ;
+		binary_all = id;
-    } else {
+	} else {
-	/* Use existing identifier */
+		/* Use existing identifier */
-	COPY_hashid ( id_name ( id ), nm ) ;
+		COPY_hashid(id_name(id), nm);
-	COPY_ulong ( id_dump ( id ), LINK_NONE ) ;
+		COPY_ulong(id_dump(id), LINK_NONE);
-	COPY_type ( id_builtin_ret ( id ), r ) ;
+		COPY_type(id_builtin_ret(id), r);
-	p = DEREF_list ( id_builtin_ptypes ( id ) ) ;
+		p = DEREF_list(id_builtin_ptypes(id));
-	COPY_type ( HEAD_list ( p ), a ) ;
+		COPY_type(HEAD_list(p), a);
-	p = TAIL_list ( p ) ;
+		p = TAIL_list(p);
-	COPY_type ( HEAD_list ( p ), b ) ;
+		COPY_type(HEAD_list(p), b);
-	binary_free = DEREF_id ( id_alias ( id ) ) ;
+		binary_free = DEREF_id(id_alias(id));
-    }
+	}
-    return ( id ) ;
+	return (id);
+}
 /*
     CONSTRUCT A BUILT-IN N-ARY OPERATOR
     This routine constructs the built-in n-ary operator 'r nm ( a, p )'.
 */
-static IDENTIFIER nary_builtin
+static IDENTIFIER
-    PROTO_N ( ( nm, a, p, r ) )
-    PROTO_T ( HASHID nm X TYPE a X LIST ( TYPE ) p X TYPE r )
+nary_builtin(HASHID nm, TYPE a, LIST(TYPE) p, TYPE r)
+{
-    IDENTIFIER id = nary_free ;
+	IDENTIFIER id = nary_free;
-    if ( IS_NULL_id ( id ) ) {
+	if (IS_NULL_id(id)) {
-	/* Allocate new identifier */
+		/* Allocate new identifier */
-	NAMESPACE ns = NULL_nspace ;
+		NAMESPACE ns = NULL_nspace;
-	CONS_type ( a, p, p ) ;
+		CONS_type(a, p, p);
-	MAKE_id_builtin ( nm, dspec_none, ns, builtin_loc, r, p, id ) ;
+		MAKE_id_builtin(nm, dspec_none, ns, builtin_loc, r, p, id);
-	COPY_id ( id_alias ( id ), nary_all ) ;
+		COPY_id(id_alias(id), nary_all);
-	nary_all = id ;
+		nary_all = id;
-    } else {
+	} else {
-	/* Use existing identifier */
+		/* Use existing identifier */
-	LIST ( TYPE ) q ;
+		LIST(TYPE) q;
-	COPY_hashid ( id_name ( id ), nm ) ;
+		COPY_hashid(id_name(id), nm);
-	COPY_ulong ( id_dump ( id ), LINK_NONE ) ;
+		COPY_ulong(id_dump(id), LINK_NONE);
-	COPY_type ( id_builtin_ret ( id ), r ) ;
+		COPY_type(id_builtin_ret(id), r);
-	q = DEREF_list ( id_builtin_ptypes ( id ) ) ;
+		q = DEREF_list(id_builtin_ptypes(id));
-	COPY_type ( HEAD_list ( q ), a ) ;
+		COPY_type(HEAD_list(q), a);
-	COPY_list ( PTR_TAIL_list ( q ), p ) ;
+		COPY_list(PTR_TAIL_list(q), p);
-	nary_free = DEREF_id ( id_alias ( id ) ) ;
+		nary_free = DEREF_id(id_alias(id));
-    }
+	}
-    return ( id ) ;
+	return (id);
+}
 /*
     CONSTRUCT OVERLOADED OPERATION CANDIDATE LIST
     This routine constructs the candidate list for the overloaded n-ary
     operation op, adding the result to p.  The candidates come from the
     current namespace and the type t, if this is a class.  The routine
     returns the hash table entry for 'operator op'.
 */
-static HASHID overload_candidates
+static HASHID
-    PROTO_N ( ( p, op, t, s ) )
-    PROTO_T ( CANDIDATE_LIST *p X int op X TYPE t X TYPE s )
+overload_candidates(CANDIDATE_LIST *p, int op, TYPE t, TYPE s)
-{
-    /* Look up 'operator op' (non-standard) */
-    HASHID nm = lookup_op ( op ) ;
-    switch ( op ) {
-	case lex_assign :
-	case lex_func_Hop :
-	case lex_array_Hop :
-	case lex_arrow : {
-	    /* These can only be member functions */
-	    break ;
-	}
-	default : {
-	    /* These can be non-member functions */
-	    IDENTIFIER id = find_op_id ( nm ) ;
-	    if ( !IS_NULL_type ( s ) ) {
-		IGNORE koenig_candidates ( p, id, s, KIND_OP ) ;
-	    }
-	    IGNORE koenig_candidates ( p, id, t, KIND_OP ) ;
-	    if ( !IS_id_dummy ( id ) ) {
-		/* Function declared */
-		add_candidates ( p, id, 1, KIND_OP ) ;
-	    }
-	    break ;
-	}
-    }
-    /* Look up 't::operator op' */
-    if ( IS_type_compound ( t ) ) {
-	CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
-	NAMESPACE ns = DEREF_nspace ( ctype_member ( ct ) ) ;
-	IDENTIFIER id = search_field ( ns, nm, 0, 0 ) ;
-	if ( !IS_NULL_id ( id ) ) {
-	    if ( IS_id_ambig ( id ) ) {
-		/* Ambiguous look-up */
-		IGNORE report_ambiguous ( id, 0, 1, 0 ) ;
-	    }
-	    add_candidates ( p, id, 1, KIND_MEM_OP ) ;
-	}
-    }
-    return ( nm ) ;
-}
-/*
-    CONSTRUCT LIST OF INTEGRAL TYPES
-    This routine adds all the promoted integral types to the list res.
-*/
-static LIST ( TYPE ) add_int_types
-    PROTO_N ( ( res ) )
-    PROTO_T ( LIST ( TYPE ) res )
+{
-    if ( basetype_info [ ntype_sllong ].key ) {
+	/* Look up 'operator op' (non-standard) */
+	HASHID nm = lookup_op(op);
+	switch (op) {
+	case lex_assign:
+	case lex_func_Hop:
+	case lex_array_Hop:
+	case lex_arrow:
-	res = cons_type_set ( res, type_ullong ) ;
+		/* These can only be member functions */
+		break;
+	default: {
-	res = cons_type_set ( res, type_sllong ) ;
+		/* These can be non-member functions */
+		IDENTIFIER id = find_op_id(nm);
+		if (!IS_NULL_type(s)) {
+			IGNORE koenig_candidates(p, id, s, KIND_OP);
-    }
+		}
-    res = cons_type_set ( res, type_ulong ) ;
+		IGNORE koenig_candidates(p, id, t, KIND_OP);
+		if (!IS_id_dummy(id)) {
+			/* Function declared */
+			add_candidates(p, id, 1, KIND_OP);
+		}
+		break;
+	}
+	}
+	/* Look up 't::operator op' */
+	if (IS_type_compound(t)) {
-    res = cons_type_set ( res, type_slong ) ;
+		CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));
-    res = cons_type_set ( res, type_uint ) ;
+		NAMESPACE ns = DEREF_nspace(ctype_member(ct));
+		IDENTIFIER id = search_field(ns, nm, 0, 0);
+		if (!IS_NULL_id(id)) {
+			if (IS_id_ambig(id)) {
+				/* Ambiguous look-up */
+				IGNORE report_ambiguous(id, 0, 1, 0);
+			}
-    res = cons_type_set ( res, type_sint ) ;
+			add_candidates(p, id, 1, KIND_MEM_OP);
+		}
+	}
-    return ( res ) ;
+	return (nm);
+}
 /*
+    CONSTRUCT LIST OF INTEGRAL TYPES
+    This routine adds all the promoted integral types to the list res.
+*/
+static LIST(TYPE)
+add_int_types(LIST(TYPE) res)
+{
+	if (basetype_info[ntype_sllong].key) {
+		res = cons_type_set(res, type_ullong);
+		res = cons_type_set(res, type_sllong);
+	}
+	res = cons_type_set(res, type_ulong);
+	res = cons_type_set(res, type_slong);
+	res = cons_type_set(res, type_uint);
+	res = cons_type_set(res, type_sint);
+	return (res);
+}
+/*
     CONSTRUCT LIST OF FLOATING POINT TYPES
     This routine adds all the floating point types to the list res.
 */
-static LIST ( TYPE ) add_float_types
+static LIST(TYPE)
-    PROTO_N ( ( res ) )
-    PROTO_T ( LIST ( TYPE ) res )
+add_float_types(LIST(TYPE) res)
+{
-    res = cons_type_set ( res, type_ldouble ) ;
+	res = cons_type_set(res, type_ldouble);
-    res = cons_type_set ( res, type_double ) ;
+	res = cons_type_set(res, type_double);
-    res = cons_type_set ( res, type_float ) ;
+	res = cons_type_set(res, type_float);
-    return ( res ) ;
+	return (res);
+}
 /*
     CONSTRUCT A LIST OF CONVERSION TYPES
     This routine constructs a list of types consisting of all the types
     of a certain kind to which the type t can be converted.  Conversions
     is indicated by the CTYPE macros defined in chktype.h, except that
     CTYPE_INTEGER refers to promoted integer types unless qualified using
     CTYPE_LVALUE.
 */
-static LIST ( TYPE ) find_type_convs
+static LIST(TYPE)
-    PROTO_N ( ( t, a, kind ) )
-    PROTO_T ( TYPE t X EXP a X unsigned kind )
+find_type_convs(TYPE t, EXP a, unsigned kind)
+{
-    LIST ( TYPE ) res = NULL_list ( TYPE ) ;
+	LIST(TYPE) res = NULL_list(TYPE);
-    unsigned nt = TAG_type ( t ) ;
+	unsigned nt = TAG_type(t);
-    switch ( nt ) {
+	switch (nt) {
-	case type_compound_tag : {
+	case type_compound_tag: {
-	    /* Class types */
+		/* Class types */
-	    LIST ( IDENTIFIER ) conv ;
+		LIST(IDENTIFIER) conv;
-	    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
+		CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));
-	    complete_class ( ct, 1 ) ;
+		complete_class(ct, 1);
-	    conv = DEREF_list ( ctype_conv ( ct ) ) ;
+		conv = DEREF_list(ctype_conv(ct));
-	    for ( ; !IS_NULL_list ( conv ) ; conv = TAIL_list ( conv ) ) {
+		for (; !IS_NULL_list(conv); conv = TAIL_list(conv)) {
-		/* Scan through conversion operations */
+			/* Scan through conversion operations */
-		TYPE r ;
+			TYPE r;
-		HASHID nm ;
+			HASHID nm;
-		unsigned nr ;
+			unsigned nr;
-		IDENTIFIER id = DEREF_id ( HEAD_list ( conv ) ) ;
+			IDENTIFIER id = DEREF_id(HEAD_list(conv));
-		DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
+			DECL_SPEC ds = DEREF_dspec(id_storage(id));
-		if ( ds & dspec_explicit ) continue ;
+			if (ds & dspec_explicit) {
+				continue;
+			}
+			/* Check for reference types */
+			nm = DEREF_hashid(id_name(id));
+			r = DEREF_type(hashid_conv_type(nm));
+			if (kind == CTYPE_NONE) {
+				/* Include all types in this case */
+				res = cons_type_set(res, r);
+				continue;
+			}
+			nr = TAG_type(r);
+			if (nr == type_ref_tag) {
+				/* Allow for reference bindings */
+				if (IS_TYPE_LVALUE(kind)) {
+					TYPE s = DEREF_type(type_ref_sub(r));
+					CV_SPEC cv = find_cv_qual(s);
+					if (!(cv & cv_const)) {
+						/* Don't include const
+						 * references */
+						unsigned ns = TAG_type(s);
+						switch (ns) {
+						case type_integer_tag:
+						case type_bitfield_tag:
+						case type_enumerate_tag:
+							if (IS_TYPE_INTEGER(kind)) {
+								res = cons_type_set(res, r);
+							}
+							break;
+						case type_floating_tag:
+							if (IS_TYPE_FLOAT(kind)) {
+								res = cons_type_set(res, r);
+							}
+							break;
+						case type_ptr_tag:
+							if (IS_TYPE_PTR(kind)) {
+								res = cons_type_set(res, r);
+							}
+							break;
+						case type_ptr_mem_tag:
+							if (IS_TYPE_PTR_MEM(kind)) {
+								res = cons_type_set(res, r);
+							}
+							break;
+						}
+					}
+				} else {
+					/* Allow for reference conversions */
+					r = DEREF_type(type_ref_sub(r));
+					nr = TAG_type(r);
+				}
+			}
-		/* Check for reference types */
+			/* Check return type */
-		nm = DEREF_hashid ( id_name ( id ) ) ;
-		r = DEREF_type ( hashid_conv_type ( nm ) ) ;
-		if ( kind == CTYPE_NONE ) {
-		    /* Include all types in this case */
-		    res = cons_type_set ( res, r ) ;
-		    continue ;
-		}
-		nr = TAG_type ( r ) ;
-		if ( nr == type_ref_tag ) {
-		    /* Allow for reference bindings */
-		    if ( IS_TYPE_LVALUE ( kind ) ) {
-			TYPE s = DEREF_type ( type_ref_sub ( r ) ) ;
-			CV_SPEC cv = find_cv_qual ( s ) ;
-			if ( !( cv & cv_const ) ) {
-			    /* Don't include const references */
-			    unsigned ns = TAG_type ( s ) ;
-			    switch ( ns ) {
+			switch (nr) {
-				case type_integer_tag :
+			case type_integer_tag:
-				case type_bitfield_tag :
+			case type_bitfield_tag:
-				case type_enumerate_tag : {
+			case type_enumerate_tag:
-				    if ( IS_TYPE_INTEGER ( kind ) ) {
-					res = cons_type_set ( res, r ) ;
-				    }
-				    break ;
+				/* Integral types */
-				}
-				case type_floating_tag : {
-				    if ( IS_TYPE_FLOAT ( kind ) ) {
+				if (IS_TYPE_INTEGER(kind)) {
-					res = cons_type_set ( res, r ) ;
+					/* Means promoted integer type */
-				    }
-				    break ;
+					TYPE s = promote_type(r);
-				}
-				case type_ptr_tag : {
+					res = cons_type_set(res, s);
-				    if ( IS_TYPE_PTR ( kind ) ) {
+				} else if (IS_TYPE_FLOAT(kind)) {
-					res = cons_type_set ( res, r ) ;
+					/* Can convert to any floating type */
-				    }
-				    break ;
+					res = add_float_types(res);
+				}
+				break;
+			case type_floating_tag:
+				/* Floating point types */
+				if (IS_TYPE_FLOAT(kind)) {
+					res = cons_type_set(res, r);
+				} else if (IS_TYPE_INTEGER(kind)) {
+					/* Can convert to any promoted integer
+					 * type */
+					res = add_int_types(res);
+				}
+				break;
-				case type_ptr_mem_tag : {
+			case type_ptr_tag:
+				/* Pointer types */
-				    if ( IS_TYPE_PTR_MEM ( kind ) ) {
+				if (IS_TYPE_PTR(kind)) {
-					res = cons_type_set ( res, r ) ;
+					res = cons_type_set(res, r);
-				    }
+				}
-				    break ;
+				break;
+			case type_ptr_mem_tag:
+				/* Pointer to member types */
+				if (IS_TYPE_PTR_MEM(kind)) {
+					res = cons_type_set(res, r);
 				}
-			    }
+				break;
+			}
-		    } else {
-			/* Allow for reference conversions */
-			r = DEREF_type ( type_ref_sub ( r ) ) ;
-			nr = TAG_type ( r ) ;
-		    }
+		}
-		/* Check return type */
+		res = REVERSE_list(res);
-		switch ( nr ) {
+		break;
+	}
-		    case type_integer_tag :
+	case type_integer_tag:
-		    case type_bitfield_tag :
+	case type_bitfield_tag:
-		    case type_enumerate_tag : {
+	case type_enumerate_tag:
-			/* Integral types */
+		/* Integral types */
-			if ( IS_TYPE_INTEGER ( kind ) ) {
+		if (IS_TYPE_LVALUE(kind)) {
-			    /* Means promoted integer type */
+			/* Lvalue of integral type */
-			    TYPE s = promote_type ( r ) ;
+			if (IS_TYPE_INTEGER(kind)) {
-			    res = cons_type_set ( res, s ) ;
+				if (nt == type_integer_tag) {
-			} else if ( IS_TYPE_FLOAT ( kind ) ) {
+					t = lvalue_type(t);
-			    /* Can convert to any floating type */
+					MAKE_type_ref(cv_none, t, t);
-			    res = add_float_types ( res ) ;
+					CONS_type(t, res, res);
-			}
+				}
-			break ;
-		    }
+			}
-		    case type_floating_tag : {
+		} else if (IS_TYPE_INTEGER(kind)) {
-			/* Floating point types */
+			/* Means promoted integer type */
-			if ( IS_TYPE_FLOAT ( kind ) ) {
+			TYPE s = promote_type(t);
-			    res = cons_type_set ( res, r ) ;
+			CONS_type(s, res, res);
-			} else if ( IS_TYPE_INTEGER ( kind ) ) {
+		} else if (IS_TYPE_FLOAT(kind)) {
-			    /* Can convert to any promoted integer type */
+			/* Can convert to any floating type */
-			    res = add_int_types ( res ) ;
+			res = add_float_types(res);
-			}
+		}
-			break ;
+		break;
-		    }
-		    case type_ptr_tag : {
+	case type_floating_tag:
-			/* Pointer types */
+		/* Floating point types */
+		if (IS_TYPE_LVALUE(kind)) {
+			/* Lvalue of floating point type */
-			if ( IS_TYPE_PTR ( kind ) ) {
+			if (IS_TYPE_FLOAT(kind)) {
+				t = lvalue_type(t);
+				MAKE_type_ref(cv_none, t, t);
-			    res = cons_type_set ( res, r ) ;
+				CONS_type(t, res, res);
+			}
+		} else if (IS_TYPE_FLOAT(kind)) {
-			break ;
+			/* Floating point type */
-		    }
+			CONS_type(t, res, res);
-		    case type_ptr_mem_tag : {
+		} else if (IS_TYPE_INTEGER(kind)) {
-			/* Pointer to member types */
+			/* Can convert to any promoted integer type */
-			if ( IS_TYPE_PTR_MEM ( kind ) ) {
+			if (basetype_info[ntype_sllong].key) {
+				CONS_type(type_ullong, res, res);
-			    res = cons_type_set ( res, r ) ;
+				CONS_type(type_sllong, res, res);
+			}
+			CONS_type(type_ulong, res, res);
+			CONS_type(type_slong, res, res);
+			CONS_type(type_uint, res, res);
+			CONS_type(type_sint, res, res);
+		}
-			break ;
+		break;
+	case type_ptr_tag:
+		/* Pointer types */
+		if (IS_TYPE_PTR(kind)) {
+			if (IS_TYPE_LVALUE(kind)) {
+				t = lvalue_type(t);
+				MAKE_type_ref(cv_none, t, t);
+			}
+			CONS_type(t, res, res);
+		}
+		break;
+	case type_ptr_mem_tag:
+		/* Pointer to member types */
+		if (IS_TYPE_PTR_MEM(kind)) {
+			if (IS_TYPE_LVALUE(kind)) {
+				t = lvalue_type(t);
+				MAKE_type_ref(cv_none, t, t);
-		    }
+			}
+			CONS_type(t, res, res);
+		}
+		break;
+	case type_array_tag:
+		/* Allow for array-to-pointer conversion */
+		if (IS_TYPE_PTR(kind) && !IS_TYPE_LVALUE(kind)) {
+			TYPE s = DEREF_type(type_array_sub(t));
+			MAKE_type_ptr(cv_none, s, s);
+			CONS_type(s, res, res);
+		}
+		if (kind == CTYPE_NONE) {
+			TYPE s = DEREF_type(type_array_sub(t));
+			MAKE_type_ptr(cv_none, s, t);
+		}
+		break;
+	case type_func_tag:
+		/* Allow for function-to-pointer conversion */
+		if (IS_TYPE_PTR(kind) && !IS_TYPE_LVALUE(kind)) {
+			TYPE s;
+			MAKE_type_ptr(cv_none, t, s);
+			CONS_type(s, res, res);
+		}
+		if (kind == CTYPE_NONE) {
+			MAKE_type_ptr(cv_none, t, t);
+		}
-	    }
-	    res = REVERSE_list ( res ) ;
-	    break ;
+		break;
+	}
-	case type_integer_tag :
-	case type_bitfield_tag :
-	case type_enumerate_tag : {
-	    /* Integral types */
-	    if ( IS_TYPE_LVALUE ( kind ) ) {
-		/* Lvalue of integral type */
-		if ( IS_TYPE_INTEGER ( kind ) ) {
-		    if ( nt == type_integer_tag ) {
+	if (kind == CTYPE_NONE) {
-			t = lvalue_type ( t ) ;
-			MAKE_type_ref ( cv_none, t, t ) ;
-			CONS_type ( t, res, res ) ;
-		    }
-		}
-	    } else if ( IS_TYPE_INTEGER ( kind ) ) {
-		/* Means promoted integer type */
-		TYPE s = promote_type ( t ) ;
-		CONS_type ( s, res, res ) ;
-	    } else if ( IS_TYPE_FLOAT ( kind ) ) {
-		/* Can convert to any floating type */
-		res = add_float_types ( res ) ;
-	    }
-	    break ;
-	}
-	case type_floating_tag : {
-	    /* Floating point types */
-	    if ( IS_TYPE_LVALUE ( kind ) ) {
-		/* Lvalue of floating point type */
+		/* Include all types in this case */
-		if ( IS_TYPE_FLOAT ( kind ) ) {
-		    t = lvalue_type ( t ) ;
-		    MAKE_type_ref ( cv_none, t, t ) ;
-		    CONS_type ( t, res, res ) ;
-		}
-	    } else if ( IS_TYPE_FLOAT ( kind ) ) {
-		/* Floating point type */
-		CONS_type ( t, res, res ) ;
-	    } else if ( IS_TYPE_INTEGER ( kind ) ) {
-		/* Can convert to any promoted integer type */
-		if ( basetype_info [ ntype_sllong ].key ) {
-		    CONS_type ( type_ullong, res, res ) ;
-		    CONS_type ( type_sllong, res, res ) ;
-		}
-		CONS_type ( type_ulong, res, res ) ;
-		CONS_type ( type_slong, res, res ) ;
-		CONS_type ( type_uint, res, res ) ;
-		CONS_type ( type_sint, res, res ) ;
+		CV_SPEC cv = DEREF_cv(type_qual(t));
-	    }
-	    break ;
-	}
-	case type_ptr_tag : {
-	    /* Pointer types */
-	    if ( IS_TYPE_PTR ( kind ) ) {
-		if ( IS_TYPE_LVALUE ( kind ) ) {
-		    t = lvalue_type ( t ) ;
+		if (cv & cv_lvalue) {
-		    MAKE_type_ref ( cv_none, t, t ) ;
-		}
-		CONS_type ( t, res, res ) ;
-	    }
-	    break ;
-	}
-	case type_ptr_mem_tag : {
-	    /* Pointer to member types */
+			/* Turn lvalues into references */
-	    if ( IS_TYPE_PTR_MEM ( kind ) ) {
-		if ( IS_TYPE_LVALUE ( kind ) ) {
-		    t = lvalue_type ( t ) ;
-		    MAKE_type_ref ( cv_none, t, t ) ;
+			MAKE_type_ref(cv_none, t, t);
+		}
-		CONS_type ( t, res, res ) ;
+		res = cons_type_set(res, t);
-	    }
-	    break ;
-	}
-	case type_array_tag : {
-	    /* Allow for array-to-pointer conversion */
-	    if ( IS_TYPE_PTR ( kind ) && !IS_TYPE_LVALUE ( kind ) ) {
-		TYPE s = DEREF_type ( type_array_sub ( t ) ) ;
-		MAKE_type_ptr ( cv_none, s, s ) ;
-		CONS_type ( s, res, res ) ;
-	    }
-	    if ( kind == CTYPE_NONE ) {
-		TYPE s = DEREF_type ( type_array_sub ( t ) ) ;
-		MAKE_type_ptr ( cv_none, s, t ) ;
-	    }
-	    break ;
-	}
-	case type_func_tag : {
-	    /* Allow for function-to-pointer conversion */
-	    if ( IS_TYPE_PTR ( kind ) && !IS_TYPE_LVALUE ( kind ) ) {
-		TYPE s ;
-		MAKE_type_ptr ( cv_none, t, s ) ;
-		CONS_type ( s, res, res ) ;
-	    }
-	    if ( kind == CTYPE_NONE ) {
-		MAKE_type_ptr ( cv_none, t, t ) ;
-	    }
-	    break ;
-	}
-    }
-    if ( kind == CTYPE_NONE ) {
-	/* Include all types in this case */
-	CV_SPEC cv = DEREF_cv ( type_qual ( t ) ) ;
-	if ( cv & cv_lvalue ) {
-	    /* Turn lvalues into references */
-	    MAKE_type_ref ( cv_none, t, t ) ;
+	}
-	res = cons_type_set ( res, t ) ;
-    }
-    UNUSED ( a ) ;
+	UNUSED(a);
-    return ( res ) ;
+	return (res);
+}
 /*
     FILTER A LIST OF POINTER TYPES
     types pa replacing any types which are not pointers to complete object
     types by the null type.  If fn is true pointer to function types are
     also allowed.
 */
-static void filter_ptr
+static void
-    PROTO_N ( ( pa, fn ) )
-    PROTO_T ( LIST ( TYPE ) pa X int fn )
+filter_ptr(LIST(TYPE) pa, int fn)
+{
-    while ( !IS_NULL_list ( pa ) ) {
+	while (!IS_NULL_list(pa)) {
-	TYPE ta = DEREF_type ( HEAD_list ( pa ) ) ;
+		TYPE ta = DEREF_type(HEAD_list(pa));
-	TYPE sa = ta ;
+		TYPE sa = ta;
-	if ( IS_type_ref ( sa ) ) {
+		if (IS_type_ref(sa)) {
-	    sa = DEREF_type ( type_ref_sub ( sa ) ) ;
+			sa = DEREF_type(type_ref_sub(sa));
-	}
+		}
-	if ( IS_type_ptr ( sa ) ) {
+		if (IS_type_ptr(sa)) {
-	    sa = DEREF_type ( type_ptr_sub ( sa ) ) ;
+			sa = DEREF_type(type_ptr_sub(sa));
-	} else {
+		} else {
-	    sa = DEREF_type ( type_ptr_mem_sub ( sa ) ) ;
+			sa = DEREF_type(type_ptr_mem_sub(sa));
-	}
+		}
-	switch ( TAG_type ( sa ) ) {
+		switch (TAG_type(sa)) {
-	    case type_array_tag : {
+		case type_array_tag: {
-		/* Check for incomplete arrays */
+			/* Check for incomplete arrays */
-		NAT n = DEREF_nat ( type_array_size ( sa ) ) ;
+			NAT n = DEREF_nat(type_array_size(sa));
-		if ( IS_NULL_nat ( n ) ) ta = NULL_type ;
+			if (IS_NULL_nat(n)) {
+				ta = NULL_type;
+			}
-		break ;
+			break;
-	    }
+		}
-	    case type_compound_tag : {
+		case type_compound_tag: {
-		/* Check for incomplete classes */
+			/* Check for incomplete classes */
-		CLASS_TYPE cs = DEREF_ctype ( type_compound_defn ( sa ) ) ;
+			CLASS_TYPE cs = DEREF_ctype(type_compound_defn(sa));
-		CLASS_INFO ci = DEREF_cinfo ( ctype_info ( cs ) ) ;
+			CLASS_INFO ci = DEREF_cinfo(ctype_info(cs));
-		if ( !( ci & cinfo_complete ) ) ta = NULL_type ;
+			if (!(ci & cinfo_complete)) {
+				ta = NULL_type;
+			}
-		break ;
+			break;
-	    }
+		}
-	    case type_enumerate_tag : {
+		case type_enumerate_tag: {
-		/* Check for incomplete enumerations */
+			/* Check for incomplete enumerations */
-		ENUM_TYPE es = DEREF_etype ( type_enumerate_defn ( sa ) ) ;
+			ENUM_TYPE es = DEREF_etype(type_enumerate_defn(sa));
-		CLASS_INFO ei = DEREF_cinfo ( etype_info ( es ) ) ;
+			CLASS_INFO ei = DEREF_cinfo(etype_info(es));
-		if ( !( ei & cinfo_complete ) ) ta = NULL_type ;
+			if (!(ei & cinfo_complete)) {
+				ta = NULL_type;
+			}
-		break ;
+			break;
-	    }
+		}
-	    case type_top_tag :
+		case type_top_tag:
-	    case type_bottom_tag : {
+		case type_bottom_tag:
-		/* These are always incomplete */
+			/* These are always incomplete */
-		ta = NULL_type ;
+			ta = NULL_type;
-		break ;
+			break;
-	    }
-	    case type_func_tag : {
+		case type_func_tag:
-		/* Deal with function types */
+			/* Deal with function types */
+			if (!fn) {
-		if ( !fn ) ta = NULL_type ;
+				ta = NULL_type;
+			}
-		break ;
+			break;
-	    }
+		}
+		COPY_type(HEAD_list(pa), ta);
+		pa = TAIL_list(pa);
+	}
-	COPY_type ( HEAD_list ( pa ), ta ) ;
-	pa = TAIL_list ( pa ) ;
-    }
-    return ;
+	return;
+}
 /*
     BUILT-IN OPERATOR TYPES
     The following macros are used to describe the return types and the
     constraints on the operand types of the built-in operators.
     This routine finds the return type for a built-in operator with
     operand types ta and tb and return descriptor rtype.  tc gives the
     default return type.  The return type is not used in overload
     resolution but is included for error reporting purposes.
 */
-static TYPE find_builtin_ret
+static TYPE
-    PROTO_N ( ( ta, tb, rtype, tc ) )
-    PROTO_T ( TYPE ta X TYPE tb X int rtype X TYPE tc )
+find_builtin_ret(TYPE ta, TYPE tb, int rtype, TYPE tc)
 {
-    switch ( rtype ) {
+	switch (rtype) {
-	case RTYPE_ARG_1 : {
+	case RTYPE_ARG_1:
-	    tc = ta ;
+		tc = ta;
-	    break ;
+		break;
-	}
-	case RTYPE_ARG_2 : {
+	case RTYPE_ARG_2:
-	    tc = tb ;
+		tc = tb;
-	    break ;
+		break;
-	}
-	case RTYPE_CONT_1 : {
+	case RTYPE_CONT_1:
-	    if ( IS_type_ptr_etc ( ta ) ) {
+		if (IS_type_ptr_etc(ta)) {
-		tc = DEREF_type ( type_ptr_etc_sub ( ta ) ) ;
+			tc = DEREF_type(type_ptr_etc_sub(ta));
-	    }
+		}
-	    break ;
+		break;
-	}
-	case RTYPE_CONT_2 : {
+	case RTYPE_CONT_2:
-	    if ( IS_type_ptr_etc ( tb ) ) {
+		if (IS_type_ptr_etc(tb)) {
-		tc = DEREF_type ( type_ptr_etc_sub ( tb ) ) ;
+			tc = DEREF_type(type_ptr_etc_sub(tb));
-	    }
+		}
-	    break ;
+		break;
-	}
-	case RTYPE_ARITH : {
+	case RTYPE_ARITH:
-	    tc = arith_type ( ta, tb, NULL_exp, NULL_exp ) ;
+		tc = arith_type(ta, tb, NULL_exp, NULL_exp);
-	    break ;
+		break;
-	}
-	case RTYPE_BOOL : {
+	case RTYPE_BOOL:
-	    tc = type_bool ;
+		tc = type_bool;
-	    break ;
+		break;
-	}
-	case RTYPE_PTRDIFF : {
+	case RTYPE_PTRDIFF:
-	    tc = type_ptrdiff_t ;
+		tc = type_ptrdiff_t;
-	    break ;
+		break;
 	}
-    }
-    return ( tc ) ;
+	return (tc);
 }
 /*
     CHECK BUILT-IN OPERAND TYPES
     This routine checks whether the operand types ta and tb are valid for
     a built-in operator with operand constraints otype.  In some cases
     the return type is returned via pt.
 */
-static int check_builtin_args
+static int
-    PROTO_N ( ( ta, tb, otype, pt ) )
-    PROTO_T ( TYPE ta X TYPE tb X int otype X TYPE *pt )
+check_builtin_args(TYPE ta, TYPE tb, int otype, TYPE *pt)
+{
-    int ok = 1 ;
+	int ok = 1;
-    switch ( otype ) {
+	switch (otype) {
-	case OTYPE_PTR : {
+	case OTYPE_PTR: {
-	    /* Allow equal pointer types */
+		/* Allow equal pointer types */
-	    TYPE sa = DEREF_type ( type_ptr_sub ( ta ) ) ;
+		TYPE sa = DEREF_type(type_ptr_sub(ta));
-	    TYPE sb = DEREF_type ( type_ptr_sub ( tb ) ) ;
+		TYPE sb = DEREF_type(type_ptr_sub(tb));
-	    ok = eq_type_unqual ( sa, sb ) ;
+		ok = eq_type_unqual(sa, sb);
-	    break ;
+		break;
 	}
-	case OTYPE_PTR_MEM : {
+	case OTYPE_PTR_MEM: {
-	    /* Allow equal pointer member types */
+		/* Allow equal pointer member types */
-	    CLASS_TYPE ca = DEREF_ctype ( type_ptr_mem_of ( ta ) ) ;
+		CLASS_TYPE ca = DEREF_ctype(type_ptr_mem_of(ta));
-	    CLASS_TYPE cb = DEREF_ctype ( type_ptr_mem_of ( tb ) ) ;
+		CLASS_TYPE cb = DEREF_ctype(type_ptr_mem_of(tb));
-	    if ( eq_ctype ( ca, cb ) ) {
+		if (eq_ctype(ca, cb)) {
-		TYPE sa = DEREF_type ( type_ptr_mem_sub ( ta ) ) ;
+			TYPE sa = DEREF_type(type_ptr_mem_sub(ta));
-		TYPE sb = DEREF_type ( type_ptr_mem_sub ( tb ) ) ;
+			TYPE sb = DEREF_type(type_ptr_mem_sub(tb));
-		ok = eq_type_unqual ( sa, sb ) ;
+			ok = eq_type_unqual(sa, sb);
-	    } else {
+		} else {
-		ok = 0 ;
+			ok = 0;
-	    }
+		}
-	    break ;
+		break;
 	}
-	case OTYPE_REF_PTR : {
+	case OTYPE_REF_PTR:
-	    /* Allow equal pointer types */
+		/* Allow equal pointer types */
-	    if ( IS_type_ref ( ta ) ) {
-		ta = DEREF_type ( type_ref_sub ( ta ) ) ;
-	    }
-	    return ( check_builtin_args ( ta, tb, OTYPE_PTR, pt ) ) ;
-	}
-	case OTYPE_REF_MEM : {
-	    /* Allow equal pointer member types */
-	    if ( IS_type_ref ( ta ) ) {
-		ta = DEREF_type ( type_ref_sub ( ta ) ) ;
-	    }
-	    return ( check_builtin_args ( ta, tb, OTYPE_PTR_MEM, pt ) ) ;
-	}
-	case OTYPE_SELECT : {
-	    /* Allow pointer member selection */
-	    TYPE sa = DEREF_type ( type_ptr_sub ( ta ) ) ;
-	    if ( IS_type_compound ( sa ) ) {
-		CLASS_TYPE ca = DEREF_ctype ( type_compound_defn ( sa ) ) ;
-		CLASS_TYPE cb = DEREF_ctype ( type_ptr_mem_of ( tb ) ) ;
-		GRAPH gr = find_base_class ( ca, cb, 0 ) ;
-		if ( IS_NULL_graph ( gr ) ) ok = 0 ;
-		*pt = DEREF_type ( type_ptr_mem_sub ( tb ) ) ;
-	    } else {
-		ok = 0 ;
-	    }
-	    break ;
-	}
-	case OTYPE_COND : {
-	    /* Allow for conditional expressions */
-	    int suspect = 0 ;
-	    TYPE r = common_type ( ta, tb, &suspect ) ;
-	    if ( IS_NULL_type ( r ) ) {
-		ok = 0 ;
-		if ( IS_type_ref ( ta ) ) {
+		if (IS_type_ref(ta)) {
-		    ta = DEREF_type ( type_ref_sub ( ta ) ) ;
+			ta = DEREF_type(type_ref_sub(ta));
-		    ok = 1 ;
-		}
-		if ( IS_type_ref ( tb ) ) {
-		    tb = DEREF_type ( type_ref_sub ( tb ) ) ;
-		    ok = 1 ;
+		}
-		if ( ok ) {
+		return (check_builtin_args(ta, tb, OTYPE_PTR, pt));
-		    suspect = 0 ;
+	case OTYPE_REF_MEM:
-		    r = common_type ( ta, tb, &suspect ) ;
+		/* Allow equal pointer member types */
-		    if ( IS_NULL_type ( r ) ) {
+		if (IS_type_ref(ta)) {
-			ok = 0 ;
-		    } else {
+			ta = DEREF_type(type_ref_sub(ta));
-			*pt = r ;
-		    }
+		}
+		return (check_builtin_args(ta, tb, OTYPE_PTR_MEM, pt));
+	case OTYPE_SELECT: {
+		/* Allow pointer member selection */
+		TYPE sa = DEREF_type(type_ptr_sub(ta));
+		if (IS_type_compound(sa)) {
+			CLASS_TYPE ca = DEREF_ctype(type_compound_defn(sa));
+			CLASS_TYPE cb = DEREF_ctype(type_ptr_mem_of(tb));
+			GRAPH gr = find_base_class(ca, cb, 0);
+			if (IS_NULL_graph(gr))ok = 0;
+			*pt = DEREF_type(type_ptr_mem_sub(tb));
+		} else {
+			ok = 0;
+		}
+		break;
+	}
+	case OTYPE_COND: {
+		/* Allow for conditional expressions */
+		int suspect = 0;
+		TYPE r = common_type(ta, tb, &suspect);
+		if (IS_NULL_type(r)) {
+			ok = 0;
+			if (IS_type_ref(ta)) {
+				ta = DEREF_type(type_ref_sub(ta));
+				ok = 1;
+			}
+			if (IS_type_ref(tb)) {
+				tb = DEREF_type(type_ref_sub(tb));
+				ok = 1;
+			}
+			if (ok) {
+				suspect = 0;
+				r = common_type(ta, tb, &suspect);
+				if (IS_NULL_type(r)) {
+					ok = 0;
-	    } else {
+				} else {
+					*pt = r;
+				}
+			}
+		} else {
-		*pt = r ;
+			*pt = r;
-	    }
+		}
-	    break ;
+		break;
+	}
+	}
-    }
-    return ( ok ) ;
+	return (ok);
 }
 /*
     ADD A LIST OF BUILT-IN UNARY CANDIDATES
     This routine adds a series of built-in unary candidates for the
     operator nm to the list p.  The possible operand types are given by pa.
     rtype describes how to form the return type from the operand type.
 */
-static void add_unary_builtin
+static void
-    PROTO_N ( ( p, nm, pa, rtype ) )
-    PROTO_T ( CANDIDATE_LIST *p X HASHID nm X LIST ( TYPE ) pa X int rtype )
+add_unary_builtin(CANDIDATE_LIST *p, HASHID nm, LIST(TYPE) pa, int rtype)
 {
-    while ( !IS_NULL_list ( pa ) ) {
+	while (!IS_NULL_list(pa)) {
-	TYPE ta = DEREF_type ( HEAD_list ( pa ) ) ;
+		TYPE ta = DEREF_type(HEAD_list(pa));
-	if ( !IS_NULL_type ( ta ) ) {
+		if (!IS_NULL_type(ta)) {
-	    TYPE tb = find_builtin_ret ( ta, ta, rtype, type_error ) ;
+			TYPE tb = find_builtin_ret(ta, ta, rtype, type_error);
-	    IDENTIFIER id = unary_builtin ( nm, ta, tb ) ;
+			IDENTIFIER id = unary_builtin(nm, ta, tb);
-	    add_candidates ( p, id, 1, KIND_BUILTIN ) ;
+			add_candidates(p, id, 1, KIND_BUILTIN);
+		}
+		pa = TAIL_list(pa);
+	}
-	pa = TAIL_list ( pa ) ;
-    }
-    DESTROY_list ( pa, SIZE_type ) ;
+	DESTROY_list(pa, SIZE_type);
-    return ;
+	return;
+}
 /*
     ADD A LIST OF BUILT-IN BINARY CANDIDATES
     are given by pa and pb.  rtype describes how to form the return type
     from the operand types, otype describes any restrictions on the operand
     types.
 */
-static void add_binary_builtin
+static void
-    PROTO_N ( ( p, nm, pa, pb, rtype, otype ) )
-    PROTO_T ( CANDIDATE_LIST *p X HASHID nm X LIST ( TYPE ) pa X
+add_binary_builtin(CANDIDATE_LIST *p, HASHID nm, LIST(TYPE) pa, LIST(TYPE) pb,
-	      LIST ( TYPE ) pb X int rtype X int otype )
+		   int rtype, int otype)
+{
-    while ( !IS_NULL_list ( pa ) ) {
+    while (!IS_NULL_list(pa)) {
-	TYPE ta = DEREF_type ( HEAD_list ( pa ) ) ;
+	TYPE ta = DEREF_type(HEAD_list(pa));
-	if ( !IS_NULL_type ( ta ) ) {
+	if (!IS_NULL_type(ta)) {
-	    LIST ( TYPE ) pc = pb ;
+	    LIST(TYPE) pc = pb;
-	    while ( !IS_NULL_list ( pc ) ) {
+	    while (!IS_NULL_list(pc)) {
-		TYPE tb = DEREF_type ( HEAD_list ( pc ) ) ;
+		TYPE tb = DEREF_type(HEAD_list(pc));
-		if ( !IS_NULL_type ( tb ) ) {
+		if (!IS_NULL_type(tb)) {
 		    /* Check operand types */
-		    TYPE tc = type_error ;
+		    TYPE tc = type_error;
-		    if ( check_builtin_args ( ta, tb, otype, &tc ) ) {
+		    if (check_builtin_args(ta, tb, otype, &tc)) {
-			IDENTIFIER id ;
+			IDENTIFIER id;
-			tc = find_builtin_ret ( ta, tb, rtype, tc ) ;
+			tc = find_builtin_ret(ta, tb, rtype, tc);
-			if ( otype == OTYPE_COND ) {
+			if (otype == OTYPE_COND) {
-			    ta = tc ;
+			    ta = tc;
-			    tb = tc ;
+			    tb = tc;
+			}
-			id = binary_builtin ( nm, ta, tb, tc ) ;
+			id = binary_builtin(nm, ta, tb, tc);
-			add_candidates ( p, id, 1, KIND_BUILTIN ) ;
+			add_candidates(p, id, 1, KIND_BUILTIN);
+		    }
+		}
-		pc = TAIL_list ( pc ) ;
+		pc = TAIL_list(pc);
+	    }
+	}
-	pa = TAIL_list ( pa ) ;
+	pa = TAIL_list(pa);
+    }
+    if (!EQ_list(pa, pb)) {
-    if ( !EQ_list ( pa, pb ) ) DESTROY_list ( pa, SIZE_type ) ;
+	    DESTROY_list(pa, SIZE_type);
+    }
-    DESTROY_list ( pb, SIZE_type ) ;
+    DESTROY_list(pb, SIZE_type);
-    return ;
+    return;
+}
 /*
     OVERLOAD A UNARY OPERATOR
     be 'a.operator op ()', 'operator op ( a )' or 'op t ( a )' for some
     type t.  Note that '->' is a special case for op, with 'a->b' being
     expanded as '( a.operator -> () )->b'.  This expansion is done in
     begin_field_exp, this routine returning the null expression to indicate
     that '->' is not overloaded.
     OVERLOAD A BINARY OPERATOR
     This routine calculates the binary overload operator 'a op b'.  This can
     be 'a.operator op ( b )', 'operator op ( a, b )' or 't ( a ) op s ( b )'
     for some types t and s.  Note that postfix '++' and '--' are special
     cases for op in which b is a dummy zero operand.
+	}
-    }
-    /* Search for overload operator */
-    if ( p->size ) {
-	CANDIDATE *q ;
-	unsigned rank ;
-	LIST ( EXP ) args ;
-	CONS_exp ( b, NULL_list ( EXP ), args ) ;
-	CONS_exp ( a, args, args ) ;
-	q = resolve_overload ( p, args, NULL_type, 0 ) ;
-	binary_free = binary_all ;
-	rank = q->rank ;
-	if ( rank >= RANK_VIABLE ) {
-	    /* Only allow viable resolutions */
-	    int kind = q->kind ;
-	    IDENTIFIER qid = q->func ;
-	    int ow = overload_warn ;
-	    if ( rank == RANK_BEST ) {
-		/* Unambiguous resolution */
-		if ( match_no_viable > 1 && ow ) {
-		    if ( do_dump ) dump_builtin ( qid ) ;
-		    report ( crt_loc, ERR_over_match_oper_ok ( qid ) ) ;
-		}
-	    } else {
-		/* Ambiguous resolution */
-		q = resolve_ambiguous ( p, args, NULL_type, 0 ) ;
-		qid = q->func ;
-		rank = q->rank ;
-		if ( rank == RANK_TARGET ) {
-		    ERROR err2 = ERR_over_match_oper_target ( op ) ;
-		    qid = make_ambig_func ( p, qid, args, qual_none, &err2 ) ;
-		    kind = KIND_OP ;
-		    if ( do_dump ) dump_builtin ( qid ) ;
-		    report ( crt_loc, err2 ) ;
-		} else if ( rank == RANK_VIABLE ) {
-		    ERROR err2 = ERR_over_match_oper_ambig ( op ) ;
-		    err2 = list_candidates ( err2, p, RANK_VIABLE ) ;
-		    report ( crt_loc, err2 ) ;
-		}
-		overload_warn = 0 ;
-	    }
-	    if ( kind == KIND_BUILTIN ) {
-		/* Built-in resolution */
-		if ( op == lex_comma ) {
-		    /* Return null expression for 'a, b' */
-		    DESTROY_list ( args, SIZE_exp ) ;
-		    e = NULL_exp ;
-		} else {
-		    e = apply_builtin ( qid, args ) ;
-		}
-	    } else {
-		/* Function resolution */
-		use_func_id ( qid, 0, suppress_usage ) ;
-		e = apply_func_id ( qid, qual_none, NULL_graph, args ) ;
-	    }
-	    overload_warn = ow ;
-	    return ( e ) ;
+	return (e);
-	}
-	DESTROY_list ( args, SIZE_exp ) ;
-    }
-    /* Try operation again */
-    if ( op == lex_comma ) {
-	/* Return null expression for 'a, b' */
-	e = NULL_exp ;
-    } else {
-	overload_depth++ ;
-	e = apply_binary ( op, a, b, NULL_type, NULL_type, 0 ) ;
-	overload_depth-- ;
-    }
-    return ( e ) ;
+}
 /*
     OVERLOAD A FUNCTION OPERATOR
     This routine calculates the function overload operator 'a ( args )'.
     This is expanded as 'a.operator () ( args )'.
 */
-EXP function_overload
+EXP
-    PROTO_N ( ( a, args ) )
-    PROTO_T ( EXP a X LIST ( EXP ) args )
+function_overload(EXP a, LIST(EXP)args)
+{
-    EXP e ;
+	EXP e;
-    int op = lex_func_Hop ;
+	int op = lex_func_Hop;
-    /* Construct candidate list */
+	/* Construct candidate list */
-    TYPE t = DEREF_type ( exp_type ( a ) ) ;
+	TYPE t = DEREF_type(exp_type(a));
-    CANDIDATE_LIST *p = &candidates ;
+	CANDIDATE_LIST *p = &candidates;
-    p->size = 0 ;
+	p->size = 0;
-    IGNORE overload_candidates ( p, op, t, NULL_type ) ;
+	IGNORE overload_candidates(p, op, t, NULL_type);
-    if ( IS_type_compound ( t ) ) {
+	if (IS_type_compound(t)) {
-	LIST ( IDENTIFIER ) conv ;
+		LIST(IDENTIFIER) conv;
-	HASHID nm = KEYWORD ( lex_zzzz ) ;
+		HASHID nm = KEYWORD(lex_zzzz);
-	CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
+		CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));
-	complete_class ( ct, 1 ) ;
+		complete_class(ct, 1);
-	conv = DEREF_list ( ctype_conv ( ct ) ) ;
+		conv = DEREF_list(ctype_conv(ct));
-	while ( !IS_NULL_list ( conv ) ) {
+		while (!IS_NULL_list(conv)) {
-	    /* Scan through conversion operations */
+			/* Scan through conversion operations */
-	    IDENTIFIER cid = DEREF_id ( HEAD_list ( conv ) ) ;
+			IDENTIFIER cid = DEREF_id(HEAD_list(conv));
-	    DECL_SPEC ds = DEREF_dspec ( id_storage ( cid ) ) ;
+			DECL_SPEC ds = DEREF_dspec(id_storage(cid));
-	    if ( !( ds & dspec_explicit ) ) {
+			if (!(ds & dspec_explicit)) {
-		HASHID cnm = DEREF_hashid ( id_name ( cid ) ) ;
+				HASHID cnm = DEREF_hashid(id_name(cid));
-		TYPE r = DEREF_type ( hashid_conv_type ( cnm ) ) ;
+				TYPE r = DEREF_type(hashid_conv_type(cnm));
-		unsigned nr = TAG_type ( r ) ;
+				unsigned nr = TAG_type(r);
-		/* Search for pointer or reference to functions */
-		if ( nr == type_ptr_tag || nr == type_ref_tag ) {
-		    TYPE s = DEREF_type ( type_ptr_etc_sub ( r ) ) ;
-		    if ( IS_type_func ( s ) ) {
-			LOCATION loc ;
-			LIST ( TYPE ) ptypes ;
-			TYPE ret = DEREF_type ( type_func_ret ( s ) ) ;
-			ptypes = DEREF_list ( type_func_ptypes ( s ) ) ;
-			DEREF_loc ( id_loc ( cid ), loc ) ;
-			cid = nary_builtin ( nm, r, ptypes, ret ) ;
-			COPY_loc ( id_loc ( cid ), loc ) ;
-			add_candidates ( p, cid, 1, KIND_BUILTIN ) ;
-		    }
-		}
-	    }
-	    conv = TAIL_list ( conv ) ;
-	}
-    }
-    /* Search for overload operator */
+				/* Search for pointer or reference to
-    if ( p->size ) {
+				 * functions */
-	CANDIDATE *q ;
+				if (nr == type_ptr_tag || nr == type_ref_tag) {
-	unsigned rank ;
+					TYPE s =
-	CONS_exp ( a, args, args ) ;
+					    DEREF_type(type_ptr_etc_sub(r));
-	q = resolve_overload ( p, args, NULL_type, 0 ) ;
+					if (IS_type_func(s)) {
-	nary_free = nary_all ;
+						LOCATION loc;
-	rank = q->rank ;
+						LIST(TYPE) ptypes;
-	if ( rank >= RANK_VIABLE ) {
+						TYPE ret = DEREF_type(type_func_ret(s));
-	    /* Only allow viable resolutions */
+						ptypes = DEREF_list(type_func_ptypes(s));
-	    int kind = q->kind ;
+						DEREF_loc(id_loc(cid), loc);
-	    IDENTIFIER qid = q->func ;
+						cid = nary_builtin(nm, r,
-	    int ow = overload_warn ;
+								   ptypes,
-	    if ( rank == RANK_BEST ) {
+								   ret);
-		/* Unambiguous resolution */
+						COPY_loc(id_loc(cid), loc);
-		if ( match_no_viable > 1 && ow ) {
+						add_candidates(p, cid, 1,
-		    if ( do_dump ) dump_builtin ( qid ) ;
+							       KIND_BUILTIN);
+					}
+				}
+			}
-		    report ( crt_loc, ERR_over_match_oper_ok ( qid ) ) ;
+			conv = TAIL_list(conv);
+		}
+	}
+	/* Search for overload operator */
+	if (p->size) {
+		CANDIDATE *q;
+		unsigned rank;
+		CONS_exp(a, args, args);
+		q = resolve_overload(p, args, NULL_type, 0);
+		nary_free = nary_all;
+		rank = q->rank;
+		if (rank >= RANK_VIABLE) {
+			/* Only allow viable resolutions */
+			int kind = q->kind;
+			IDENTIFIER qid = q->func;
+			int ow = overload_warn;
+			if (rank == RANK_BEST) {
+				/* Unambiguous resolution */
+				if (match_no_viable > 1 && ow) {
+					if (do_dump) {
+						dump_builtin(qid);
+					}
+					report(crt_loc,
+					       ERR_over_match_oper_ok(qid));
+				}
-	    } else {
+			} else {
-		/* Ambiguous resolution */
+				/* Ambiguous resolution */
-		q = resolve_ambiguous ( p, args, NULL_type, 0 ) ;
+				q = resolve_ambiguous(p, args, NULL_type, 0);
-		qid = q->func ;
+				qid = q->func;
-		rank = q->rank ;
+				rank = q->rank;
-		if ( rank == RANK_TARGET ) {
+				if (rank == RANK_TARGET) {
+					ERROR err =
-		    ERROR err = ERR_over_match_oper_target ( op ) ;
+					    ERR_over_match_oper_target(op);
-		    qid = make_ambig_func ( p, qid, args, qual_none, &err ) ;
+					qid = make_ambig_func(p, qid, args,
+							      qual_none, &err);
-		    kind = KIND_OP ;
+					kind = KIND_OP;
+					if (do_dump) {
-		    if ( do_dump ) dump_builtin ( qid ) ;
+						dump_builtin(qid);
+					}
-		    report ( crt_loc, err ) ;
+					report(crt_loc, err);
-		} else if ( rank == RANK_VIABLE ) {
+				} else if (rank == RANK_VIABLE) {
+					ERROR err =
-		    ERROR err = ERR_over_match_oper_ambig ( op ) ;
+					    ERR_over_match_oper_ambig(op);
-		    err = list_candidates ( err, p, RANK_VIABLE ) ;
+					err = list_candidates(err, p,
+							      RANK_VIABLE);
-		    report ( crt_loc, err ) ;
+					report(crt_loc, err);
+				}
+				overload_warn = 0;
+			}
+			if (kind == KIND_BUILTIN) {
+				/* Built-in resolution */
+				e = apply_builtin(qid, args);
+			} else {
+				/* Function resolution */
+				use_func_id(qid, 0, suppress_usage);
+				e = apply_func_id(qid, qual_none, NULL_graph,
+						  args);
+			}
+			overload_warn = ow;
+			return (e);
+		}
-		overload_warn = 0 ;
-	    }
-	    if ( kind == KIND_BUILTIN ) {
-		/* Built-in resolution */
-		e = apply_builtin ( qid, args ) ;
+		DESTROY_CONS_exp(destroy, a, args, args);
-	    } else {
-		/* Function resolution */
-		use_func_id ( qid, 0, suppress_usage ) ;
-		e = apply_func_id ( qid, qual_none, NULL_graph, args ) ;
-	    }
-	    overload_warn = ow ;
-	    return ( e ) ;
+	}
-	DESTROY_CONS_exp ( destroy, a, args, args ) ;
-    }
-    /* Try operation again with increased overload depth */
+	/* Try operation again with increased overload depth */
-    overload_depth++ ;
+	overload_depth++;
-    e = make_func_exp ( a, args, 0 ) ;
+	e = make_func_exp(a, args, 0);
-    overload_depth-- ;
+	overload_depth--;
-    return ( e ) ;
+	return (e);
+}
 #endif /* LANGUAGE_CPP */

Subversion Repositories tendra.SVN

(root)/branches/tendra5/src/producers/common/construct/operator.c – Rev 5 → 6