Changeset 503

Timestamp:

01/21/08 16:21:29 (8 months ago)

Author:

krobillard

Message:

Iter/each can now take skip value on stack. Each.set works again.

Location:

trunk/thune

Files:

• boot.c (modified) (1 diff)
• doc/UserManual (modified) (2 diffs)
• mkboot.t (modified) (1 diff)
• tests/working/compare.t (modified) (3 diffs)
• tests/working/control.good (modified) (1 diff)
• tests/working/control.t (modified) (2 diffs)
• tests/working/iter.good (modified) (1 diff)
• tests/working/iter.t (modified) (1 diff)
• tests/working/parse2.good (modified) (1 diff)
• tests/working/parse2.t (modified) (1 diff)
• thune.c (modified) (3 diffs)

trunk/thune/boot.c

@@ -76 +76 @@
   "  forever drop\n"
   "] 'loop func :loop.to\n"
+  "[ser words block! body block!]\n"
+  "[\n"
+  "    ser [words set body do] words length? iter\n"
+  "]\n"
+  "'loop func :each.set    ;(ser words body -- )\n"
   "[ser accu op] [\n"
   "  ser [first accu op do :accu] iter\n"

trunk/thune/doc/UserManual

@@ -365 +365 @@
 iter      (ser body -- )             Iterate over series.
 iter/N    (ser body -- )             Iterate over series with skip.
+each      (ser body -- )             Iterate over series elements.
+each/N    (ser body -- )             Iterate over series elements with skip.
 proc      (body -- proc)             Create procedure.
 func      (sig body -- func)         Create function with local values.
@@ -388 +390 @@
 Word      Stack Usage                Function
 ========  =========================  ============================
-each      (ser body -- )             Iterate over series and take first element.
 each.set  (ser words body -- )       Iterate over series and assign elements.
 while     (body cond -- )            Evaluate body while cond is true.

trunk/thune/mkboot.t

@@ -86 +86 @@
 ] 'loop func :loop.to
 
+[ser words block! body block!]
+[
+    ser [words set body do] words length? iter
+]
+'loop func :each.set    ;(ser words body -- )
+
 [ser accu op] [
   ser [first accu op do :accu] iter

trunk/thune/tests/working/compare.t

@@ -21 +21 @@
     first :cmp
 
-    ;data [a b] [
-    ;    [a b dup2 cmp do] print
-    ;] each.set
-
-    data [
-        [a b] set
+    data [a b] [
         [a b dup2 cmp do] print
-    ] iter/2
+    ] each.set
 ] proc :test
 
@@ -41 +36 @@
 
 "--- if ---" print
-data
-   ;[a b]
+data [a b]
 [
-    [a b] set
     [a b ' '
         a b if/eq '=
@@ -54 +47 @@
     ] print
 ]
-;each.set
-iter/2
+each.set

trunk/thune/tests/working/control.good

@@ -45 +45 @@
 each "two"
 each "tree"
+--- each.set 0 ---
+--- each.set 1 ---
+1
+2
+a
+b
+one
+two
+tree
+--- each.set 2 ---
+1 2
+a b
+one two
+tree none
+--- each.set 3 ---
+1 2 a
+b one two
+tree none none
+--- each.set 8 ---
+1 2 a b one two tree none
 --- either ---
 'T'

trunk/thune/tests/working/control.t

@@ -27 +27 @@
 
 
-/*
 "--- each.set 0 ---" print
 data tail [a] [[a] print] each.set
@@ -42 +41 @@
 "--- each.set 8 ---" print
 data [a b c d e f g h] [[a b c d e f g h] print] each.set
-*/
 
 

trunk/thune/tests/working/iter.good

@@ -19 +19 @@
 [x]
 --- Reverse empty ---
+--- Skip on stack ---
+"A-message"

trunk/thune/tests/working/iter.t

@@ -25 +25 @@
 [] [.] iter/-1
 
+"--- Skip on stack ---" print
+{} {A - m e s s a g e} [append] 2 each head .

trunk/thune/tests/working/parse2.good

@@ -16 +16 @@
 
 
-[words string!  file string!  rev logic!  | rules a b ab --]
+[words string!  file string!  rev logic!  | rules a b --]
 [
     [] copy :rules
     words parse.white
 
-    [[b a] [a b]] rev pick :ab
+    [[b a] [a b]] rev pick
     [
-        ab set
         rules [a (b prin) |] copy 'a infuse append.cat tail prev mark.eol drop
     ]
-    iter/2
+    each.set
 
     file read

trunk/thune/tests/working/parse2.t

@@ -16 +16 @@
 
 
-[words string!  file string!  rev logic!  | rules a b ab --]
+[words string!  file string!  rev logic!  | rules a b --]
 [
     [] copy :rules
     words parse.white
 
-    [[b a] [a b]] rev pick :ab
+    [[b a] [a b]] rev pick
     [
-        ab set
         rules [a (b prin) |] copy 'a infuse append.cat tail prev mark.eol drop
     ]
-    iter/2
+    each.set
 
     file read

trunk/thune/thune.c

@@ -601 +601 @@
                     break;
 
-                case OP_ITER:           // (series blk -- )
+                case OP_ITER:           // (series blk [skip] -- )
                 case OP_EACH:
-                    if( ur_is(UR_TOS, UT_BLOCK) &&
-                        (ur_itLen( ut, ur_s_prev(UR_TOS) ) > 0) )
-                    {
-                        int itype = (ur_opcode(val) == OP_ITER) ?
+                {
+                    int itype;
+                    int skip;
+
+                    if( ur_is(UR_TOS, UT_INT) )
+                    {
+                        skip = ur_int(UR_TOS);
+                        UR_S_DROP;
+                    }
+                    else
+                    {
+                        skip = ur_sel(val);
+                    }
+
+                    if( ! ur_is(UR_TOS, UT_BLOCK) )
+                    {
+                        ur_throwErr( UR_ERR_DATATYPE,
+                             "iter/each expected block! for body" );
+                        goto throw_cc;
+                    }
+
+                    if( ur_itLen( ut, ur_s_prev(UR_TOS) ) > 0 )
+                    {
+                        itype = (ur_opcode(val) == OP_ITER) ?
                                     CC_ITER : CC_EACH;
-                        int skip = ur_sel(val);
-                        if( skip == 0 )
-                            skip = 1;
 
                         PUSHC_EVAL( blkN, start, pc );
@@ -620 +637 @@
                         //ur_copyCell( ut->toc, UR_TOS );
                         UR_TOC->iter.code = itype;
-                        UR_TOC->iter.skip = skip;
+                        UR_TOC->iter.skip = skip ? skip : 1;
                         ut->toc->series.n   = UR_TOS->series.n;
                         ut->toc->series.it  = UR_TOS->series.it;
@@ -634 +651 @@
                         UR_S_DROPN(2);
                     }
+                }
                     break;