Posted to tcl by aku at Wed Jun 24 22:59:31 GMT 2020view raw

  1. int
  2. marpatcl_scr_rep_from_any (Tcl_Interp* ip, Tcl_Obj* o)
  3. {
  4. /*
  5. * The conversion goes through a list intrep, avoiding manual parsing of
  6. * the structure.
  7. */
  8. int objc;
  9. Tcl_Obj **objv;
  10. int robjc;
  11. Tcl_Obj **robjv;
  12. SCR* scr = NULL;
  13. OTSCR* otscr = NULL;
  14. int start, end, i;
  15.  
  16. marpatcl_unicontext_data ctx = marpatcl_unicontext (ip);
  17.  
  18. TRACE_FUNC ("(ip %p, o %p)", ip, o);
  19. /*
  20. * The class is a list of codepoints and ranges (2-element lists).
  21. */
  22. if (Tcl_ListObjGetElements(ip, o, &objc, &objv) != TCL_OK) {
  23. goto fail;
  24. }
  25.  
  26. scr = marpatcl_scr_new (objc);
  27. TRACE ("CAP %d", objc);
  28. for (i = 0; i < objc; i++) {
  29. Tcl_Obj* elt = objv[i];
  30. TRACE ("PROCESS. [%02d] %p", i, elt);
  31.  
  32. /*
  33. * First handle objects which already have a suitable type. No
  34. * conversions required, only data extraction and validation.
  35. */
  36.  
  37. if (elt->typePtr == ctx->intType) {
  38. TRACE ("INT. ... [%02d] %p", i, elt);
  39.  
  40. process_int:
  41. TRACE ("INT. CHK [%02d] %p", i, elt);
  42. if (marpatcl_get_codepoint_from_obj (ip, elt, &start) != TCL_OK) {
  43. goto fail;
  44. }
  45. TRACE ("++ (%d)", start);
  46. marpatcl_scr_add_range(scr, start, start);
  47. continue;
  48.  
  49. }
  50.  
  51. if (elt->typePtr == ctx->listType) {
  52. TRACE ("LIST ... [%02d] %p", i, elt);
  53.  
  54. process_list:
  55. TRACE ("LIST CHK [%02d] %p", i, elt);
  56. if (marpatcl_get_range_from_obj (ip, elt, &start, &end) != TCL_OK) {
  57. goto fail;
  58. }
  59. TRACE ("++ (%d...%d)", start, end);
  60. marpatcl_scr_add_range(scr, start, end);
  61. continue;
  62. }
  63.  
  64. /*
  65. * While object has no suitable type, it may be convertible to
  66. * such. Those which are convertable get dispatched to the handlers
  67. * above.
  68. */
  69.  
  70. if (Tcl_GetIntFromObj(ip, elt, &start) == TCL_OK) {
  71. TRACE ("INT. CVT [%02d] %p", i, elt);
  72. goto process_int;
  73. }
  74.  
  75. if (Tcl_ListObjGetElements(ip, elt, &robjc, &robjv) == TCL_OK) {
  76. TRACE ("LIST CVT [%02d] %p", i, elt);
  77. goto process_list;
  78. }
  79.  
  80. TRACE ("NO.. CVT [%02d] %p", i, elt);
  81.  
  82. /*
  83. * No suitable type, and not convertible to such either. Most of the
  84. * time this is not reached because most bogus input is convertible to
  85. * a list. And then the range-validation kicks in. Only bad list
  86. * syntax comes here.
  87. */
  88.  
  89. Tcl_SetErrorCode (ip, "MARPA", NULL);
  90. Tcl_SetObjResult (ip, Tcl_NewStringObj("Expected codepoint or range, got neither",-1));
  91. goto fail;
  92. }
  93.  
  94. TRACE ("USE %d", scr->n);
  95.  
  96. otscr = marpatcl_otscr_take (marpatcl_otscr_new (scr));
  97.  
  98. /*
  99. * Kill the old intrep (a list). This was delayed as much as
  100. * possible. Afterward we can put in our own intrep.
  101. */
  102.  
  103. FreeIntRep (o);
  104.  
  105. o->INT_REP = otscr;
  106. o->typePtr = &marpatcl_scr_objtype;
  107.  
  108. TRACE_RETURN ("ok: %d", TCL_OK);
  109.  
  110. fail:
  111. TRACE ("%s", "FAIL");
  112. if (scr) {
  113. marpatcl_scr_destroy(scr);
  114. }
  115. TRACE_RETURN ("err: %d", TCL_ERROR);
  116. }
  117.