Changeset 502
- Timestamp:
- 01/21/08 02:41:15 (7 months ago)
- Files:
-
- trunk/thune/boot.c (modified) (2 diffs)
- trunk/thune/gc.c (modified) (1 diff)
- trunk/thune/internal.h (modified) (2 diffs)
- trunk/thune/mkboot.t (modified) (2 diffs)
- trunk/thune/tests/working/compare.t (modified) (3 diffs)
- trunk/thune/tests/working/control.good (modified) (1 diff)
- trunk/thune/tests/working/control.t (modified) (2 diffs)
- trunk/thune/tests/working/parse2.good (modified) (1 diff)
- trunk/thune/tests/working/parse2.t (modified) (1 diff)
- trunk/thune/thune.c (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
trunk/thune/boot.c
r488 r502 18 18 " opcode! 13 'proc make :proc\n" 19 19 " opcode! 14 'iter make :iter\n" 20 " opcode! 15 ' recurse make :recurse\n"21 " ; opcode! 16 'loop make :xx-loop\n"20 " opcode! 15 'each make :each\n" 21 " opcode! 16 'recurse make :recurse\n" 22 22 " opcode! 17 'return make :return\n" 23 23 " opcode! 18 'throw make :throw\n" … … 76 76 " forever drop\n" 77 77 "] 'loop func :loop.to\n" 78 "[ser body]\n"79 "[\n"80 " ser [first body do] iter\n"81 "] 'loop func :each ;(ser body -- )\n"82 "[ser words block! body block! | len-1]\n"83 "[\n"84 " ;words [first word! verify drop] iter\n"85 " ser\n"86 " words length?\n"87 " dup dec :len-1\n"88 " [\n"89 " 1 [words set body do]\n"90 " 2 [words set next body do]\n"91 " [words set len-1 skip body do]\n"92 " ] select\n"93 " iter\n"94 "]\n"95 "'loop func :each.set ; (ser words body -- )\n"96 78 "[ser accu op] [\n" 97 79 " ser [first accu op do :accu] iter\n" trunk/thune/gc.c
r458 r502 394 394 395 395 case CC_ITER: 396 case CC_EACH: 396 397 SET_BIT_BLOCK_L( it->cp.n ) 397 398 it -= CC_LEN_ITER; trunk/thune/internal.h
r490 r502 137 137 #define CC_REDUCE 5 138 138 #define CC_ITER 6 139 #define CC_CATCH 7 140 #define CC_TERM 8 141 #define CC_END 9 139 #define CC_EACH 7 140 #define CC_CATCH 8 141 #define CC_TERM 9 142 #define CC_END 10 142 143 #define CC_COUNT (CC_END+1) 143 144 … … 191 192 #define OP_PROC 13 192 193 #define OP_ITER 14 193 #define OP_ RECURSE15194 #define OP_ LOOP16194 #define OP_EACH 15 195 #define OP_RECURSE 16 195 196 #define OP_RETURN 17 196 197 #define OP_THROW 18 trunk/thune/mkboot.t
r488 r502 19 19 opcode! 13 'proc make :proc 20 20 opcode! 14 'iter make :iter 21 opcode! 15 ' recurse make :recurse22 ; opcode! 16 'loop make :xx-loop 21 opcode! 15 'each make :each 22 opcode! 16 'recurse make :recurse 23 23 opcode! 17 'return make :return 24 24 opcode! 18 'throw make :throw … … 86 86 ] 'loop func :loop.to 87 87 88 [ser body]89 [90 ser [first body do] iter91 ] 'loop func :each ;(ser body -- )92 93 [ser words block! body block! | len-1]94 [95 ;words [first word! verify drop] iter96 97 ser98 words length?99 dup dec :len-1100 [101 1 [words set body do]102 2 [words set next body do]103 [words set len-1 skip body do]104 ] select105 iter106 ]107 'loop func :each.set ; (ser words body -- )108 109 88 [ser accu op] [ 110 89 ser [first accu op do :accu] iter trunk/thune/tests/working/compare.t
r222 r502 20 20 [ 21 21 first :cmp 22 data [a b] [ 22 23 ;data [a b] [ 24 ; [a b dup2 cmp do] print 25 ;] each.set 26 27 data [ 28 [a b] set 23 29 [a b dup2 cmp do] print 24 ] each.set30 ] iter/2 25 31 ] proc :test 26 32 … … 35 41 36 42 "--- if ---" print 37 data [a b] [ 43 data 44 ;[a b] 45 [ 46 [a b] set 38 47 [a b ' ' 39 48 a b if/eq '= … … 44 53 a b if/gte '>= 45 54 ] print 46 ] each.set 47 55 ] 56 ;each.set 57 iter/2 trunk/thune/tests/working/control.good
r194 r502 45 45 each "two" 46 46 each "tree" 47 --- each.set 0 ---48 --- each.set 1 ---49 150 251 a52 b53 one54 two55 tree56 --- each.set 2 ---57 1 258 a b59 one two60 tree none61 --- each.set 3 ---62 1 2 a63 b one two64 tree none none65 --- each.set 8 ---66 1 2 a b one two tree none67 47 --- either --- 68 48 'T' trunk/thune/tests/working/control.t
r194 r502 27 27 28 28 29 /* 29 30 "--- each.set 0 ---" print 30 31 data tail [a] [[a] print] each.set … … 41 42 "--- each.set 8 ---" print 42 43 data [a b c d e f g h] [[a b c d e f g h] print] each.set 44 */ 43 45 44 46 trunk/thune/tests/working/parse2.good
r232 r502 16 16 17 17 18 [words string! file string! rev logic! | rules a b --]18 [words string! file string! rev logic! | rules a b ab --] 19 19 [ 20 20 [] copy :rules 21 21 words parse.white 22 [[b a] [a b]] rev pick 22 23 [[b a] [a b]] rev pick :ab 23 24 [ 25 ab set 24 26 rules [a (b prin) |] copy 'a infuse append.cat tail prev mark.eol drop 25 27 ] 26 each.set28 iter/2 27 29 28 30 file read trunk/thune/tests/working/parse2.t
r232 r502 16 16 17 17 18 [words string! file string! rev logic! | rules a b --]18 [words string! file string! rev logic! | rules a b ab --] 19 19 [ 20 20 [] copy :rules 21 21 words parse.white 22 [[b a] [a b]] rev pick 22 23 [[b a] [a b]] rev pick :ab 23 24 [ 25 ab set 24 26 rules [a (b prin) |] copy 'a infuse append.cat tail prev mark.eol drop 25 27 ] 26 each.set28 iter/2 27 29 28 30 file read trunk/thune/thune.c
r499 r502 51 51 52 52 case CC_ITER: 53 case CC_EACH: 53 54 toc -= CC_LEN_ITER; 54 55 break; … … 352 353 UR_C_GROW 353 354 354 355 #define PUSHC_ITER(blkn,a,b,itSkip) \356 UR_TOC->cp.cell = a; \357 UR_C_GROW; \358 UR_TOC->iter.code = CC_ITER; \359 UR_TOC->iter.skip = itSkip; \360 UR_TOC->iter.n = blkn; \361 UR_TOC->iter.cell = b; \362 UR_C_GROW363 364 #define RESET_ITER(a,b) \365 b = UR_TOC->iter.cell; \366 a = UR_TOC[-1].cp.cell; \367 UR_C_GROW368 355 369 356 #define DO_BLOCK(vp) \ … … 615 602 616 603 case OP_ITER: // (series blk -- ) 604 case OP_EACH: 617 605 if( ur_is(UR_TOS, UT_BLOCK) && 618 606 (ur_itLen( ut, ur_s_prev(UR_TOS) ) > 0) ) 619 607 { 608 int itype = (ur_opcode(val) == OP_ITER) ? 609 CC_ITER : CC_EACH; 620 610 int skip = ur_sel(val); 621 611 if( skip == 0 ) 622 612 skip = 1; 613 623 614 PUSHC_EVAL( blkN, start, pc ); 624 615 SET_BLK_PC( UR_TOS->series.n, 625 616 UR_TOS->series.it ); 626 PUSHC_ITER( blkN, pc, end, skip ); 627 628 // Loop code must drop TOS. 629 *UR_TOS = UR_TOS[-1]; // drop dup 617 618 ur_copyCell( ut->toc, UR_TOS[-1] ); 619 UR_C_GROW; 620 //ur_copyCell( ut->toc, UR_TOS ); 621 UR_TOC->iter.code = itype; 622 UR_TOC->iter.skip = skip; 623 ut->toc->series.n = UR_TOS->series.n; 624 ut->toc->series.it = UR_TOS->series.it; 625 ut->toc->series.end = UR_TOS->series.end; 626 UR_C_GROW; 627 628 UR_S_DROP; // Loop code must drop TOS. 629 if( itype == CC_EACH ) 630 ur_pick( ut, UR_TOS, 0, UR_TOS ); 630 631 } 631 632 else … … 1071 1072 1072 1073 case CC_ITER: 1074 case CC_EACH: 1073 1075 { 1074 1076 int skip = UR_TOC->iter.skip; 1075 UR_TOS->series.it += skip; 1076 if( ((skip > 0) ? ur_itLen(ut, UR_TOS) : UR_TOS->series.it + 1) 1077 UCell* ser = ut->toc - 1; 1078 ser->series.it += skip; 1079 if( ((skip > 0) ? ur_itLen(ut, ser) : ser->series.it + 1) 1077 1080 > 0 ) 1078 1081 { 1079 RESET_ITER( pc, end ); 1080 UR_S_DUP; // Loop code must drop TOS. 1082 UR_S_GROW; // Loop code must drop TOS. 1083 if( UR_TOC->id.code == CC_EACH ) 1084 ur_pick( ut, ser, 0, UR_TOS ); 1085 else 1086 ur_copyCell(UR_TOS, *ser); 1087 1088 SET_BLK_PC( ut->toc->series.n, ut->toc->series.it ); 1089 UR_C_GROW; 1081 1090 goto execute; 1082 1091 } 1083 1092 UR_C_DEC; 1084 UR_S_DROP; // Pop iterator value.1085 1093 } 1086 1094 goto control; … … 1167 1175 1168 1176 case CC_ITER: 1177 case CC_EACH: 1169 1178 UR_C_DECN( CC_LEN_ITER ); 1170 1179 if( ur_is(UR_TOS, UT_WORD) && 1171 1180 ur_atom(UR_TOS) == UR_ATOM_BREAK ) 1172 1181 { 1173 UR_S_DROP N( 2 );1182 UR_S_DROP; 1174 1183 goto control; 1175 1184 }
