node *OSbinop (node *arg_node, info *arg_info)
{
DBUG_ENTER("OSbinop");
/*
* Extremely important:
* we must continue to traverse the abstract syntax tree !!
*/
BINOP_LEFT( arg_node) = TRAVdo( BINOP_LEFT( arg_node), arg_info);
BINOP_RIGHT( arg_node) = TRAVdo( BINOP_RIGHT( arg_node), arg_info);
if (BINOP_OP( arg_node) == BO_sub) {
if ((NODE_TYPE( BINOP_LEFT( arg_node)) == N_var)
&& (NODE_TYPE( BINOP_RIGHT( arg_node)) == N_var)
&& STReq( VAR_NAME( BINOP_LEFT( arg_node)), VAR_NAME( BINOP_RIGHT( arg_node)))) {
arg_node = FREEdoFreeTree( arg_node);
arg_node = TBmakeNum( 0);
}
else if ((NODE_TYPE( BINOP_LEFT( arg_node)) == N_num)
&& (NODE_TYPE( BINOP_RIGHT( arg_node)) == N_num)
&& (NUM_VALUE( BINOP_LEFT( arg_node)) == NUM_VALUE( BINOP_RIGHT( arg_node)))) {
arg_node = FREEdoFreeTree( arg_node);
arg_node = TBmakeNum( 0);
}
}
DBUG_RETURN( arg_node);
}
/** <!--******************************************************************-->
*
* @fn CHKMvar
*
* @brief Touched the node and its sons/attributes
*
* @param arg_node Var node to process
* @param arg_info pointer to info structure
*
* @return processed node
*
***************************************************************************/
node *
CHKMvar (node * arg_node, info * arg_info)
{
DBUG_ENTER ("CHKMvar");
NODE_ERROR (arg_node) = CHKMTRAV (NODE_ERROR (arg_node), arg_info);
VAR_NAME (arg_node) = CHKMattribString (VAR_NAME (arg_node), arg_info);
VAR_DECL (arg_node) = CHKMattribLink (VAR_DECL (arg_node), arg_info);
DBUG_RETURN (arg_node);
}
/** <!--******************************************************************-->
*
* @fn COPYvar
*
* @brief Copies the node and its sons/attributes
*
* @param arg_node Var node to process
* @param arg_info pointer to info structure
*
* @return processed node
*
***************************************************************************/
node *
COPYvar (node * arg_node, info * arg_info)
{
node *result = TBmakeVar (NULL);
DBUG_ENTER ("COPYvar");
LUTinsertIntoLutP (INFO_LUT (arg_info), arg_node, result);
/* Copy attributes */
VAR_NAME (result) = STRcpy (VAR_NAME (arg_node));
VAR_DECL (result) =
LUTsearchInLutPp (INFO_LUT (arg_info), VAR_DECL (arg_node));
/* Return value */
DBUG_RETURN (result);
}
node *LVARglobaldef( node *arg_node, info *arg_info)
{
char *var_name;
DBUG_ENTER("LVARglobaldef");
var_name = VAR_NAME(GLOBALDEF_ID( arg_node));
/* set declaration of this global variable */
VAR_DECL(GLOBALDEF_ID( arg_node) ) = arg_node;
/* check for duplicated variable declaration */
if(hashmap_contains(arg_info->global, var_name)) {
CTIerror(":%d: error: '%s' has already been defined in this context",
NODE_LINE(arg_node), var_name);
CTIerror(":%d: error: location of earlier definition",
NODE_LINE((node *)hashmap_get(arg_info->global, var_name)));
DBUG_RETURN(arg_node);
}
/* add global variabele declaration to hashmap */
hashmap_add(arg_info->global, var_name, arg_node);
DBUG_RETURN( arg_node);
}
node *
PRTvar (node * arg_node, info * arg_info)
{
DBUG_ENTER ("PRTvar");
printf( "%s", VAR_NAME( arg_node));
DBUG_RETURN (arg_node);
}
static void
cljc_init (void)
{
GC_INIT ();
PTABLE_NAME (cljc_DOT_core_SLASH_Nil) = alloc_ptable (TYPE_Nil);
PTABLE_NAME (cljc_DOT_core_SLASH_Integer) = alloc_ptable (TYPE_Integer);
PTABLE_NAME (cljc_DOT_core_SLASH_Boolean) = alloc_ptable (TYPE_Boolean);
PTABLE_NAME (cljc_DOT_core_SLASH_Array) = alloc_ptable (TYPE_Array);
PTABLE_NAME (cljc_DOT_core_SLASH_Character) = alloc_ptable (TYPE_Character);
PTABLE_NAME (cljc_DOT_core_SLASH_String) = alloc_ptable (TYPE_String);
value_nil = alloc_value (PTABLE_NAME (cljc_DOT_core_SLASH_Nil), sizeof (value_t));
value_true = alloc_value (PTABLE_NAME (cljc_DOT_core_SLASH_Boolean), sizeof (value_t));
value_false = alloc_value (PTABLE_NAME (cljc_DOT_core_SLASH_Boolean), sizeof (value_t));
VAR_NAME (cljc_DOT_core_SLASH_print) = make_closure (cljc_core_print, NULL);
VAR_NAME (cljc_DOT_core_SLASH_apply) = make_closure (cljc_core_apply, NULL);
}
static const char *bdd_var_name (int index)
{
char *name;
/* Watch out when index is not associated with a name in the
var_table. This could happen when generating nameless bdd labels.
The macro VAR_NAME may then not be used.
*/
if (index >= var_table->size || EMPTY_BUCKET (var_table, index)) {
/* Think up dummy name, say _<index>, but no check is made whether
this name already exists!
*/
static char buf[16];
sprintf (buf, "_%d", index);
name = buf;
}
else
name = VAR_NAME (index);
return name;
}
node *LVARvar( node *arg_node, info *arg_info)
{
char *var_name;
node *var_dec;
DBUG_ENTER("LVARvar");
var_name = VAR_NAME(arg_node);
/* check for local variable declaration */
var_dec = hashmap_get(arg_info->local, var_name);
/* check for global variable declaration */
if(!var_dec)
var_dec = hashmap_get(arg_info->global, var_name);
if(var_dec)
VAR_DECL(arg_node) = var_dec;
else
CTIerror(":%d: error: unknown identifier '%s'", NODE_LINE(arg_node), var_name);
DBUG_RETURN( arg_node);
}
/* Must mutate original if changes required for consistency */
GLOBAL void FunctionConflict(Node *orig, Node *create)
{
Node *ofdcl, *nfdcl;
assert(orig);
assert(create);
assert(orig->typ == Decl);
assert(create->typ == Decl);
ofdcl = NodeDataType(orig);
nfdcl = NodeDataType(create);
if (ofdcl->typ != Fdcl || nfdcl->typ != Fdcl)
goto Mismatch;
/*
* Check if one declaration is T_PROCEDURE and the other is not.
* BUG: I think the whole way we treat 'cilk' and 'inlet' keywords
* is broken. We treat 'cilk' like 'const', but
*
* const int foo()
*
* is not the same as
*
* cilk int foo()
*
* The former returns a 'const int', but the latter does not return a
* 'cilk int' ! - athena
*
* BTW, the following line is a hack :-)
* ((ofdcl->u.fdcl.tq ^ nfdcl->u.fdcl.tq) & (T_PROCEDURE | T_INLET))
* Bradley rewrote it has follows:
*/
if ((tq_has_procedure(ofdcl->u.fdcl.tq) != tq_has_procedure(nfdcl->u.fdcl.tq))
|| (tq_has_inlet(ofdcl->u.fdcl.tq) != tq_has_inlet(nfdcl->u.fdcl.tq)))
goto Mismatch;
/* The Result Type must be equal */
if (!TypeEqual(ofdcl->u.fdcl.returns, nfdcl->u.fdcl.returns))
goto Mismatch;
/* Inspect the parameter lists */
{
List *optr = ofdcl->u.fdcl.args, *nptr = nfdcl->u.fdcl.args;
/* Are both definitions in prototype form? */
if (optr && nptr) {
/* Then every parameter must be compatible */
for (; optr && nptr; optr = Rest(optr), nptr = Rest(nptr)) {
Node *oitem = FirstItem(optr), *otype = NodeDataType(oitem),
*nitem = FirstItem(nptr), *ntype = NodeDataType(nitem);
if (!TypeEqualFormals(otype, ntype)) {
SetItem(optr, nitem);
goto Mismatch;
}
}
/* And the parameter lists must be of the same length */
if (optr || nptr)
goto Mismatch;
}
/* Check for <Type> f(void) vs <Type> f() */
else if (IsVoidArglist(optr));
/* Check for <Type> f() vs <Type> f(void) */
else if (IsVoidArglist(nptr))
ofdcl->u.fdcl.args = MakeNewList(PrimVoid);
/* Else the provided types must be the "usual unary conversions" */
else {
/* Either this loop will run */
for (; optr; optr = Rest(optr)) {
Node *oitem = FirstItem(optr), *otype = NodeDataType(oitem);
if (!TypeEqual(otype, UsualUnaryConversionType(otype)) ||
IsEllipsis(otype))
goto Mismatch;
}
/* Or this one will */
for (; nptr; nptr = Rest(nptr)) {
Node *nitem = FirstItem(nptr), *ntype = NodeDataType(nitem);
if (!TypeEqual(ntype, UsualUnaryConversionType(ntype)) ||
IsEllipsis(ntype))
goto Mismatch;
}
}
}
return;
Mismatch:
SyntaxErrorCoord(create->coord,
"identifier `%s' redeclared", VAR_NAME(orig));
fprintf(stderr, "\tPrevious declaration: ");
PRINT_COORD(stderr, orig->coord);
fputc('\n', stderr);
return;
}
PRIVATE void formal_conflict(Node *orig, Node *create)
{
SyntaxErrorCoord(create->coord,
"formal `%s' used multiple times", VAR_NAME(orig));
}
