Changeset 280 for trunk/thune/rune

Timestamp:

09/22/06 16:47:41 (2 years ago)

Author:

krobillard

Message:

Thune - Working on Rune eval. Rune eval.t is now a single 'rune block.

Location:

trunk/thune/rune

Files:

• rune.c (modified) (13 diffs)
• tests/eval.good (modified) (1 diff)
• tests/eval.t (modified) (1 diff)
• tests/mandel.ru (modified) (1 diff)

trunk/thune/rune/rune.c

@@ -92 +92 @@
 {
     ROP_NOP = 0,
+    ROP_DO,
+    ROP_DOES,
     ROP_REDUCE,
     ROP_ADD,
@@ -236 +238 @@
     }
 
-//fetch_pc_ok:
+fetch_pc_ok:
 
     if( ur_is(pc, UT_WORD) )
@@ -254 +256 @@
             PUSHC_CELL( val );
             goto fetch_pc;
+
+        //case UT_GETWORD:
+
+        case UT_LITWORD:
+            ur_copyCell(UR_TOS, *val);
+            val = UR_TOS;
+            ur_type(val) = UT_WORD;
+            break;
 
         case UT_OPCODE:
@@ -264 +274 @@
                     goto fetch_pc;
 
+                case ROP_DO:
+                case ROP_DOES:
+                case ROP_REDUCE:
+                    PUSHC_CELL( val );
+                    goto fetch_pc;
+
                 case ROP_ADD:
                 case ROP_SUB:
@@ -272 +288 @@
             goto invalid_opcode;
 
-        case UT_CALL:
-            if( ur_argc(val) == 0 )
-                goto call;
-            PUSHC_CELL( val );
-            goto fetch_pc;
+        case UT_PAREN:
+            goto do_block;
 
         case UT_FUNCTION:
@@ -284 +297 @@
             ur_funcFetch(OR_TOC) = ur_argc(val);
             goto fetch_pc;
+
+        case UT_CALL:
+            if( ur_argc(val) == 0 )
+                goto call;
+            PUSHC_CELL( val );
+            goto fetch_pc;
     }
 
@@ -300 +319 @@
             goto fetch_pc;
 
-        case UT_OPCODE:     // Assume Infix.
-            PUSH_VAL
-            val = INFIX_CALL( ur_opcode(OR_TOC) );
-            UR_C_DEC;
-            goto call;
+        case UT_OPCODE:
+            cval = OR_TOC;
+            switch( ur_opcode(cval) )
+            {
+                case ROP_DO:
+                    UR_C_DEC;
+                    if( ur_is(val, UT_BLOCK) || ur_is(val, UT_PAREN) )
+                        goto do_block;
+                    goto control;
+
+                case ROP_DOES:
+                {
+                    UIndex bodN;
+
+                    UR_C_DEC;
+
+                    if( ! ur_is(val, UT_BLOCK) )
+                        goto bad_opcode_type;
+                    bodN = val->series.n;
+
+                    val = UR_TOS;
+                    ur_initType( val, UT_FUNCTION );
+                    // localArgs & localVars cleared by ur_initType().
+                    val->func.bodyN    = bodN;
+                    val->func.closureN = 0;
+                    val->func.sigN     = 0;
+                }
+                    goto control;
+
+                default:
+                    // Infix operator.
+                    PUSH_VAL
+                    val = INFIX_CALL( ur_opcode(cval) );
+                    UR_C_DEC;
+                    goto call;
+            }
+            goto bad_control;
 
         case UT_SETWORD:
@@ -345 +396 @@
                 val = OR_TOC;
                 UR_C_DEC;
-
-                blk = ur_blockPtr( val->func.sigN );
-                if( ! _verifyArgs( ur_thread, blk->ptr.cells + 1,
-                                   ur_argc(val) ) )
-                    goto op_throw;
                 goto call_func;
             }
@@ -368 +414 @@
     PUSHC_HOLD( val->series.n );
     SET_BLK_PC( val->series.n, val->series.it );
-    goto fetch_pc;
+    if( pc >= end )
+    {
+        UR_C_DEC;
+        val = UR_TOS;
+        ur_initType( val, UT_UNSET );
+        goto control_end;
+    }
+    goto fetch_pc_ok;
 
 call:
