Posted to tcl by jima at Tue Sep 25 21:46:01 GMT 2018view raw

  1. static void expand(
  2. Tcl_Interp *interp,
  3. int lr, unsigned int *R,
  4. int lpa, unsigned int *pa,
  5. Tcl_Obj *sub,
  6. int i, Tcl_Obj *buf
  7. ) {
  8. int lc;
  9. Tcl_ListObjLength( interp, sub, &lc );
  10. lc = lc + 1;
  11. unsigned int* cur;
  12. cur = malloc( sizeof( unsigned int ) * lc );
  13. Tcl_Obj* r;
  14. for( int j = 0; j < lc - 1; j++ ) {
  15. Tcl_ListObjIndex( interp, sub, j, &r );
  16. Tcl_GetIntFromObj( interp, r, &cur[j] );
  17. }
  18. for( ; i < lpa; i++ ) {
  19. cur[lc-1] = pa[i];
  20. for( int j = 0; j < lr; j = j + 3 ) {
  21. for( int k1 = 0; k1 < lc; k1++ ) {
  22. if( R[j] == cur[k1] ) {
  23. for( int k2 = 0; k2 < lc; k2++ ) {
  24. if( R[j+1] == cur[k2] ) {
  25. for( int k3 = 0; k3 < lc; k3++ ) {
  26. if( R[j+2] == cur[k3] ) {
  27. return;
  28. }
  29. }
  30. }
  31. }
  32. }
  33. }
  34. }
  35. r = Tcl_DuplicateObj( sub );
  36. Tcl_ListObjAppendElement( interp, r, Tcl_NewIntObj( pa[i] ) );
  37. Tcl_ListObjAppendElement( interp, buf, r );
  38. expand( interp, lr, R, lpa, pa, r, i+1, buf );
  39. }
  40. free( cur );
  41. return;
  42. }
  43.  
  44. /*
  45. list redux
  46. list sortx (or just size_t n), this is pa
  47. */
  48. static int TisCExpand_Cmd(
  49. ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
  50. ) {
  51. /* R */
  52. /* 0 ... Len-1 */
  53. int lr;
  54. Tcl_ListObjLength( interp, objv[1], &lr );
  55. unsigned int* R;
  56. R = malloc( sizeof( unsigned int ) * lr );
  57. Tcl_Obj* r;
  58. for( int j = 0; j < lr; j++ ) {
  59. Tcl_ListObjIndex( interp, objv[1], j, &r );
  60. Tcl_GetIntFromObj( interp, r, &R[j] );
  61. }
  62. /* pa */
  63. /* 0 ... Len-1 */
  64. int lpa;
  65. Tcl_ListObjLength( interp, objv[2], &lpa );
  66. unsigned int* pa;
  67. pa = malloc( sizeof( unsigned int ) * lpa );
  68. for( int k = 0; k < lpa; k++ ) {
  69. Tcl_ListObjIndex( interp, objv[2], k, &r );
  70. Tcl_GetIntFromObj( interp, r, &pa[k] );
  71. }
  72. /* sub */
  73. Tcl_Obj* sub;
  74. sub = Tcl_NewListObj( 0, NULL );
  75. /* i */
  76. int i = 0;
  77. /* buf */
  78. Tcl_Obj* buf;
  79. buf = Tcl_NewListObj( 0, NULL );
  80. /* expand */
  81. expand( interp, lr, R, lpa, pa, sub, i, buf );
  82. /* bye */
  83. free( R );
  84. free( pa );
  85. /* result */
  86. Tcl_SetObjResult( interp, buf );
  87. return TCL_OK;
  88. }