示例#1
0
文件: inquire.c 项目: franred/ofc
void ofc_sema_stmt_io_inquire__cleanup(
	ofc_sema_stmt_t s)
{
	ofc_sema_expr_delete(s.io_inquire.unit);
	ofc_sema_expr_delete(s.io_inquire.file);
	ofc_sema_expr_delete(s.io_inquire.err);

	ofc_sema_lhs_delete(s.io_inquire.access);
	ofc_sema_lhs_delete(s.io_inquire.action);
	ofc_sema_lhs_delete(s.io_inquire.blank);
	ofc_sema_lhs_delete(s.io_inquire.delim);
	ofc_sema_lhs_delete(s.io_inquire.direct);
	ofc_sema_lhs_delete(s.io_inquire.exist);
	ofc_sema_lhs_delete(s.io_inquire.form);
	ofc_sema_lhs_delete(s.io_inquire.formatted);
	ofc_sema_lhs_delete(s.io_inquire.iostat);
	ofc_sema_lhs_delete(s.io_inquire.name);
	ofc_sema_lhs_delete(s.io_inquire.named);
	ofc_sema_lhs_delete(s.io_inquire.nextrec);
	ofc_sema_lhs_delete(s.io_inquire.number);
	ofc_sema_lhs_delete(s.io_inquire.opened);
	ofc_sema_lhs_delete(s.io_inquire.pad);
	ofc_sema_lhs_delete(s.io_inquire.position);
	ofc_sema_lhs_delete(s.io_inquire.read);
	ofc_sema_lhs_delete(s.io_inquire.readwrite);
	ofc_sema_lhs_delete(s.io_inquire.recl);
	ofc_sema_lhs_delete(s.io_inquire.sequential);
	ofc_sema_lhs_delete(s.io_inquire.unformatted);
	ofc_sema_lhs_delete(s.io_inquire.write);
}
示例#2
0
void ofc_sema_stmt_io_read__cleanup(
	ofc_sema_stmt_t s)
{
	ofc_sema_expr_delete(s.io_read.unit);
	ofc_sema_expr_delete(s.io_read.format);
	ofc_sema_expr_delete(s.io_read.advance);
	ofc_sema_expr_delete(s.io_read.end);
	ofc_sema_expr_delete(s.io_read.eor);
	ofc_sema_expr_delete(s.io_read.err);
	ofc_sema_expr_delete(s.io_read.iostat);
	ofc_sema_expr_delete(s.io_read.rec);
	ofc_sema_expr_delete(s.io_read.size);
}
示例#3
0
文件: do.c 项目: franred/ofc
static ofc_sema_stmt_t* ofc_sema_stmt_do__label(
	ofc_sema_scope_t* scope,
	const ofc_parse_stmt_t* stmt)
{
	if (!stmt
		|| (stmt->type != OFC_PARSE_STMT_DO_LABEL)
		|| !stmt->do_label.init
		|| !stmt->do_label.last
		|| !stmt->do_label.end_label)
		return NULL;

	ofc_sema_stmt_t s;
	s.type = OFC_SEMA_STMT_DO_LABEL;
	s.do_label.iter = NULL;
	s.do_label.init = NULL;
	s.do_label.last = NULL;
	s.do_label.step = NULL;

	s.do_label.end_label = ofc_sema_expr(
		scope, stmt->do_label.end_label);
	if (!s.do_label.end_label)
		return NULL;

	if (!ofc_sema_stmt__loop_control(
		scope, stmt->do_label.init,
		stmt->do_label.last, stmt->do_label.step,
		&s.do_label.iter, &s.do_label.init,
		&s.do_label.last, &s.do_label.step))
	{
		ofc_sema_expr_delete(s.do_label.end_label);
		return NULL;
	}

	ofc_sema_stmt_t* as = ofc_sema_stmt_alloc(s);
	if (!as)
	{
		ofc_sema_expr_delete(s.do_label.end_label);
		ofc_sema_expr_delete(s.do_label.init);
		ofc_sema_expr_delete(s.do_label.last);
		ofc_sema_expr_delete(s.do_label.step);
		return NULL;
	}

	return as;
}
示例#4
0
bool ofc_sema_lhs_list_init(
	ofc_sema_lhs_list_t* lhs,
	const ofc_sema_expr_list_t* init)
{
	unsigned lhs_count;
	unsigned init_count;
	if (!ofc_sema_lhs_list_elem_count(lhs, &lhs_count)
		|| !ofc_sema_expr_list_elem_count(init, &init_count))
		return false;

	unsigned e = (lhs_count < init_count ? lhs_count : init_count);

	unsigned i;
	for (i = 0; i < e; i++)
	{
		ofc_sema_lhs_t* lhs_elem
			= ofc_sema_lhs_list_elem_get(lhs, i);
		if (!lhs_elem) return false;

		ofc_sema_expr_t* init_elem
			= ofc_sema_expr_list_elem_get(init, i);
		if (!init_elem)
		{
			ofc_sema_lhs_delete(lhs_elem);
			return false;
		}

		bool success = ofc_sema_lhs_init(
			lhs_elem, init_elem);
		ofc_sema_lhs_delete(lhs_elem);

		if (!success)
		{
			/* TODO - Fail atomically? */
			ofc_sparse_ref_error(init_elem->src,
				"Invalid initializer");
			ofc_sema_expr_delete(init_elem);
			return false;
		}

		ofc_sema_expr_delete(init_elem);
	}

	return true;
}
示例#5
0
文件: do.c 项目: franred/ofc
static ofc_sema_stmt_t* ofc_sema_stmt_do_while__label(
	ofc_sema_scope_t* scope,
	const ofc_parse_stmt_t* stmt)
{

	if (!stmt
		|| (stmt->type != OFC_PARSE_STMT_DO_WHILE)
		|| !stmt->do_while_block.cond)
		return NULL;

	ofc_sema_stmt_t s;
	s.type = OFC_SEMA_STMT_DO_WHILE;

	s.do_while.end_label = ofc_sema_expr(
	scope, stmt->do_while.end_label);
	if (!s.do_while.end_label)
		return NULL;

	s.do_while.cond = ofc_sema_expr(
		scope, stmt->do_while.cond);
	if (!s.do_while.cond)
		return NULL;

	const ofc_sema_type_t* type
		= ofc_sema_expr_type(s.do_while.cond);
	if (!ofc_sema_type_is_logical(type))
	{
		ofc_sparse_ref_error(stmt->do_while.cond->src,
			"IF condition type must be LOGICAL.");

		ofc_sema_expr_delete(s.do_while.cond);
		return NULL;
	}

	ofc_sema_stmt_t* as = ofc_sema_stmt_alloc(s);
	if (!as)
	{
		ofc_sema_expr_delete(s.do_while.cond);
		return NULL;
	}

	return as;
}
示例#6
0
ofc_sema_stmt_t* ofc_sema_stmt_assign(
	ofc_sema_scope_t* scope,
	const ofc_parse_stmt_t* stmt)
{
	if (!scope || !stmt
		|| (stmt->type != OFC_PARSE_STMT_ASSIGN)
		|| ofc_sparse_ref_empty(stmt->assign.variable))
		return false;

	ofc_sema_stmt_t s;
	ofc_sema_decl_t* dest
		= ofc_sema_scope_decl_find_create(
			scope, stmt->assign.variable, false);
	if (!dest) return false;

	if (!ofc_sema_type_is_integer(dest->type))
	{
		const ofc_sema_type_t* ptype
			= ofc_sema_type_create_primitive(
				OFC_SEMA_TYPE_INTEGER, OFC_SEMA_KIND_NONE);
		if (!ptype) return NULL;

		if (!ofc_sema_decl_type_set(
			dest, ptype, stmt->assign.variable))
		{
			ofc_sparse_ref_error(stmt->src,
				"ASSIGN destination must be of type INTEGER.");
			return NULL;
		}

		ofc_sparse_ref_warning(stmt->assign.variable,
			"IMPLICIT declaration of variable in ASSIGN destination"
			" as non-INTEGER makes no sense, declaring as INTEGER.");
	}
	s.assign.dest = dest;

	s.assign.label = ofc_sema_expr_label(
		scope, stmt->assign.label);
	if (!s.assign.label) return false;

	s.type = OFC_SEMA_STMT_ASSIGN;
	s.src = stmt->src;

	ofc_sema_stmt_t* as
		= ofc_sema_stmt_alloc(s);
	if (!as)
	{
		ofc_sema_expr_delete(s.assign.label);
		return NULL;
	}

	dest->was_written = true;
	return as;
}
示例#7
0
文件: do.c 项目: franred/ofc
static ofc_sema_stmt_t* ofc_sema_stmt_do__block(
	ofc_sema_scope_t* scope,
	const ofc_parse_stmt_t* stmt)
{
	if (!stmt
		|| (stmt->type != OFC_PARSE_STMT_DO_BLOCK)
		|| !stmt->do_block.init
		|| !stmt->do_block.last)
		return NULL;

	ofc_sema_stmt_t s;
	s.type = OFC_SEMA_STMT_DO_BLOCK;
	s.do_block.iter = NULL;
	s.do_block.init = NULL;
	s.do_block.last = NULL;
	s.do_block.step = NULL;

	if (!ofc_sema_stmt__loop_control(
		scope, stmt->do_block.init,
		stmt->do_block.last, stmt->do_block.step,
		&s.do_block.iter, &s.do_block.init,
		&s.do_block.last, &s.do_block.step))
		return NULL;


	s.do_block.block = NULL;
	if (stmt->do_block.block)
	{
		s.do_block.block
			= ofc_sema_stmt_list(
				scope, stmt->do_block.block);
		if (!s.do_block.block)
		{
			ofc_sema_expr_delete(s.do_block.init);
			ofc_sema_expr_delete(s.do_block.last);
			ofc_sema_expr_delete(s.do_block.step);
			return NULL;
		}
	}

	ofc_sema_stmt_t* as = ofc_sema_stmt_alloc(s);
	if (!as)
	{
		ofc_sema_stmt_list_delete(s.do_block.block);
		ofc_sema_expr_delete(s.do_block.init);
		ofc_sema_expr_delete(s.do_block.last);
		ofc_sema_expr_delete(s.do_block.step);
		return NULL;
	}

	if (stmt->do_block.end_do_has_label
		&& !ofc_sema_label_map_add_end_block(
			scope->label, stmt->do_block.end_do_label, as))
	{
		ofc_sema_stmt_delete(as);
		return NULL;
	}

	return as;
}
示例#8
0
bool ofc_sema_io_format_iolist_compare(
	const ofc_sema_stmt_t* stmt,
	const ofc_parse_format_desc_list_t* format_list,
	ofc_sema_expr_list_t* iolist)
{
	if (!format_list || !iolist) return false;

	/* This is to handle "forced reversion"
	   http://www.obliquity.com/computer/fortran/format.html */
	unsigned repeat_from = 0;
	unsigned offset = 0;
	unsigned i, elem_count;
	for (i = 0; i < format_list->count; i++)
	{
		if (format_list->desc[i]->type
			== OFC_PARSE_FORMAT_DESC_REPEAT)
			repeat_from = offset;

		if (!ofc_parse_format_desc_elem_count(
			format_list->desc[i], &elem_count))
			return false;
		offset += elem_count;
	}

	unsigned count;
	if (!ofc_parse_format_desc_list_elem_count(
		format_list, &count))
		return false;

	offset = 0;
	for (i = 0; i < iolist->count; i++)
	{
		if (offset >= count)
			offset = repeat_from;

		ofc_sema_expr_t* pexpr
			= ofc_sema_expr_list_elem_get(iolist, i);

		const ofc_sema_type_t* type
			= ofc_sema_expr_type(pexpr);

		if (ofc_sema_type_is_complex(type))
		{
			unsigned j;
			for (j = 0; j < 2; j++)
			{
				/* Find the next data descriptor */
				ofc_parse_format_desc_t* desc;
				while (true)
				{
					if (offset >= count)
						offset = repeat_from;

					desc = ofc_parse_format_desc_list_elem_get(
						format_list, offset++);
					if (!desc)
					{
						ofc_sema_expr_delete(pexpr);
						return false;
					}

					if (ofc_parse_format_is_data_desc(desc))
						break;

					ofc_parse_format_desc_delete(desc);
				}

				if (!ofc_sema_io_compare_types(
					stmt, NULL, &pexpr, type, desc))
				{
					ofc_sema_expr_delete(pexpr);
					ofc_parse_format_desc_delete(desc);
					return false;
				}
				ofc_parse_format_desc_delete(desc);
			}
			ofc_sema_expr_delete(pexpr);
			continue;
		}

		/* Find the next data descriptor */
		ofc_parse_format_desc_t* desc;
		while (true)
		{
			if (offset >= count)
				offset = repeat_from;

			desc = ofc_parse_format_desc_list_elem_get(
				format_list, offset++);

			if (ofc_parse_format_is_data_desc(desc))
				break;

			ofc_parse_format_desc_delete(desc);
		}

		if (!ofc_sema_io_compare_types(
			stmt, NULL, &pexpr, type, desc))
		{
			ofc_sema_expr_delete(pexpr);
			ofc_parse_format_desc_delete(desc);
			return false;
		}

		ofc_parse_format_desc_delete(desc);
		ofc_sema_expr_delete(pexpr);
	}

	return true;
}
示例#9
0
static ofc_parse_format_desc_t* ofc_sema_io_format_iolist_check_def__helper(
	ofc_parse_format_desc_t* desc,
	ofc_sema_expr_list_t* iolist,
	unsigned* offset, bool* changed)
{
	if (!desc || !iolist)
		return NULL;

	if (desc->type == OFC_PARSE_FORMAT_DESC_REPEAT)
	{
		ofc_parse_format_desc_list_t* repeat_list
			= ofc_parse_format_desc_list_create();
		if (!repeat_list) return NULL;

		bool was_changed = false;
		unsigned k;
		for (k = 0; k < desc->repeat->count; k++)
		{
			bool c = false;
			ofc_parse_format_desc_t* elem
				= ofc_sema_io_format_iolist_check_def__helper(
					desc->repeat->desc[k], iolist, offset, &c);
			if (c) was_changed = true;
			if (!ofc_parse_format_desc_list_add(repeat_list, elem))
			{
				ofc_parse_format_desc_list_delete(repeat_list);
				return NULL;
			}
		}

		if (changed) *changed = was_changed;
		ofc_parse_format_desc_t* repeat
			= ofc_parse_format_desc_create_repeat(repeat_list, desc->n);
		return repeat;
	}
	else if (!ofc_parse_format_is_data_desc(desc))
	{
		if (changed) *changed = false;
		return ofc_parse_format_desc_copy(desc);
	}
	else
	{
		unsigned repeat;
		if (!ofc_parse_format_desc_elem_count(
			desc, &repeat))
			return NULL;

		ofc_sema_expr_t* expr
			= ofc_sema_expr_list_elem_get(iolist, *offset);
		*offset += repeat;

		if (!expr)
			return ofc_parse_format_desc_copy(desc);

		ofc_parse_format_desc_t* copy
			= ofc_sema_format_desc_set_def(desc, expr, NULL);
		if (!copy)
		{
			ofc_sema_expr_delete(expr);
			return NULL;
		}

		bool is_same = ofc_parse_format_desc_compare(desc, copy);
		if (changed) *changed = !is_same;


		ofc_sema_expr_delete(expr);

		return copy;
	}

	return NULL;
}
示例#10
0
文件: do.c 项目: franred/ofc
static ofc_sema_stmt_t* ofc_sema_stmt_do_while__block(
	ofc_sema_scope_t* scope,
	const ofc_parse_stmt_t* stmt)
{

	if (!stmt
		|| (stmt->type != OFC_PARSE_STMT_DO_WHILE_BLOCK)
		|| !stmt->do_while_block.cond)
		return NULL;

	ofc_sema_stmt_t s;
	s.type = OFC_SEMA_STMT_DO_WHILE_BLOCK;

	s.do_while_block.cond = ofc_sema_expr(
		scope, stmt->do_while_block.cond);
	if (!s.do_while_block.cond)
		return NULL;

	const ofc_sema_type_t* type
		= ofc_sema_expr_type(s.do_while_block.cond);
	if (!ofc_sema_type_is_logical(type))
	{
		ofc_sparse_ref_error(stmt->do_while_block.cond->src,
			"IF condition type must be LOGICAL.");

		ofc_sema_expr_delete(s.do_while_block.cond);
		return NULL;
	}

	s.do_while_block.block = NULL;
	if (stmt->do_while_block.block)
	{
		s.do_while_block.block
			= ofc_sema_stmt_list(
				scope, stmt->do_while_block.block);

		if (!s.do_while_block.block)
		{
			ofc_sema_expr_delete(s.do_while_block.cond);
			return NULL;
		}
	}

	ofc_sema_stmt_t* as = ofc_sema_stmt_alloc(s);
	if (!as)
	{
		ofc_sema_stmt_list_delete(s.do_while_block.block);
		ofc_sema_expr_delete(s.do_while_block.cond);
		return NULL;
	}

	if (stmt->do_while_block.end_do_has_label
		&& !ofc_sema_label_map_add_end_block(
			scope->label, stmt->do_while_block.end_do_label, as))
	{
		ofc_sema_stmt_delete(as);
		return NULL;
	}

	return as;
}
示例#11
0
static ofc_sema_lhs_t* ofc_sema_lhs_substring(
	ofc_sema_scope_t* scope,
	ofc_sema_lhs_t* lhs,
	const ofc_parse_array_index_t* index)
{
	if (!ofc_sema_lhs_reference(lhs))
		return NULL;

	if (!index
		|| (index->count != 1)
		|| !lhs->data_type)
	{
		ofc_sema_lhs_delete(lhs);
		return NULL;
	}

	const ofc_parse_array_range_t* range
		= index->range[0];
	if (!range || range->stride)
	{
		ofc_sema_lhs_delete(lhs);
		return NULL;
	}

	ofc_sema_expr_t* first
		= ofc_sema_expr(scope, range->first);
	if (range->first && !first)
	{
		ofc_sema_lhs_delete(lhs);
		return NULL;
	}

	ofc_sema_expr_t* last = NULL;
	if (range->last)
	{
		last = ofc_sema_expr(scope, range->last);
		if (!last)
		{
			ofc_sema_lhs_delete(lhs);
			ofc_sema_expr_delete(first);
			return NULL;
		}
	}
	else if (!range->is_slice)
	{
		last = first;
	}

	unsigned len = 0;
	bool len_var = true;
	if ((!first || ofc_sema_expr_is_constant(first))
		&& ofc_sema_expr_is_constant(last))
	{
		const ofc_sema_typeval_t* first_ctv
			= ofc_sema_expr_constant(first);
		const ofc_sema_typeval_t* last_ctv
			= ofc_sema_expr_constant(last);

		if ((first && !first_ctv) || !last_ctv)
		{
			ofc_sema_lhs_delete(lhs);
			if (last != first)
				ofc_sema_expr_delete(last);
			ofc_sema_expr_delete(first);
			return NULL;
		}

		int64_t ifirst = 1;
		if (first && !ofc_sema_typeval_get_integer(
			first_ctv, &ifirst))
		{
			ofc_sema_lhs_delete(lhs);
			if (last != first)
				ofc_sema_expr_delete(last);
			ofc_sema_expr_delete(first);
			return NULL;
		}

		int64_t ilast;
		if (!ofc_sema_typeval_get_integer(
			last_ctv, &ilast))
		{
			ofc_sema_lhs_delete(lhs);
			if (last != first)
				ofc_sema_expr_delete(last);
			ofc_sema_expr_delete(first);
			return NULL;
		}

		if (ifirst < 0)
		{
			ofc_sparse_ref_error(lhs->src,
				"First index in character substring must be 1 or greater");

			ofc_sema_lhs_delete(lhs);
			if (last != first)
				ofc_sema_expr_delete(last);
			ofc_sema_expr_delete(first);
			return NULL;
		}

		if (ilast < ifirst)
		{
			ofc_sparse_ref_error(lhs->src,
				"Last index in character substring must be greater than first");

			ofc_sema_lhs_delete(lhs);
			if (last != first)
				ofc_sema_expr_delete(last);
			ofc_sema_expr_delete(first);
			return NULL;
		}

		if ((lhs->data_type->len > 0)
			&& (ilast > lhs->data_type->len))
		{
			ofc_sparse_ref_warning(lhs->src,
				"Last index in character substring out-of-bounds");
		}

		int64_t ilen = (ilast - ifirst) + 1;
		len = ilen;
		if ((int64_t)len != ilen)
		{
			ofc_sema_lhs_delete(lhs);
			if (last != first)
				ofc_sema_expr_delete(last);
			ofc_sema_expr_delete(first);
			return NULL;
		}
		len_var = false;
	}

	const ofc_sema_type_t* type
		= ofc_sema_type_create_character(
			lhs->data_type->kind, len, len_var);
	if (!type)
	{
		ofc_sema_lhs_delete(lhs);
		if (last != first)
			ofc_sema_expr_delete(last);
		ofc_sema_expr_delete(first);
		return NULL;
	}

	ofc_sema_lhs_t* alhs
		= (ofc_sema_lhs_t*)malloc(
			sizeof(ofc_sema_lhs_t));
	if (!alhs)
	{
		if (last != first)
			ofc_sema_expr_delete(last);
		ofc_sema_expr_delete(first);
		ofc_sema_lhs_delete(lhs);
		return NULL;
	}

	alhs->type            = OFC_SEMA_LHS_SUBSTRING;
	alhs->src             = lhs->src;
	alhs->parent          = lhs;
	alhs->substring.first = first;
	alhs->substring.last  = last;
	alhs->data_type       = type;
	alhs->refcnt          = 0;

	return alhs;
}
示例#12
0
ofc_sema_lhs_t* ofc_sema_lhs_elem_get(
	ofc_sema_lhs_t* lhs, unsigned offset)
{
	if (!lhs)
		return NULL;

	switch (lhs->type)
	{
		case OFC_SEMA_LHS_DECL:
		case OFC_SEMA_LHS_ARRAY_INDEX:
		case OFC_SEMA_LHS_STRUCTURE_MEMBER:
			if (ofc_sema_type_is_procedure(lhs->data_type))
				return NULL;

			ofc_sema_structure_t* structure
				= ofc_sema_lhs_structure(lhs);

			if (ofc_sema_lhs_is_array(lhs))
			{
				unsigned base_count = 1;
				if (structure)
				{
					unsigned scount;
					if (!ofc_sema_structure_elem_count(
						structure, &scount))
						return NULL;

					base_count *= scount;
					if (base_count == 0)
						return NULL;
				}

				unsigned base_offset = (offset % base_count);

				ofc_sema_array_index_t* index
					= ofc_sema_array_index_from_offset(
						lhs->decl, (offset / base_count));
				if (!index) return NULL;

				ofc_sema_lhs_t* nlhs
					= ofc_sema_lhs_index(lhs, index);
				if (!nlhs)
				{
					ofc_sema_array_index_delete(index);
					return NULL;
				}

				ofc_sema_lhs_t* rlhs
					= ofc_sema_lhs_elem_get(
						nlhs, base_offset);
				ofc_sema_lhs_delete(nlhs);
				return rlhs;
			}
			else if (structure)
			{
				ofc_sema_decl_t* member
					= ofc_sema_structure_member_get_decl_offset(
						structure, offset);

				ofc_sema_lhs_t* nlhs
					= ofc_sema_lhs_member(lhs, member);
				if (!nlhs)
				{
					ofc_sema_decl_delete(member);
					return NULL;
				}

				ofc_sema_lhs_t* rlhs
					= ofc_sema_lhs_elem_get(
						nlhs, offset);
				ofc_sema_lhs_delete(nlhs);
				return rlhs;
			}
			else
			{
				if (offset != 0)
					return NULL;
				if (!ofc_sema_lhs_reference(lhs))
					return NULL;
				return lhs;
			}
			break;

		case OFC_SEMA_LHS_ARRAY_SLICE:
		{
			if (ofc_sema_type_is_procedure(lhs->data_type))
				return NULL;

			ofc_sema_structure_t* structure
				= ofc_sema_lhs_structure(lhs);

			unsigned base_count = 1;
			if (structure)
			{
				unsigned scount;
				if (!ofc_sema_structure_elem_count(
					structure, &scount))
					return NULL;

				base_count *= scount;
				if (base_count == 0)
					return NULL;
			}

			unsigned base_offset = (offset % base_count);

			ofc_sema_array_index_t* index
				= ofc_sema_array_slice_index_from_offset(
					lhs->slice.slice, (offset / base_count));
			if (!index) return NULL;

			ofc_sema_lhs_t* nlhs
				= ofc_sema_lhs_index(lhs->parent, index);
			if (!nlhs)
			{
				ofc_sema_array_index_delete(index);
				return NULL;
			}

			ofc_sema_lhs_t* rlhs
				= ofc_sema_lhs_elem_get(
					nlhs, base_offset);
			ofc_sema_lhs_delete(nlhs);
			return rlhs;
		}
		case OFC_SEMA_LHS_SUBSTRING:
			if (offset != 0)
				return NULL;
			if (!ofc_sema_lhs_reference(lhs))
					return NULL;
			return lhs;

		case OFC_SEMA_LHS_IMPLICIT_DO:
		{
			if (!lhs->implicit_do.iter)
				return NULL;

			unsigned sub_elem_count;
			if (!ofc_sema_lhs_list_elem_count(
				lhs->implicit_do.lhs, &sub_elem_count))
				return NULL;

			if (sub_elem_count == 0)
				return NULL;

			unsigned sub_offset
				= (offset % sub_elem_count);
			offset /= sub_elem_count;

			const ofc_sema_typeval_t* ctv[2];
			ctv[0] = ofc_sema_expr_constant(
					lhs->implicit_do.init);
			ctv[1] = ofc_sema_expr_constant(
					lhs->implicit_do.step);

			long double first, step = 1.0;
			if (!ofc_sema_typeval_get_real(ctv[0], &first))
				return NULL;
			if (ctv[1] && !ofc_sema_typeval_get_real(ctv[1], &step))
				return NULL;

			long double doffset
				= first + ((long double)offset * step);

			ofc_sema_typeval_t* dinit
				= ofc_sema_typeval_create_real(
					doffset, OFC_SEMA_KIND_NONE,
					OFC_SPARSE_REF_EMPTY);
			if (!dinit) return NULL;

			ofc_sema_typeval_t* init
				= ofc_sema_typeval_cast(
					dinit, lhs->implicit_do.iter->type);
			ofc_sema_typeval_delete(dinit);
			if (!init) return NULL;

			ofc_sema_expr_t* iter_expr
				= ofc_sema_expr_typeval(init);
			if (!iter_expr)
			{
				ofc_sema_typeval_delete(init);
				return NULL;
			}

			ofc_sema_lhs_t* rval = NULL;
			unsigned e = sub_offset;
			unsigned i;
			for (i = 0; i < lhs->implicit_do.lhs->count; i++)
			{
				ofc_sema_lhs_t* lhs_dummy
					= lhs->implicit_do.lhs->lhs[i];

				unsigned elem_count;
				if (!ofc_sema_lhs_elem_count(
					lhs_dummy, &elem_count))
					return NULL;

				if (e < elem_count)
				{

					ofc_sema_lhs_t* body
						= ofc_sema_lhs_copy_replace(
							lhs_dummy, lhs->implicit_do.iter, iter_expr);
					if (!body) return NULL;

					rval = ofc_sema_lhs_elem_get(
						body, sub_offset);

					ofc_sema_lhs_delete(body);
				}
				else
				{
					e -= elem_count;
				}
			}

			ofc_sema_expr_delete(iter_expr);

			return rval;
		}

		default:
			break;
	}

	return NULL;
}
示例#13
0
void ofc_sema_lhs_delete(
	ofc_sema_lhs_t* lhs)
{
	if (!lhs)
		return;

	if (lhs->refcnt > 0)
	{
		lhs->refcnt--;
		return;
	}

	switch (lhs->type)
	{
		case OFC_SEMA_LHS_DECL:
			ofc_sema_decl_delete(lhs->decl);
			break;

		case OFC_SEMA_LHS_ARRAY_INDEX:
		case OFC_SEMA_LHS_ARRAY_SLICE:
		case OFC_SEMA_LHS_SUBSTRING:
		case OFC_SEMA_LHS_STRUCTURE_MEMBER:
			ofc_sema_lhs_delete(lhs->parent);
			break;

		default:
			break;
	}

	switch (lhs->type)
	{
		case OFC_SEMA_LHS_ARRAY_INDEX:
			ofc_sema_array_index_delete(lhs->index);
			break;

		case OFC_SEMA_LHS_ARRAY_SLICE:
			ofc_sema_array_slice_delete(lhs->slice.slice);
			ofc_sema_array_delete(lhs->slice.dims);
			break;

		case OFC_SEMA_LHS_SUBSTRING:
			if (lhs->substring.last != lhs->substring.first)
				ofc_sema_expr_delete(lhs->substring.last);
			ofc_sema_expr_delete(lhs->substring.first);
			break;

		case OFC_SEMA_LHS_STRUCTURE_MEMBER:
			ofc_sema_decl_delete(lhs->member);
			break;

		case OFC_SEMA_LHS_IMPLICIT_DO:
			ofc_sema_lhs_list_delete(lhs->implicit_do.lhs);
			ofc_sema_decl_delete(lhs->implicit_do.iter);
			ofc_sema_expr_delete(lhs->implicit_do.init);
			ofc_sema_expr_delete(lhs->implicit_do.last);
			ofc_sema_expr_delete(lhs->implicit_do.step);
			break;

		default:
			break;
	}

	free(lhs);
}
示例#14
0
ofc_sema_lhs_t* ofc_sema_lhs_copy_replace(
	const ofc_sema_lhs_t*  lhs,
	const ofc_sema_decl_t* replace,
	const ofc_sema_expr_t* with)
{
	if (!lhs)
		return NULL;

	ofc_sema_lhs_t* copy
		= (ofc_sema_lhs_t*)malloc(
			sizeof(ofc_sema_lhs_t));
	if (!copy) return NULL;

	*copy = *lhs;

	if (lhs->type == OFC_SEMA_LHS_DECL)
	{
		if (!ofc_sema_decl_reference(lhs->decl))
		{
			free(copy);
			return NULL;
		}
	}
	else if (lhs->type == OFC_SEMA_LHS_IMPLICIT_DO)
	{
		copy->implicit_do.lhs
			= ofc_sema_lhs_list_copy_replace(
				lhs->implicit_do.lhs, replace, with);
		copy->implicit_do.iter
			= (ofc_sema_decl_reference(lhs->implicit_do.iter)
				? lhs->implicit_do.iter : NULL);
		copy->implicit_do.init
			= ofc_sema_expr_copy_replace(
				lhs->implicit_do.init, replace, with);
		copy->implicit_do.last
			= ofc_sema_expr_copy_replace(
				lhs->implicit_do.last, replace, with);
		copy->implicit_do.step
			= ofc_sema_expr_copy_replace(
				lhs->implicit_do.step, replace, with);
		if (!copy->implicit_do.lhs
			|| !copy->implicit_do.iter
			|| !copy->implicit_do.init
			|| !copy->implicit_do.last
			|| (lhs->implicit_do.step
				&& !copy->implicit_do.step))
		{
			ofc_sema_lhs_delete(copy);
			return NULL;
		}
	}
	else
	{
		switch (lhs->type)
		{
			case OFC_SEMA_LHS_ARRAY_INDEX:
				copy->index = ofc_sema_array_index_copy_replace(
					lhs->index, replace, with);
				if (!copy->index)
				{
					free(copy);
					return NULL;
				}
				break;

			case OFC_SEMA_LHS_ARRAY_SLICE:
				copy->slice.slice
					= ofc_sema_array_slice_copy_replace(
						lhs->slice.slice, replace, with);

				copy->slice.dims
					= ofc_sema_array_copy_replace(
						lhs->slice.dims, replace, with);
				if (!copy->slice.slice
					|| !copy->slice.dims)
				{
					ofc_sema_array_slice_delete(copy->slice.slice);
					ofc_sema_array_delete(copy->slice.dims);
					free(copy);
					return NULL;
				}
				break;

			case OFC_SEMA_LHS_SUBSTRING:
				if (lhs->substring.first)
				{
					copy->substring.first
						= ofc_sema_expr_copy_replace(
							lhs->substring.first, replace, with);
					if (!copy->substring.first)
					{
						free(copy);
						return NULL;
					}
				}

				if (lhs->substring.last)
				{
					copy->substring.last
						= ofc_sema_expr_copy_replace(
							lhs->substring.last, replace, with);
					if (!copy->substring.last)
					{
						ofc_sema_expr_delete(
							copy->substring.first);
						free(copy);
						return NULL;
					}
				}
				break;

			case OFC_SEMA_LHS_STRUCTURE_MEMBER:
				break;

			default:
				free(copy);
				return NULL;
		}

		copy->parent = ofc_sema_lhs_copy_replace(
			lhs->parent, replace, with);
		if (!copy->parent)
		{
			ofc_sema_lhs_delete(copy);
			return NULL;
		}
	}

	return copy;
}
示例#15
0
bool ofc_sema_io_list_has_complex(
	ofc_sema_lhs_list_t* ilist,
	ofc_sema_expr_list_t* olist,
	unsigned* count)
{
	if (!count) return false;

	if (ilist)
	{
		unsigned i;
		for (i = 0; i < ilist->count; i++)
		{
			ofc_sema_lhs_t* lhs
				= ofc_sema_lhs_list_elem_get(ilist, i);

			const ofc_sema_type_t* type
				= ofc_sema_lhs_type(lhs);
			ofc_sema_lhs_delete(lhs);
			if (!type) return false;

			if (ofc_sema_type_is_complex(type))
			{
				unsigned elem_count;
				if (!ofc_sema_lhs_elem_count(
					ilist->lhs[i], &elem_count))
					return false;

				*count += elem_count;
			}
		}
	}
	else if (olist)
	{
		unsigned i;
		for (i = 0; i < olist->count; i++)
		{
			ofc_sema_expr_t* expr
				= ofc_sema_expr_list_elem_get(olist, i);

			const ofc_sema_type_t* type
				= ofc_sema_expr_type(expr);
			ofc_sema_expr_delete(expr);
			if (!type) return false;

			if (ofc_sema_type_is_complex(type))
			{
				unsigned elem_count;
				if (!ofc_sema_expr_elem_count(
					olist->expr[i], &elem_count))
					return false;

				*count += elem_count;
			}
		}
	}
	else
	{
		return false;
	}

	return true;
}
示例#16
0
文件: do.c 项目: franred/ofc
static bool ofc_sema_stmt__loop_control(
	ofc_sema_scope_t* scope,
	const ofc_parse_assign_t* parse_init,
	const ofc_parse_expr_t*   parse_last,
	const ofc_parse_expr_t*   parse_step,
	ofc_sema_lhs_t**  sema_iter,
	ofc_sema_expr_t** sema_init,
	ofc_sema_expr_t** sema_last,
	ofc_sema_expr_t** sema_step)
{
	*sema_iter = ofc_sema_lhs(
		scope, parse_init->name);
	if (!*sema_iter) return false;

	const ofc_sema_type_t* dtype
		= ofc_sema_lhs_type(*sema_iter);
	if (!ofc_sema_type_is_scalar(dtype))
	{
		ofc_sparse_ref_error(parse_init->name->src,
			"DO loop iterator must be a scalar type.");
		ofc_sema_lhs_delete(*sema_iter);
		return false;
	}

	if (!ofc_sema_type_is_integer(dtype))
	{
		ofc_sparse_ref_warning(parse_init->name->src,
			"Using REAL in DO loop iterator.");
	}

	*sema_init = ofc_sema_expr(
		scope, parse_init->init);
	if (!*sema_init)
	{
		ofc_sema_lhs_delete(*sema_iter);
		return false;
	}

	if (!ofc_sema_type_compatible(dtype,
		ofc_sema_expr_type(*sema_init)))
	{
		ofc_sema_expr_t* cast
			= ofc_sema_expr_cast(*sema_init, dtype);
		if (!cast)
		{
			const ofc_sema_type_t* expr_type
				= ofc_sema_expr_type(*sema_init);
			ofc_sparse_ref_error(parse_init->init->src,
				"Expression type %s doesn't match lhs type %s",
				ofc_sema_type_str_rep(expr_type),
				ofc_sema_type_str_rep(dtype));
			ofc_sema_expr_delete(*sema_init);
			ofc_sema_lhs_delete(*sema_iter);
			return false;
		}
		*sema_init = cast;
	}

	*sema_last = ofc_sema_expr(
		scope, parse_last);
	if (!*sema_last)
	{
		ofc_sema_expr_delete(*sema_init);
		ofc_sema_lhs_delete(*sema_iter);
		return false;
	}

	if (!ofc_sema_type_compatible(dtype,
		ofc_sema_expr_type(*sema_last)))
	{
		ofc_sema_expr_t* cast
			= ofc_sema_expr_cast(*sema_last, dtype);
		if (!cast)
		{
			const ofc_sema_type_t* expr_type =
				ofc_sema_expr_type(*sema_last);
			ofc_sparse_ref_error(parse_last->src,
				"Expression type %s doesn't match lhs type %s",
				ofc_sema_type_str_rep(expr_type),
				ofc_sema_type_str_rep(dtype));
			ofc_sema_expr_delete(*sema_init);
			ofc_sema_expr_delete(*sema_last);
			ofc_sema_lhs_delete(*sema_iter);
			return false;
		}
		*sema_last = cast;
	}

	*sema_step = NULL;
	if (parse_step)
	{
		*sema_step = ofc_sema_expr(
			scope, parse_step);
		if (!*sema_step)
		{
			ofc_sema_expr_delete(*sema_init);
			ofc_sema_expr_delete(*sema_last);
			ofc_sema_lhs_delete(*sema_iter);
			return false;
		}

		if (!ofc_sema_type_compatible(dtype,
			ofc_sema_expr_type(*sema_step)))
		{
			ofc_sema_expr_t* cast
				= ofc_sema_expr_cast(*sema_step, dtype);
			if (!cast)
			{
				const ofc_sema_type_t* expr_type =
					ofc_sema_expr_type(*sema_step);
				ofc_sparse_ref_error(parse_step->src,
					"Expression type %s doesn't match lhs type %s",
					ofc_sema_type_str_rep(expr_type),
					ofc_sema_type_str_rep(dtype));
				ofc_sema_expr_delete(*sema_step);
				ofc_sema_expr_delete(*sema_init);
				ofc_sema_expr_delete(*sema_last);
				ofc_sema_lhs_delete(*sema_iter);
				return false;
			}
			*sema_step = cast;
		}
	}

	return true;
}
示例#17
0
ofc_sema_stmt_t* ofc_sema_stmt_io_position(
	ofc_sema_scope_t* scope,
	const ofc_parse_stmt_t* stmt)
{
	if (!scope || !stmt
		|| !stmt->io.params)
		return NULL;

	const char* name;
	ofc_sema_stmt_t s;

	switch (stmt->type)
	{
		case OFC_PARSE_STMT_IO_REWIND:
			s.type = OFC_SEMA_STMT_IO_REWIND;
			name = "REWIND";
			break;
		case OFC_PARSE_STMT_IO_END_FILE:
			s.type = OFC_SEMA_STMT_IO_END_FILE;
			name = "ENDFILE";
			break;
		case OFC_PARSE_STMT_IO_BACKSPACE:
			s.type = OFC_SEMA_STMT_IO_BACKSPACE;
			name = "BACKSPACE";
			break;
		default:
			return NULL;
	}

	s.io_position.unit        = NULL;
	s.io_position.iostat      = NULL;
	s.io_position.err         = NULL;

	ofc_parse_call_arg_t* ca_unit   = NULL;
	ofc_parse_call_arg_t* ca_iostat = NULL;
	ofc_parse_call_arg_t* ca_err    = NULL;

	unsigned i;
	for (i = 0; i < stmt->io.params->count; i++)
	{
		ofc_parse_call_arg_t* param
			= stmt->io.params->call_arg[i];
		if (!param) continue;

		if (ofc_sparse_ref_empty(param->name))
		{
			if (i >= 1)
			{
				ofc_sparse_ref_error(param->src,
					"Un-named parameter %u has no meaning in %s.", i, name);
				return NULL;
			}

			if (i == 0)
			{
				ca_unit = param;
			}
		}
		else if (ofc_str_ref_equal_strz_ci(param->name.string, "UNIT"))
		{
			if (ca_unit)
			{
				ofc_sparse_ref_error(param->src,
					"Re-definition of UNIT in %s.", name);
				return NULL;
			}

			ca_unit = param;
		}
		else if (ofc_str_ref_equal_strz_ci(param->name.string, "IOSTAT"))
		{
			if (ca_iostat)
			{
				ofc_sparse_ref_error(param->src,
					"Re-definition of IOSTAT in %s.", name);
				return NULL;
			}

			ca_iostat = param;
		}
		else if (ofc_str_ref_equal_strz_ci(param->name.string, "ERR"))
		{
			if (ca_err)
			{
				ofc_sparse_ref_error(param->src,
					"Re-definition of ERR in %s.", name);
				return NULL;
			}

			ca_err = param;
		}
		else
		{
			ofc_sparse_ref_error(param->src,
				"Unrecognized paramater %u name '%.*s' in %s.",
				i, param->name.string.size, param->name.string.base, name);
			return NULL;
		}
	}

	if (!ca_unit)
	{
		ofc_sparse_ref_error(stmt->src,
			"No UNIT defined in %s.", name);
		return NULL;
	}

	if (ca_unit->type == OFC_PARSE_CALL_ARG_EXPR)
	{
		s.io_position.unit = ofc_sema_expr(
			scope, ca_unit->expr);
		if (!s.io_position.unit) return NULL;

		const ofc_sema_type_t* etype
			= ofc_sema_expr_type(s.io_position.unit);
		if (!etype) return NULL;

		if (!ofc_sema_type_is_integer(etype))
		{
			ofc_sparse_ref_error(stmt->src,
				"UNIT must be of type INTEGER in %s", name);
			ofc_sema_expr_delete(s.io_position.unit);
			return NULL;
		}

		if (!ofc_sema_expr_validate_uint(s.io_position.unit))
		{
			ofc_sparse_ref_error(stmt->src,
				   "UNIT must be a positive INTEGER in %s", name);
			ofc_sema_expr_delete(s.io_position.unit);
			return NULL;
		}
	}
	else
	{
		ofc_sparse_ref_error(stmt->src,
			"UNIT must be an INTEGER expression in %s", name);
		return NULL;
	}

	if (ca_iostat)
	{
		s.io_position.iostat = ofc_sema_expr(
			scope, ca_iostat->expr);
		if (!s.io_position.iostat)
		{
			ofc_sema_expr_delete(s.io_position.unit);
			return NULL;
		}

		if (s.io_position.iostat->type != OFC_SEMA_EXPR_LHS)
		{
			ofc_sparse_ref_error(stmt->src,
				"IOSTAT must be of a variable in %s", name);
			ofc_sema_expr_delete(s.io_position.unit);
			ofc_sema_expr_delete(s.io_position.iostat);
			return NULL;
		}

		const ofc_sema_type_t* etype
			= ofc_sema_expr_type(s.io_position.iostat);
		if (!etype)
		{
			ofc_sema_expr_delete(s.io_position.unit);
			ofc_sema_expr_delete(s.io_position.iostat);
			return NULL;
		}

		if (!ofc_sema_type_is_integer(etype))
		{
			ofc_sparse_ref_error(stmt->src,
				"IOSTAT must be of type INTEGER in %s", name);
			ofc_sema_expr_delete(s.io_position.unit);
			ofc_sema_expr_delete(s.io_position.iostat);
			return NULL;
		}

	}

	if (ca_err)
	{
		s.io_position.err = ofc_sema_expr_label(
			scope, ca_err->expr);
		if (!s.io_position.err)
		{
			ofc_sema_expr_delete(s.io_position.unit);
			ofc_sema_expr_delete(s.io_position.iostat);
			return NULL;
		}
	}

	ofc_sema_stmt_t* as
		= ofc_sema_stmt_alloc(s);
	if (!as)
	{
		ofc_sema_expr_delete(s.io_position.unit);
		ofc_sema_expr_delete(s.io_position.iostat);
		ofc_sema_expr_delete(s.io_position.err);
		return NULL;
	}
	return as;
}