## initializer-normalizer.pkg
## AUTHORS: Dino Oliva (oliva@research.bell-labs.com)
# Compiled by:
# src/lib/c-kit/src/ast/ast.sublibpackage initializer_normalizer: (weak) Set_Up_Normalizer { # Set_Up_Normalizer is from src/lib/c-kit/src/ast/initializer-normalizer.api #
package raw_syntax = raw_syntax;
package b= namings; # namings is from src/lib/c-kit/src/ast/bindings.pkg include package raw_syntax;
exception NORMALIZE_EXCEPTION;
fun fail msg
=
{ print msg;
raise exception NORMALIZE_EXCEPTION;
};
# Does this signal an internal "compiler bug"?
# only acts as a warning, since normalize acts as an identity
# on the expression if this is called.
fun warn msg
=
{ print msg;
();
};
int_ct
=
raw_syntax::NUMERIC
( raw_syntax::NONSATURATE,
raw_syntax::WHOLENUM,
raw_syntax::SIGNED,
raw_syntax::INT,
raw_syntax::SIGNASSUMED
);
char_ct
=
raw_syntax::NUMERIC
( raw_syntax::NONSATURATE,
raw_syntax::WHOLENUM,
raw_syntax::UNSIGNED,
raw_syntax::CHAR,
raw_syntax::SIGNASSUMED
);
# David B MacQueen:
# The bindAid function introduces
# new aid mappings in the atab state
# component.
# This takes the type of a declaration
# and the initializer and massages the
# initializer so that it exactly matches
# the type of declaration. It is called
# in BuildRawSyntaxTree.
#
fun normalize
{
get_tid: tid::Uid -> Null_Or( namings::Tid_Naming ),
bind_aid: raw_syntax::Ctype -> aid::Uid,
init_type: raw_syntax::Ctype,
init_expr: raw_syntax::Init_Expression
}
: raw_syntax::Init_Expression
=
{ fun core_expression2expression (ctype, core_expression)
=
{ aid = bind_aid ctype;
EXPRESSION (core_expression, aid, line_number_db::UNKNOWN);
};
fun make_chr_init c
=
SIMPLE (core_expression2expression (char_ct, (INT_CONST (large_int::from_int (char::to_int c)))));
fun make_int_init i
=
SIMPLE (core_expression2expression (int_ct, (INT_CONST (i: large_int::Int))));
fun make_chrs (NULL, [] ) => [];
make_chrs (THE c, [] ) => [ make_chr_init c ];
make_chrs (c_opt, c ! cs) => make_chr_init c ! make_chrs (c_opt, cs);
end;
# padding out with zero (via scalarNorm)
# when too few initializers.
# as per [ISO-C, p.72-73]
#
fun arr_norm (arr_type, raw_syntax::QUAL (_, ctype), max_op) orig_inits # strip qual
=>
arr_norm (arr_type, ctype, max_op) orig_inits;
arr_norm (arr_type, raw_syntax::TYPE_REF tid, max_op) orig_inits # Dereference type REF
=>
case (get_tid tid)
THE { ntype => THE (b::TYPEDEFX (tid, ctype)), ... }
=>
arr_norm (arr_type, ctype, max_op) orig_inits;
_ => fail "Inconsistent table for type REF";
esac;
arr_norm (arr_type, raw_syntax::NUMERIC(_, _, _, raw_syntax::CHAR, _), max_op)
(SIMPLE (EXPRESSION (STRING_CONST s, aid, loc)) ! rest)
=>
# Secial case for character arrays initialized w/strings
#
{ len = (string::length_in_bytes s) + 1; # size of c string
max = case max_op
THE l => large_int::to_int l;
_ => len;
esac;
null_opt = if (len == max + 1) NULL;
else THE '\000';
fi;
char_inits
=
make_chrs (null_opt, explode s);
norm (arr_type, (AGGREGATE char_inits) ! rest);
};
arr_norm (arr_type, base_type, max_op) orig_inits
=>
{ max = case max_op
THE l => large_int::to_int l;
_ => length orig_inits;
esac;
fun loop (i, inits)
=
if (i==max)
([], inits);
else
my (elem_init, remainder ) = norm (base_type, inits);
my (elem_inits, remainder') = loop (i+1, remainder);
(elem_init ! elem_inits, remainder');
fi;
my (array_inits, remainder)
=
loop (0, orig_inits);
(AGGREGATE array_inits, remainder);
};
end
also
fun struct_norm (struct_type, fields) orig_inits
=
{ fun loop [] inits
=>
([], inits);
loop ((field_type, NULL, li_opt) ! fields) inits
=>
# According to the standard, unnamed fields don't
# have initializers.
#
loop fields inits;
loop ((field_type, pid_opt, li_opt) ! fields) inits
=>
{ my (field_init, remainder ) = norm (field_type, inits);
my (field_inits, remainder') = loop fields remainder;
(field_init ! field_inits, remainder');
};
end;
my (struct_inits, remainder)
=
loop fields orig_inits;
(AGGREGATE struct_inits, remainder);
}
also
fun union_norm (union_type, fields) orig_inits
=
case fields
[] => { warn "Empty union type, initializing to {}";
(AGGREGATE [], orig_inits);
};
(field_ctype, member) ! _
=>
{ my (field_init, remainder)
=
norm (field_ctype, orig_inits);
(AGGREGATE [field_init], remainder);
};
esac
# fill in with zeros if you run out of initializers
also
fun scalar_norm ctype orig_inits
=
case orig_inits
(scalar_init ! remainder)
=>
(scalar_init, remainder);
[] => { scalar_init = make_int_init 0;
(scalar_init, []);
};
esac
# feed supplies its argument initfn
# with the inits from the first aggregate,
# if there is one. The initfn should
# consume all the inits from the aggregate.
#
also
fun feed (initfn, (AGGREGATE elem_inits) ! inits)
=>
{ my (newinit, remainder)
=
initfn elem_inits;
case remainder
[] => (newinit, inits);
_ => { warn "Too many initializers for expression, ignoring extras";
(newinit, inits);
};
esac;
};
feed (initfn, inits)
=>
initfn inits;
end
also
fun norm (ctype, inits)
=
case ctype
raw_syntax::QUAL (_, ctype)
=>
norm (ctype, inits); # strip qual
raw_syntax::TYPE_REF tid # Dereference type REF
=>
case (get_tid tid)
THE { ntype => THE (b::TYPEDEFX (tid, ctype)), ... }
=>
norm (ctype, inits);
_ => fail "Inconsistent table for type REF";
esac;
raw_syntax::ARRAY (opt, base_type)
=>
{ len_op = case opt
THE (i, _) => THE i;
NULL => NULL;
esac;
feed (arr_norm (ctype, base_type, len_op), inits);
};
raw_syntax::STRUCT_REF tid
=>
case (get_tid tid)
THE { ntype => THE (b::STRUCT (tid, fields)), ... }
=>
feed (struct_norm (ctype, fields), inits);
THE _ => fail "Incomplete type for struct REF";
NULL => fail "Inconsistent table for struct REF";
esac;
raw_syntax::UNION_REF tid
=>
case (get_tid tid)
THE { ntype => THE (b::UNION (tid, fields)), ... }
=>
feed (union_norm (ctype, fields), inits);
THE _ => fail "Incomplete type for union REF";
NULL => fail "Inconsistent table for union REF";
esac;
( raw_syntax::NUMERIC _
| raw_syntax::POINTER _
| raw_syntax::FUNCTION _
| raw_syntax::ENUM_REF _
) =>
feed (scalar_norm ctype, inits);
raw_syntax::VOID => fail "Incomplete type: void";
raw_syntax::ELLIPSES => fail "Cannot initialize ellipses";
raw_syntax::ERROR => fail "Cannot initialize error type";
esac;
{ my (newinit, remainder)
=
norm (init_type, [init_expr]);
case remainder
[] => newinit; # Used them all.
_ => { warn "Too many initializers for expression, ignoring extras";
newinit;
};
esac;
}
except
NORMALIZE_EXCEPTION = init_expr;
}; # fun normalize
}; # package initializer_normalizer