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