@@ -407 +460 @@
     {
         int argc = ur_argc(val);
-        //int locc = totc - argc;
+        int locc = totc - argc;
 
         UR_LF_PUSH( -val->func.sigN, UR_TOS - (argc - 1) );
-/*
+
+        if( argc )
+        {
+            blk = ur_blockPtr( val->func.sigN );
+            if( ! _verifyArgs( ur_thread, blk->ptr.cells + totc, argc ) )
+                goto op_throw;
+        }
+
         if( locc )
         {
-            tos = UR_TOS;
-            while( n-- )
-            {
-                --tos;
-                ur_initType(tos, UT_NONE);
-            }
-            UR_TOS = tos;
+            UCell* vit  = ur_s_next(UR_TOS);
+            UCell* vend = vit + locc;
+            do
+            {
+                ur_initType(vit, UT_NONE);
+                ++vit;
+            }
+            while( vit != vend );
+            UR_TOS = vit;
         }
         else
-*/
         {
             UR_S_GROW;
@@ -471 +532 @@
     ur_throwErr( UR_ERR_SCRIPT, "infix opcode missing first value" );
     goto trace_error;
+
+bad_opcode_type:
+
+    ur_throwErr( UR_ERR_DATATYPE, "invalid type %s for '%s opcode",
+                 ur_typeName( ur_type(val) ),
+                 ur_atomCStr( ur_atom(cval), 0) );
+    goto trace_error;
+    //goto throw_cc;
 
 invalid_opcode:
@@ -638 +707 @@
 
 
+
 char rune_boot[] =
   "[\n"
   "  0 'nop\n"
-  "  1 reduce\n"
-  "  2 +\n"
-  "  3 -\n"
-  "  4 *\n"
-  "  5 /\n"
+  "  1 r.do\n"
+  "  2 does\n"
+  "  3 reduce\n"
+  "  4 +\n"
+  "  5 -\n"
+  "  6 *\n"
+  "  7 /\n"
   "] make-opcodes :rune-ops\n"
   "[block! verify/1 rune-ops infuse code! swap 'rune make] proc :runec\n"
@@ -655 +727 @@
   "  div    [a int!/decimal! b int!/decimal!]\n"
   "  console.out [val]\n"
-  "  func   [sig block! body block!]\n"
-  "  type?  [val]\n"
+  "  func    [sig block! body block!]\n"
+  "  type?   [val]\n"
+  "  to-text [val]\n"
   "  reduce [val]\n"
+  "  .      [val]\n"
   "] define-natives\n"
+  "console.out: :cout\n"
   "\n"
   ;
 
+  //"time-blk: func [blk | s] [s: now  do blk  now - s]\n"
 
 static UCallDef rune_calls[] =

trunk/thune/rune/tests/eval.good

@@ -16 +16 @@
 9
 9
+--- Paren ---
+18
 --- Print ---
 hi

trunk/thune/rune/tests/eval.t

@@ -1 +1 @@
 [
-    swap print
-    rune .
-] proc :test    ; (name blk -- )
+
+r.prin:  func [val] [console.out to-text val]
+r.print: func [val] [console.out to-text val console.out eol]
+time-blk: func [blk | s] [s: now  r.do blk  now - s]
+
+tst: func [msg blk] [
+    r.print msg
+    . r.do blk
+]
 
 
+;tst "--- Reduce 1 ---" [reduce [1 + 2 * 3]]
 
-/*
-"--- Reduce 1 ---"
-[reduce [1 + 2 * 3]] test
-*/
+tst "--- Empty ---" []
 
-;'orig
-"--- Empty ---"
-[] test
+tst "--- Inert ---" [1 2 3]
 
-"--- Inert ---"
-[1 2 3] test
+tst "--- Call 1 ---" [sub add 4 5 x: 1]
+r.print x
 
-"--- Call 1 ---"
-[sub add 4 5 x: 1] test
-x .
+tst "--- Infix 1 ---" [sub add 4 5 x: 1 + 2]
+r.print x
 
-"--- Infix 1 ---"
-[sub add 4 5 x: 1 + 2] test
-x .
+tst "--- Infix 2 ---" [1 + sub add 4 5 x: 1 + 2]
+r.print x
 
-"--- Infix 2 ---"
-[1 + sub add 4 5 x: 1 + 2] test
-x .
+tst "--- Infix 3 ---"
+    [add 1 2 * 3]       ;= 7
+. 1 + 2 * 3             ;= 9
+. mul add 1 2 3         ;= 9
+;. + 1 * 2 3             ;= 5 (Rune expects first value)
+;. 1 + * 2 3             ;= 7 (Rune expects first value)
 
-"--- Infix 3 ---"
-[add 1 2 * 3] test      ;= 7
-[1 + 2 * 3] rune .        ;= 9
-[mul add 1 2 3] rune .    ;= 9
-;[+ 1 * 2 3] test        ;= 5 (Rune expects first value)
-;[1 + * 2 3] test        ;= 7 (Rune expects first value)
+tst "--- Paren ---" [8 + (5 * 2)]
 
-"--- Print ---"
-[console.out "hi^/"] test
+tst "--- Print ---"
+    [console.out "hi^/"]
 
-"--- Func 1 ---"
-[p2: func [x] [x * x]  nop p2 4] test
+tst "--- Func 1 ---"
+    [p2: func [x] [x * x]  nop p2 4]
 
-"--- Func 2 ---"
-[p2: func [] [] p2] test
+tst "--- Func 2 ---"
+    [p2: func [] [] p2]
 
+] rune

trunk/thune/rune/tests/mandel.ru

@@ -1 +1 @@
 ; Rune version of http://www.timestretch.com/FractalBenchmark.html
+
+/*
+  TODO
+   [ ] either
+   [ ] loop
+   [ ] loop.to
+   [ ] if
+   [ ] return
+*/
 
 BAILOUT: 16.0