Changeset 168 for trunk/thune/eval.c

Timestamp:

06/05/06 03:23:01 (3 years ago)

Author:

krobillard

Message:

Thune -

'set can now assign a block of words from a series.
Implemented 'foreach as a function.
Boot.c is now built from mkboot.t script.

Files:

• trunk/thune/eval.c (modified) (8 diffs)

trunk/thune/eval.c

@@ -89 +89 @@
 
 #define RESET_ITER(a,b) \
-    b = UR_TOC->cp.cell; \
-    a = UR_TOC[-1].cp.cell; \
-    UR_C_GROW
-
-
-#define PUSHC_FOREACH(si,a,b) \
-    UR_TOC->cp.cell = a; \
-    UR_C_GROW; \
-    UR_TOC->cp.code = CC_FOREACH; \
-    UR_TOC->cp.n    = si; \
-    UR_TOC->cp.cell = b; \
-    UR_C_GROW
-
-#define RESET_FOREACH(a,b) \
     b = UR_TOC->cp.cell; \
     a = UR_TOC[-1].cp.cell; \
@@ -506 +492 @@
 
             case CC_ITER:
-            case CC_FOREACH:
                  toc -= CC_LEN_ITER;
                  break;
@@ -665 +650 @@
                         }
                         break;
-
-                    case OP_FOREACH:        // (blk series ['words] -- )
-                        ++pc;
-                        val = UR_TOS;
-                        while( ur_is(val, UT_LITWORD) )
-                            ++val;
-                        PUSHC_EVAL( blkN, start, pc );
-                        SET_BLK_PC( val[1].series.n,
-                                    val[1].series.it );
-                        PUSHC_FOREACH( UR_BOS - val, pc, end );
-                        goto control;
 
                     case OP_RECURSE:
@@ -975 +949 @@
             goto control;
 
-        case CC_FOREACH:
-            val = UR_BOS - UR_TOC->cp.n;
-            if( ur_itLen(val) > 0 )
-            {
-                UR_TOS->series.it++;
-                RESET_FOREACH( pc, end );
-                UR_S_DUP;
-                goto execute;
-            }
-            UR_C_DEC;
-            UR_S_DROPN( UR_TOC->cp.n );     // Pop iterator values.
-            goto control;
-
         case CC_CATCH:
             UR_C_DECN( 2 );
@@ -1044 +1005 @@
 
             case CC_ITER:
-            case CC_FOREACH:
                 UR_C_DECN( CC_LEN_ITER );
                 break;
@@ -1312 +1272 @@
             break;
 
+        case UT_CHAR:
         case UT_INT:
-            if( ur_is(b, UT_INT) )
+            if( ur_is(b, UT_INT) || ur_is(b, UT_CHAR) )
             {
                 if( ur_int(a) == ur_int(b) )
@@ -1541 +1502 @@
 
 
-// (val word -- )
+/*
+  (val word -- )
+
+  If val is a series and word is a block then the words are set to the
+  first N elements of the series (where N is the number of words in word).
+*/
 UR_CALL( uc_set )
 {
+    UBlock* blk;
+    UCell* cell;
+    UCell* val;
+
+    val = ur_s_prev( tos );
+
     if( ur_isAWord(tos) )
     {
-        UBlock* blk;
-        UCell* cell;
-        UCell* val;
-
         if( ur_wordIsUnbound(tos) )
         {
@@ -1563 +1531 @@
         }
 
-        val = ur_s_prev( tos );
         ur_wordCell( tos, blk, cell );
         ur_copyCell( cell, *val );
+    }
+    else if( ur_is(tos, UT_BLOCK) )
+    {
+        UCell* it;
+        UCell* end;
+
+        blk = ur_block(tos);
+        UR_ITER_BLOCK( it, end, blk, tos );
+
+        if( ur_isASeries(val) )
+        {
+            int n = 0;
+            while( it != end )
+            {
+                if( ur_isAWord(it) )
+                {
+                    ur_wordCell( it, blk, cell );
+                    ur_pick( val, n++, cell );
+                }
+                ++it;
+            }
+        }
+        else
+        {
+            while( it != end )
+            {
+                if( ur_isAWord(it) )
+                {
+                    ur_wordCell( it, blk, cell );
+                    ur_copyCell( cell, *val );
+                }
+                ++it;
+            }
+        }
     }
     UR_S_DROPN(2);