*/ REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def) /* ***********************************************************************/ { REBVAL *spec; REBVAL *body; REBCNT len; if ( !IS_BLOCK(def) || (len = VAL_LEN(def)) < 2 || !IS_BLOCK(spec = VAL_BLK(def)) ) return FALSE; body = VAL_BLK_SKIP(def, 1); VAL_FUNC_SPEC(value) = VAL_SERIES(spec); VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec)); if (type != REB_COMMAND) { if (len != 2 || !IS_BLOCK(body)) return FALSE; VAL_FUNC_BODY(value) = VAL_SERIES(body); } else Make_Command(value, def); VAL_SET(value, type); if (type == REB_FUNCTION || type == REB_CLOSURE) Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value)); return TRUE; }
*/ REBFLG Copy_Function(REBVAL *value, REBVAL *args) /* ***********************************************************************/ { REBVAL *spec = VAL_BLK(args); REBVAL *body = VAL_BLK_SKIP(args, 1); if (IS_END(spec)) body = 0; else { // Spec given, must be block or * if (IS_BLOCK(spec)) { VAL_FUNC_SPEC(value) = VAL_SERIES(spec); VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec)); } else if (!IS_STAR(spec)) return FALSE; } if (body && !IS_END(body)) { if (!IS_FUNCTION(value) && !IS_CLOSURE(value)) return FALSE; // Body must be block: if (!IS_BLOCK(body)) return FALSE; VAL_FUNC_BODY(value) = VAL_SERIES(body); } // No body, use protytpe: else if (IS_FUNCTION(value) || IS_CLOSURE(value)) VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(value)); // Rebind function words: if (IS_FUNCTION(value)) Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value)); return TRUE; }
*/ REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def) /* ***********************************************************************/ { REBVAL *spec; REBVAL *body; REBCNT len; if ( !IS_BLOCK(def) //// || type < REB_CLOSURE // for now || (len = VAL_LEN(def)) < 2 || !IS_BLOCK(spec = VAL_BLK(def)) ) return FALSE; body = VAL_BLK_SKIP(def, 1); // Print("Make_Func"); //: %s spec %d", Get_Sym_Name(type+1), SERIES_TAIL(spec)); VAL_FUNC_SPEC(value) = VAL_SERIES(spec); VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec)); if (type != REB_COMMAND) { if (len != 2 || !IS_BLOCK(body)) return FALSE; VAL_FUNC_BODY(value) = VAL_SERIES(body); } else Make_Command(value, def); VAL_SET(value, type); if (type == REB_FUNCTION) Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value)); return TRUE; }
*/ void Bind_Stack_Block(REBSER *body, REBSER *block) /* ***********************************************************************/ { REBINT dsf = DSF; // Find body (frame) on stack: while (body != VAL_WORD_FRAME(DSF_WORD(dsf))) { dsf = PRIOR_DSF(dsf); if (dsf <= 0) Trap0(RE_NOT_DEFINED); // better message !!!! } if (IS_FUNCTION(DSF_FUNC(dsf))) { Bind_Relative(VAL_FUNC_ARGS(DSF_FUNC(dsf)), body, block); } }
*/ void Bind_Frame(REBSER *obj) /* ** Clone a frame, knowing which types of values need to be ** copied, deep copied, and rebound. ** ***********************************************************************/ { REBVAL *val; REBOOL funcs = FALSE; //DISABLE_GC; // Copy functions: for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) { if (IS_FUNCTION(val)) { Clone_Function(val, val); funcs = TRUE; } else if (IS_CLOSURE(val)) { funcs = TRUE; } } // Rebind all values: Bind_Block(obj, BLK_SKIP(obj, 1), BIND_DEEP | BIND_FUNC); if (funcs) { // Rebind functions: for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) { if (IS_FUNCTION(val)) { Bind_Relative(VAL_FUNC_ARGS(val), VAL_FUNC_BODY(val), VAL_FUNC_BODY(val)); } else if (IS_CLOSURE(val)) { } } } //ENABLE_GC; }
*/ void Bind_Stack_Block(REBSER *frame, REBSER *block) /* ***********************************************************************/ { Bind_Relative(frame, frame, block); }