Posted to tcl by aku at Wed Jun 24 22:59:31 GMT 2020view pretty
int marpatcl_scr_rep_from_any (Tcl_Interp* ip, Tcl_Obj* o) { /* * The conversion goes through a list intrep, avoiding manual parsing of * the structure. */ int objc; Tcl_Obj **objv; int robjc; Tcl_Obj **robjv; SCR* scr = NULL; OTSCR* otscr = NULL; int start, end, i; marpatcl_unicontext_data ctx = marpatcl_unicontext (ip); TRACE_FUNC ("(ip %p, o %p)", ip, o); /* * The class is a list of codepoints and ranges (2-element lists). */ if (Tcl_ListObjGetElements(ip, o, &objc, &objv) != TCL_OK) { goto fail; } scr = marpatcl_scr_new (objc); TRACE ("CAP %d", objc); for (i = 0; i < objc; i++) { Tcl_Obj* elt = objv[i]; TRACE ("PROCESS. [%02d] %p", i, elt); /* * First handle objects which already have a suitable type. No * conversions required, only data extraction and validation. */ if (elt->typePtr == ctx->intType) { TRACE ("INT. ... [%02d] %p", i, elt); process_int: TRACE ("INT. CHK [%02d] %p", i, elt); if (marpatcl_get_codepoint_from_obj (ip, elt, &start) != TCL_OK) { goto fail; } TRACE ("++ (%d)", start); marpatcl_scr_add_range(scr, start, start); continue; } if (elt->typePtr == ctx->listType) { TRACE ("LIST ... [%02d] %p", i, elt); process_list: TRACE ("LIST CHK [%02d] %p", i, elt); if (marpatcl_get_range_from_obj (ip, elt, &start, &end) != TCL_OK) { goto fail; } TRACE ("++ (%d...%d)", start, end); marpatcl_scr_add_range(scr, start, end); continue; } /* * While object has no suitable type, it may be convertible to * such. Those which are convertable get dispatched to the handlers * above. */ if (Tcl_GetIntFromObj(ip, elt, &start) == TCL_OK) { TRACE ("INT. CVT [%02d] %p", i, elt); goto process_int; } if (Tcl_ListObjGetElements(ip, elt, &robjc, &robjv) == TCL_OK) { TRACE ("LIST CVT [%02d] %p", i, elt); goto process_list; } TRACE ("NO.. CVT [%02d] %p", i, elt); /* * No suitable type, and not convertible to such either. Most of the * time this is not reached because most bogus input is convertible to * a list. And then the range-validation kicks in. Only bad list * syntax comes here. */ Tcl_SetErrorCode (ip, "MARPA", NULL); Tcl_SetObjResult (ip, Tcl_NewStringObj("Expected codepoint or range, got neither",-1)); goto fail; } TRACE ("USE %d", scr->n); otscr = marpatcl_otscr_take (marpatcl_otscr_new (scr)); /* * Kill the old intrep (a list). This was delayed as much as * possible. Afterward we can put in our own intrep. */ FreeIntRep (o); o->INT_REP = otscr; o->typePtr = &marpatcl_scr_objtype; TRACE_RETURN ("ok: %d", TCL_OK); fail: TRACE ("%s", "FAIL"); if (scr) { marpatcl_scr_destroy(scr); } TRACE_RETURN ("err: %d", TCL_ERROR); }