Exemplo n.º 1
0
Arquivo: lisp43.c Projeto: plops/clicc
void Farray_element_type(CL_FORM *base)
{
	if(CL_ARRAY_P(STACK(base, 0)))
	{
	}
	else
	{
		COPY(SYMVAL(Slisp, 121), STACK(base, 1));	/* NO_ARRAY */
		COPY(STACK(base, 0), STACK(base, 2));
		Ferror(STACK(base, 1), 2);
	}
	array_element_type_internal(STACK(base, 0));
	to_element_type(STACK(base, 0));
}
Exemplo n.º 2
0
void check_array_internal(CL_FORM *base)
{
	LOAD_BOOL(CL_SYMBOLP(ARG(1)) && GET_SYMBOL(ARG(1)) == SYMBOL(Slisp, 49), ARG(3));	/* * */
	if(CL_TRUEP(ARG(3)))
	{
		goto THEN1;
	}
	else
	{
		COPY(ARG(0), ARG(4));
		array_element_type_internal(ARG(4));
		to_element_type(ARG(4));
		COPY(ARG(1), ARG(5));
		Fupgraded_array_element_type(ARG(5));
	}
	if(EQL(ARG(4), ARG(5)))
	{
		THEN1:;
		LOAD_BOOL(CL_SYMBOLP(ARG(2)) && GET_SYMBOL(ARG(2)) == SYMBOL(Slisp, 49), ARG(3));	/* * */
		if(CL_TRUEP(ARG(3)))
		{
			COPY(ARG(3), ARG(0));
		}
		else
		{
			if(CL_ATOMP(ARG(2)))
			{
				COPY(ARG(0), ARG(4));
				Farray_rank(ARG(4));
				COPY(ARG(2), ARG(5));
				Fnumeql(ARG(4), 2);
				COPY(ARG(4), ARG(0));
			}
			else
			{
				COPY(ARG(0), ARG(4));
				Farray_rank(ARG(4));
				COPY(ARG(2), ARG(5));
				Flength(ARG(5));
				Fnumeql(ARG(4), 2);
				if(CL_TRUEP(ARG(4)))
				{
					LOAD_NIL(ARG(4));
					LOAD_FIXNUM(ARG(5), 0, ARG(5));
					M1_1:;
					COPY(ARG(5), ARG(6));
					COPY(ARG(2), ARG(7));
					Flength(ARG(7));
					Fge(ARG(6), 2);
					if(CL_TRUEP(ARG(6)))
					{
						LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
						goto RETURN1;
					}
					COPY(ARG(2), ARG(6));
					COPY(ARG(6), ARG(7));
					if(CL_CONSP(ARG(7)))
					{
						COPY(GET_CAR(ARG(7)), ARG(6));
					}
					else
					{
						if(CL_TRUEP(ARG(7)))
						{
							LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(6));	/* ~a is not a list */
							Ferror(ARG(6), 2);
						}
						else
						{
							COPY(ARG(7), ARG(6));
						}
					}
					COPY(ARG(2), ARG(7));
					COPY(ARG(7), ARG(8));
					if(CL_CONSP(ARG(8)))
					{
						COPY(GET_CDR(ARG(8)), ARG(2));
					}
					else
					{
						if(CL_TRUEP(ARG(8)))
						{
							LOAD_SMSTR((CL_FORM *)&KClisp[262], ARG(9));	/* ~a is not a list */
							COPY(ARG(8), ARG(10));
							Ferror(ARG(9), 2);
						}
						else
						{
							COPY(ARG(8), ARG(2));
						}
					}
					COPY(ARG(6), ARG(4));
					LOAD_BOOL(CL_SYMBOLP(ARG(4)) && GET_SYMBOL(ARG(4)) == SYMBOL(Slisp, 49), ARG(6));	/* * */
					if(CL_TRUEP(ARG(6)))
					{
						goto THEN2;
					}
					else
					{
						COPY(ARG(0), ARG(7));
						COPY(ARG(5), ARG(8));
						Farray_dimension(ARG(7));
						COPY(ARG(4), ARG(8));
						Fnumeql(ARG(7), 2);
					}
					if(CL_TRUEP(ARG(7)))
					{
						THEN2:;
					}
					else
					{
						LOAD_NIL(ARG(0));
						goto RETURN1;
					}
					F1plus(ARG(5));
					goto M1_1;
					RETURN1:;
				}
				else
				{
					LOAD_NIL(ARG(0));
				}
			}
		}
	}
	else
	{
		LOAD_NIL(ARG(0));
	}
}