Exemplo n.º 1
0
//
//  Is_Type_Of: C
// 
// Types can be: word or block. Each element must be either
// a datatype or a typeset.
//
static REBOOL Is_Type_Of(const REBVAL *value, REBVAL *types)
{
    const REBVAL *val;

    val = IS_WORD(types) ? GET_OPT_VAR_MAY_FAIL(types) : types;

    if (IS_DATATYPE(val))
        return LOGICAL(VAL_TYPE_KIND(val) == VAL_TYPE(value));

    if (IS_TYPESET(val))
        return LOGICAL(TYPE_CHECK(val, VAL_TYPE(value)));

    if (IS_BLOCK(val)) {
        for (types = VAL_ARRAY_AT(val); NOT_END(types); types++) {
            val = IS_WORD(types) ? GET_OPT_VAR_MAY_FAIL(types) : types;
            if (IS_DATATYPE(val)) {
                if (VAL_TYPE_KIND(val) == VAL_TYPE(value)) return TRUE;
            }
            else if (IS_TYPESET(val)) {
                if (TYPE_CHECK(val, VAL_TYPE(value))) return TRUE;
            }
            else
                fail (Error(RE_INVALID_TYPE, Type_Of(val)));
        }
        return FALSE;
    }

    fail (Error_Invalid_Arg(types));
}
Exemplo n.º 2
0
//
//  Update_Typeset_Bits_Core: C
//
// This sets the bits in a bitset according to a block of datatypes.  There
// is special handling by which BAR! will set the "variadic" bit on the
// typeset, which is heeded by functions only.
//
// !!! R3-Alpha supported fixed word symbols for datatypes and typesets.
// Confusingly, this means that if you have said `word!: integer!` and use
// WORD!, you will get the integer type... but if WORD! is unbound then it
// will act as WORD!.  Also, is essentially having "keywords" and should be
// reviewed to see if anything actually used it.
//
REBOOL Update_Typeset_Bits_Core(
    REBVAL *typeset,
    const REBVAL *head,
    REBOOL trap // if TRUE, then return FALSE instead of failing
) {
    const REBVAL *item = head;

    REBARR *types = VAL_ARRAY(ROOT_TYPESETS);

    assert(IS_TYPESET(typeset));

    VAL_TYPESET_BITS(typeset) = 0;

    for (; NOT_END(item); item++) {
        const REBVAL *var = NULL;

        if (IS_BAR(item)) {
            SET_VAL_FLAG(typeset, TYPESET_FLAG_VARIADIC);
            continue;
        }

        if (IS_WORD(item) && !(var = TRY_GET_OPT_VAR(item))) {
            REBSYM sym = VAL_WORD_SYM(item);

            // See notes: if a word doesn't look up to a variable, then its
            // symbol is checked as a second chance.
            //
            if (IS_KIND_SYM(sym)) {
                TYPE_SET(typeset, KIND_FROM_SYM(sym));
                continue;
            }
            else if (sym >= SYM_ANY_NOTHING_X && sym < SYM_DATATYPES)
                var = ARR_AT(types, sym - SYM_ANY_NOTHING_X);
        }

        if (!var) var = item;

        if (IS_DATATYPE(var)) {
            TYPE_SET(typeset, VAL_TYPE_KIND(var));
        }
        else if (IS_TYPESET(var)) {
            VAL_TYPESET_BITS(typeset) |= VAL_TYPESET_BITS(var);
        }
        else {
            if (trap) return FALSE;

            fail (Error_Invalid_Arg(item));
        }
    }

    return TRUE;
}
Exemplo n.º 3
0
*/	static REBOOL Is_Of_Type(REBVAL *value, REBVAL *types)
/*
**		Types can be: word or block. Each element must be either
**		a datatype or a typeset.
**
***********************************************************************/
{
	REBVAL *val;

	val = IS_WORD(types) ? Get_Var(types) : types;

	if (IS_DATATYPE(val)) {
		return (VAL_DATATYPE(val) == (REBINT)VAL_TYPE(value));
	}

	if (IS_TYPESET(val)) {
		return (TYPE_CHECK(val, VAL_TYPE(value)));
	}

	if (IS_BLOCK(val)) {
		for (types = VAL_BLK_DATA(val); NOT_END(types); types++) {
			val = IS_WORD(types) ? Get_Var(types) : types;
			if (IS_DATATYPE(val))
				if (VAL_DATATYPE(val) == (REBINT)VAL_TYPE(value)) return TRUE;
			else if (IS_TYPESET(val))
				if (TYPE_CHECK(val, VAL_TYPE(value))) return TRUE;
			else
				Trap1(RE_INVALID_TYPE, Of_Type(val));
		}
		return FALSE;
	}

	Trap_Arg(types);

	return 0; // for compiler
}
Exemplo n.º 4
0
*/	static int Count_Dia_Args(REBVAL *args)
/*
**		Return number of formal args provided to the function.
**		This is just a guess, because * repeats count as zero.
**
***********************************************************************/
{
	REBINT n = 0;

	for (; NOT_END(args); args++) {
		if (IS_WORD(args)) {
			if (VAL_WORD_SYM(args) == SYM__P) { // skip: * type
				if (NOT_END(args+1)) args++;
			} else n++;
		}
		else if (IS_DATATYPE(args) || IS_TYPESET(args)) n++;
	}
	return n;
}
Exemplo n.º 5
0
*/	REBFLG Make_Typeset(REBVAL *block, REBVAL *value, REBFLG load)
/*
**		block - block of datatypes (datatype words ok too)
**		value - value to hold result (can be word-spec type too)
**
***********************************************************************/
{
	const REBVAL *val;
	REBCNT sym;
	REBSER *types = VAL_SERIES(ROOT_TYPESETS);

	VAL_TYPESET(value) = 0;

	for (; NOT_END(block); block++) {
		val = NULL;
		if (IS_WORD(block)) {
			//Print("word: %s", Get_Word_Name(block));
			sym = VAL_WORD_SYM(block);
			if (VAL_WORD_FRAME(block)) { // Get word value
				val = GET_VAR(block);
			} else if (sym < REB_MAX) { // Accept datatype word
				TYPE_SET(value, VAL_WORD_SYM(block)-1);
				continue;
			} // Special typeset symbols:
			else if (sym >= SYM_ANY_TYPEX && sym <= SYM_ANY_BLOCKX)
				val = BLK_SKIP(types, sym - SYM_ANY_TYPEX + 1);
		}
		if (!val) val = block;
		if (IS_DATATYPE(val)) {
			TYPE_SET(value, VAL_DATATYPE(val));
		} else if (IS_TYPESET(val)) {
			VAL_TYPESET(value) |= VAL_TYPESET(val);
		} else {
			if (load) return FALSE;
			Trap_Arg_DEAD_END(block);
		}
	}

	return TRUE;
}
Exemplo n.º 6
0
*/	REBCNT Find_Block(REBSER *series, REBCNT index, REBCNT end, REBVAL *target, REBCNT len, REBCNT flags, REBINT skip)
/*
**		Flags are set according to: ALL_FIND_REFS
**
**	Main Parameters:
**		start - index to start search
**		end   - ending position
**		len   - length of target
**		skip  - skip factor
**		dir   - direction
**
**	Comparison Parameters:
**		case  - case sensitivity
**		wild  - wild cards/keys
**
**	Final Parmameters:
**		tail  - tail position
**		match - sequence
**		SELECT - (value that follows)
**
***********************************************************************/
{
	REBVAL *value;
	REBVAL *val;
	REBCNT cnt;
	REBCNT start = index;

	if (flags & (AM_FIND_REVERSE | AM_FIND_LAST)) {
		skip = -1;
		start = 0;
		if (flags & AM_FIND_LAST) index = end - len;
		else index--;
	}

	// Optimized find word in block:
	if (ANY_WORD(target)) {
		for (; index >= start && index < end; index += skip) {
			value = BLK_SKIP(series, index);
			if (ANY_WORD(value)) {
				cnt = (VAL_WORD_SYM(value) == VAL_WORD_SYM(target));
				if (flags & AM_FIND_CASE) {
					// Must be same type and spelling:
					if (cnt && VAL_TYPE(value) == VAL_TYPE(target)) return index;
				}
				else {
					// Can be different type or alias:
					if (cnt || VAL_WORD_CANON(value) == VAL_WORD_CANON(target)) return index;
				}
			}
			if (flags & AM_FIND_MATCH) break;
		}
		return NOT_FOUND;
	}
	// Match a block against a block:
	else if (ANY_BLOCK(target) && !(flags & AM_FIND_ONLY)) {
		for (; index >= start && index < end; index += skip) {
			cnt = 0;
			value = BLK_SKIP(series, index);
			for (val = VAL_BLK_DATA(target); NOT_END(val); val++, value++) {
				if (0 != Cmp_Value(value, val, (REBOOL)(flags & AM_FIND_CASE))) break;
				if (++cnt >= len) {
					return index;
				}
			}
			if (flags & AM_FIND_MATCH) break;
		}
		return NOT_FOUND;
	}
	// Find a datatype in block:
	else if (IS_DATATYPE(target) || IS_TYPESET(target)) {
		for (; index >= start && index < end; index += skip) {
			value = BLK_SKIP(series, index);
			// Used if's so we can trace it...
			if (IS_DATATYPE(target)) {
				if ((REBINT)VAL_TYPE(value) == VAL_DATATYPE(target)) return index;
				if (IS_DATATYPE(value) && VAL_DATATYPE(value) == VAL_DATATYPE(target)) return index;
			}
			if (IS_TYPESET(target)) {
				if (TYPE_CHECK(target, VAL_TYPE(value))) return index;
				if (IS_DATATYPE(value) && TYPE_CHECK(target, VAL_DATATYPE(value))) return index;
				if (IS_TYPESET(value) && EQUAL_TYPESET(value, target)) return index;
			}
			if (flags & AM_FIND_MATCH) break;
		}
		return NOT_FOUND;
	}
	// All other cases:
	else {
		for (; index >= start && index < end; index += skip) {
			value = BLK_SKIP(series, index);
			if (0 == Cmp_Value(value, target, (REBOOL)(flags & AM_FIND_CASE))) return index;
			if (flags & AM_FIND_MATCH) break;
		}
		return NOT_FOUND;
	}
}
Exemplo n.º 7
0
*/	void Make_Block_Type(REBFLG make, REBVAL *value, REBVAL *arg)
/*
**		Value can be:
**			1. a datatype (e.g. BLOCK!)
**			2. a value (e.g. [...])
**
**		Arg can be:
**			1. integer (length of block)
**			2. block (copy it)
**			3. value (convert to a block)
**
***********************************************************************/
{
	REBCNT type;
	REBCNT len;
	REBSER *ser;

	// make block! ...
	if (IS_DATATYPE(value))
		type = VAL_DATATYPE(value);
	else  // make [...] ....
		type = VAL_TYPE(value);

	// make block! [1 2 3]
	if (ANY_BLOCK(arg)) {
		len = VAL_BLK_LEN(arg);
		if (len > 0 && type >= REB_PATH && type <= REB_LIT_PATH)
			No_Nones(arg);
		ser = Copy_Values(VAL_BLK_DATA(arg), len);
		goto done;
	}

	if (IS_STRING(arg)) {
		REBCNT index, len = 0;
		VAL_SERIES(arg) = Prep_Bin_Str(arg, &index, &len); // (keeps safe)
		ser = Scan_Source(VAL_BIN(arg), VAL_LEN(arg));
		goto done;
	}

	if (IS_BINARY(arg)) {
		ser = Scan_Source(VAL_BIN_DATA(arg), VAL_LEN(arg));
		goto done;
	}

	if (IS_MAP(arg)) {
		ser = Map_To_Block(VAL_SERIES(arg), 0);
		goto done;
	}

	if (ANY_OBJECT(arg)) {
		ser = Make_Object_Block(VAL_OBJ_FRAME(arg), 3);
		goto done;
	}

	if (IS_VECTOR(arg)) {
		ser = Make_Vector_Block(arg);
		goto done;
	}

//	if (make && IS_NONE(arg)) {
//		ser = Make_Block(0);
//		goto done;
//	}

	// to block! typset
	if (!make && IS_TYPESET(arg) && type == REB_BLOCK) {
		Set_Block(value, Typeset_To_Block(arg));
		return;
	}

	if (make) {
		// make block! 10
		if (IS_INTEGER(arg) || IS_DECIMAL(arg)) {
			len = Int32s(arg, 0);
			Set_Series(type, value, Make_Block(len));
			return;
		}
		Trap_Arg(arg);
	}

	ser = Copy_Values(arg, 1);

done:
	Set_Series(type, value, ser);
	return;
}
Exemplo n.º 8
0
*/	static REBINT Add_Arg(REBDIA *dia, REBVAL *value)
/*
**		Add an actual argument to the output block.
**
**		Note that the argument may be out sequence with the formal
**		arguments so we must scan for a slot that matches.
**
**		Returns:
**		  1: arg matches a formal arg and has been stored
**		  0: no arg of that type was found
**		 -N: error (type block contains a bad value)
**
***********************************************************************/
{
	REBINT type = 0;
	REBINT accept = 0;
	REBVAL *fargs;
	REBINT fargi;
	REBVAL *outp;
	REBINT rept = 0;

	outp = BLK_SKIP(dia->out, dia->outi);

	// Scan all formal args, looking for one that matches given value:
	for (fargi = dia->fargi;; fargi++) {

		//Debug_Fmt("Add_Arg fargi: %d outi: %d", fargi, outi);
		
		if (IS_END(fargs = BLK_SKIP(dia->fargs, fargi))) return 0;

again:
		// Formal arg can be a word (type or refinement), datatype, or * (repeater):
		if (IS_WORD(fargs)) {

			// If word is a datatype name:
			type = VAL_WORD_CANON(fargs);
			if (type < REB_MAX) {
				type--;	// the type id
			}
			else if (type == SYM__P) {
				// repeat: * integer!
				rept = 1;
				fargs++;
				goto again;
			}
			else {
				// typeset or refinement
				REBVAL *temp;

				type = -1;

				// Is it a refinement word?
				if (IS_WORD(value) && VAL_WORD_CANON(fargs) == VAL_WORD_CANON(value)) {
					accept = 4;
				}
				// Is it a typeset?
				else if (NZ(temp = Get_Var_No_Trap(fargs)) && IS_TYPESET(temp)) {
					if (TYPE_CHECK(temp, VAL_TYPE(value))) accept = 1;
				}
				else if (!IS_WORD(value)) return 0; // do not search past a refinement
				//else return -REB_DIALECT_BAD_SPEC;
			}
		}
		// It's been reduced and is an actual datatype or typeset:
		else if (IS_DATATYPE(fargs)) {
			type = VAL_DATATYPE(fargs);
		}
		else if (IS_TYPESET(fargs)) {
			if (TYPE_CHECK(fargs, VAL_TYPE(value))) accept = 1;
		} else
			return -REB_DIALECT_BAD_SPEC;

		// Make room for it in the output block:
		if (IS_END(outp))
			outp = Append_Value(dia->out);
		else if (!IS_NONE(outp)) {
			// There's already an arg in this slot, so skip it...
			if (dia->cmd > 1) outp++;	
			if (!rept) continue; // see if there's another farg that will work for it
			// Look for first empty slot:
			while (NOT_END(outp) && !IS_NONE(outp)) outp++;
			if (IS_END(outp)) outp = Append_Value(dia->out);
		}

		// The datatype was correct from above!
		if (accept) break;

		//Debug_Fmt("want: %d got: %d rept: %d", type, VAL_TYPE(value), rept);

		// Direct match to datatype or to integer/decimal coersions:
		if (type == (REBINT)VAL_TYPE(value)) {
			accept = 1;
			break;
		}
		else if (type == REB_INTEGER && IS_DECIMAL(value)) {
			accept = 2;
			break;
		}
		else if (type == REB_DECIMAL && IS_INTEGER(value)) {
			accept = 3;
			break;
		}

		dia->missed++;				// for debugging

		// Repeat did not match, so stop repeating and remove unused output slot:
		if (rept) {
			Remove_Last(dia->out);
			outp--;
			rept = 0;
			continue;
		}

		if (dia->cmd > 1) outp++;	// skip output slot (for non-default values)
	}

	// Process the result:
	switch (accept) {

	case 1:
		*outp = *value;
		break;

	case 2:
		SET_INTEGER(outp, (REBI64)VAL_DECIMAL(value));
		break;

	case 3:
		SET_DECIMAL(outp, (REBDEC)VAL_INT64(value));
		break;

	case 4:	// refinement:
		dia->fargi = fargs - BLK_HEAD(dia->fargs) + 1;
		dia->outi = outp - BLK_HEAD(dia->out) + 1;
		*outp = *value;
		return 1;

	case 0:
		return 0;
	}

	// Optimization: arg was in correct order:
	if (!rept && fargi == (signed)(dia->fargi)) {
		dia->fargi++;
		dia->outi++;
	}

	return 1;
}