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);
}