Changeset 281 for trunk/thune/rune

Timestamp:

09/23/06 18:16:16 (2 years ago)

Author:

krobillard

Message:

Thune - Tokenize now counts eol in line comments.
Rune - Func/call no longer eats stack. Added if, if.else.

Location:

trunk/thune/rune

Files:

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

trunk/thune/rune/rune.c

@@ -31 +31 @@
 
 
+#define CELL_TRUE(val) \
+    ((ur_type(val) != UT_NONE) && \
+    ((ur_type(val) != UT_LOGIC) || (ur_logic(val) != 0)))
+
+#define CELL_FALSE(val) \
+    (ur_is(val, UT_NONE) || (ur_is(val, UT_LOGIC) && (ur_logic(val) == 0)))
+
+
 #define OR_TOC      ur_thread->toc
 #define OR_BOC      ur_thread->cstack
 
 #define ur_funcFetch(cell)  cell->func.closureN
+#define ur_opFetch(cell)    cell->word.sel
 #define ur_argc(cell)       cell->func.localArgs
 #define ur_varc(cell)       cell->func.localVars
@@ -95 +104 @@
     ROP_DOES,
     ROP_REDUCE,
+    ROP_IF,
+    ROP_IF_ELSE,
     ROP_ADD,
     ROP_SUB,
@@ -158 +169 @@
 
 
-#define PUSH_VAL    if(val != UR_TOS) { UR_S_PUSH( *val ); }
+#define PUSH_VAL \
+    UR_S_GROW; \
+    if(val != UR_TOS) \
+        *UR_TOS = *val;
+
+//#define PUSH_VAL    if(val != UR_TOS) { UR_S_PUSH( *val ); }
+//#define PLACE_VAL   if(val != UR_TOS) { ur_copyCell(UR_TOS, *val); }
 
 // Look ahead for infix operator.
@@ -221 +238 @@
             }
                 UR_C_DEC;
-                goto control_end;
+                goto control;
 #endif
 
@@ -227 +244 @@
                 if( ur_evalLocal(OR_TOC) )
                 {
-                    val = UR_TOS;
-                    UR_TOS = UR_LF_BEG->localFrame.cell;
+                    // Return from function.
+                    cval = UR_LF_BEG->localFrame.cell;
                     UR_LF_POP;
-                    ur_copyCell(UR_TOS, *val);
+                    ur_copyCell(cval, *val);
+                    val = cval;
+                    UR_TOS = ur_s_prev(cval);
                 }
                 UR_C_DEC;
-                goto control_end;
+                goto control;
         }
         goto unexpected_end;
@@ -257 +276 @@
             goto fetch_pc;
 
-        //case UT_GETWORD:
+        case UT_GETWORD:
+            val = ur_wordCell( ur_thread, val );
+            break;
 
         case UT_LITWORD:
-            ur_copyCell(UR_TOS, *val);
-            val = UR_TOS;
-            ur_type(val) = UT_WORD;
+            cval = ur_s_next(UR_TOS);
+            ur_copyCell(cval, *val);
+            ur_type(cval) = UT_WORD;
+            val = cval;
             break;
 
@@ -278 +300 @@
                 case ROP_REDUCE:
                     PUSHC_CELL( val );
+                    goto fetch_pc;
+
+                case ROP_IF:
+                    PUSHC_CELL( val );
+                    ur_opFetch( OR_TOC ) = 2;
+                    goto fetch_pc;
+
+                case ROP_IF_ELSE:
+                    PUSHC_CELL( val );
+                    ur_opFetch( OR_TOC ) = 3;
                     goto fetch_pc;
 
@@ -300 +332 @@
         case UT_CALL:
             if( ur_argc(val) == 0 )
-                goto call;
+            {
+                //UR_S_GROW;    // Calls without arguments must ( -- val).
+                goto do_call;
+            }
             PUSHC_CELL( val );
             goto fetch_pc;
@@ -306 +341 @@
 
 control:
-control_end:
 
     // Here val points to current value (most often contents at pc).
@@ -348 +382 @@
                     goto control;
 
+                case ROP_IF:
+                    LOOK_AHEAD_FOR_INFIX
+                    si = ur_opFetch(cval) - 1;
+                    if( si == 0 )
+                    {
+                        UR_C_DEC;
+
+                        cval = UR_TOS;
+                        UR_S_DROP;
+                        if( CELL_FALSE( cval ) )
+                            goto control;
+                        if( ur_is(val, UT_BLOCK) || ur_is(val, UT_PAREN) )
+                            goto do_block;
+                        ur_copyCell( cval, *val );
+                        val = cval;
+                        goto control;
+                    }
+                    ur_opFetch(cval) = si;
+                    PUSH_VAL
+                    goto fetch_pc;
+
+                case ROP_IF_ELSE:
+                    LOOK_AHEAD_FOR_INFIX
+                    si = ur_opFetch(cval) - 1;
+                    if( si == 0 )
+                    {
+                        UR_C_DEC;
+
+                        cval = ur_s_prev(UR_TOS);
+                        if( CELL_TRUE( cval ) )
+                            val = UR_TOS;
+                        UR_S_DROPN( 2 );
+                        if( ur_is(val, UT_BLOCK) || ur_is(val, UT_PAREN) )
+                            goto do_block;
+                        ur_copyCell( cval, *val );
+                        val = cval;
+                        goto control;
+                    }
+                    ur_opFetch(cval) = si;
+                    PUSH_VAL
+                    goto fetch_pc;
+
                 default:
                     // Infix operator.
@@ -353 +429 @@
                     val = INFIX_CALL( ur_opcode(cval) );
                     UR_C_DEC;
-                    goto call;
+                    goto do_call;
             }
             goto bad_control;
@@ -366 +442 @@
             ur_copyCell( cval, *val /*UR_TOS*/ );
             UR_C_DEC;
-            goto control_end;
+            goto control;
 
         case UT_BLOCK:
@@ -373 +449 @@
 
         case UT_PAREN:
+            // paren! type denotes block evaluation should resume.
             SET_BLK_PC( OR_TOC->series.n, OR_TOC->series.it );
             UR_C_DEC;
-            goto control_end;
-
-        case UT_CALL:
-            LOOK_AHEAD_FOR_INFIX
-            PUSH_VAL
-            //printf( "KR f %d\n", OR_TOC->call.fetch );
-            if( --OR_TOC->call.fetch == 0 )
-            {
-                val = OR_TOC;
-                UR_C_DEC;
-                goto call;
-            }
-            goto fetch_pc;
+            goto control;
 
         case UT_FUNCTION:
             LOOK_AHEAD_FOR_INFIX
             PUSH_VAL
-            if( --ur_funcFetch(OR_TOC) == 0 )
+            si = ur_funcFetch(OR_TOC) - 1;
+            if( si == 0 )
             {
                 val = OR_TOC;
@@ -398 +464 @@
                 goto call_func;
             }
+            ur_funcFetch(OR_TOC) = si;
+            goto fetch_pc;
+
+        case UT_CALL:
+            LOOK_AHEAD_FOR_INFIX
+            //printf( "KR f %d\n", OR_TOC->call.fetch );
+            PUSH_VAL
+            si = OR_TOC->call.fetch - 1;
+            if( si == 0 )
+            {
+                val = OR_TOC;
+                UR_C_DEC;
+                goto do_call;
+            }
+            OR_TOC->call.fetch = si;
             goto fetch_pc;
     }
@@ -416 +497 @@
     if( pc >= end )
     {
-        UR_C_DEC;
+        UR_C_DEC;   // TODO: Don't put on stack if empty.
         val = UR_TOS;
         ur_initType( val, UT_UNSET );
-        goto control_end;
+        goto control;
     }
     goto fetch_pc_ok;
 
-call:
+do_call:
+
+    //printf( "KR call %ld\n", UR_TOS - ur_thread->dstack );
 
     val->call.addr( ur_thread, UR_TOS );
+    val = UR_TOS;
+    UR_S_DROP;
 
     switch( UR_CALL_OP )
@@ -449 +534 @@
             goto fetch_pc;
     }
-    val = UR_TOS;
     goto control;
 
@@ -496 +580 @@
     SET_BLK_PC( bodyN, 0 );
     }
-
+    if( pc >= end )
+    {
+        UR_C_DEC;   // TODO: Don't put on stack if empty.
+        val = ur_s_next(UR_TOS);
+        ur_initType( val, UT_UNSET );
+        goto control;
+    }
+    ur_initType(UR_TOS, UT_UNSET);
+    goto fetch_pc_ok;
+
+    /*
     ur_initType(UR_TOS, UT_UNSET);
     val = UR_TOS;
     goto fetch_pc;
+    */
 
 op_throw:
@@ -573 +668 @@
 
 
+/**
+   (val -- val)
+
+   Print value to stdout (without linefeed).
+*/
+UR_CALL( rc_cout )
+{
+    char* it;
+    char* end;
+
+    UR_CALL_UNUSED_TH
+
+    if( ur_is(tos, UT_CHAR) )
+    {
+        putchar( ur_char(tos) );
+    }
+    else if( ur_stringSlice(tos, &it, &end) && it )
+    {
+        if( ur_encoding(tos) == UR_ENC_UTF16 )
+        {
+            uint16_t* uit  = (uint16_t*) it;
+            uint16_t* uend = (uint16_t*) end;
+
+            while( uit != uend )
+                putchar( *uit++ );
+        }
+        else
+        {
+            fwrite( it, 1, end - it, stdout );
+        }
+    }
+}
+
+
+// (val -- val)
+UR_CALL( rc_probe )
+{
+    UString* str;
+    str = ur_binPtr( ur_thread->callTempBinN );
+    str->used = 0;
+    ur_toStr( tos, str, 0 );
+    ur_arrayReserve( str, sizeof(char), str->used + 1 );
+    str->ptr.c[ str->used++ ] = '\n';
+    
+    UR_S_GROW;
+    tos = UR_TOS;
+    ur_initType( tos, UT_STRING );
+    ur_setSeries( tos, ur_thread->callTempBinN, 0 );
+    rc_cout( ur_thread, tos );
+    UR_S_DROP;
+}
+
+
 extern UIndex _funcSignature( const UCell* scell, int* pArgc, int* pVarc );
-
 
 // (block -- )
@@ -714 +861 @@
   "  2 does\n"
   "  3 reduce\n"
-  "  4 +\n"
-  "  5 -\n"
-  "  6 *\n"
-  "  7 /\n"
+  "  4 r.if\n"
+  "  5 r.if.else\n"
+  "  6 +\n"
+  "  7 -\n"
+  "  8 *\n"
+  "  9 /\n"
   "] make-opcodes :rune-ops\n"
   "[block! verify/1 rune-ops infuse code! swap 'rune make] proc :runec\n"
@@ -726 +875 @@
   "  mul    [a int!/decimal! b int!/decimal!]\n"
   "  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"
+  "  cout   [val]\n"
+  "  probe  [val]\n"
+  "  type?  [val]\n"
   "  to-text [val]\n"
-  "  reduce [val]\n"
-  "  .      [val]\n"
+  "  reduce  [val]\n"
   "] define-natives\n"
-  "console.out: :cout\n"
   "\n"
   ;
@@ -741 +889 @@
 static UCallDef rune_calls[] =
 {
+    { rc_cout,         "cout" },
+    { rc_probe,        "probe" },
     { rc_defNatives,   "define-natives" },
 };

trunk/thune/rune/tests/eval.good

@@ -20 +20 @@
 --- Print ---
 hi
-unset
+"hi^/"
+--- Does 1 ---
+inside-does
 --- Func 1 ---
 16
 --- Func 2 ---
 unset
+--- Func Local ---
+none
+none
+--- If ---
+<if true>
+<if 1>
+--- If Else ---
+no
+no
+yes
+yes
+--- Now ---
+Timing print string.
+time!

trunk/thune/rune/tests/eval.t

@@ -1 +1 @@
 [
 
-r.prin:  func [val] [console.out to-text val]
-r.print: func [val] [console.out to-text val console.out eol]
+r.prin:  func [val] [cout to-text val]
+r.print: func [val] [cout to-text val cout eol]
 time-blk: func [blk | s] [s: now  r.do blk  now - s]
 
 tst: func [msg blk] [
     r.print msg
-    . r.do blk
+    probe r.do blk
 ]
 
@@ -28 +28 @@
 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)
+probe 1 + 2 * 3             ;= 9
+probe mul add 1 2 3         ;= 9
+;probe + 1 * 2 3             ;= 5 (Rune expects first value)
+;probe 1 + * 2 3             ;= 7 (Rune expects first value)
 
 tst "--- Paren ---" [8 + (5 * 2)]
 
 tst "--- Print ---"
-    [console.out "hi^/"]
+    [cout "hi^/"]           ; Rune returns value passed to cout.
+
+tst "--- Does 1 ---"
+    [x: does ['inside-does] x]
 
 tst "--- Func 1 ---"
-    [p2: func [x] [x * x]  nop p2 4]
+    [p2: func [x] [x * x]  p2 4]
 
 tst "--- Func 2 ---"
     [p2: func [] [] p2]
 
+tst "--- Func Local ---"
+    [p2: func [| a] [probe a] p2]
+
+r.print "--- If ---"
+r.if none  [r.print "<if none>"]
+r.if false [r.print "<if false>"]
+r.if true  [r.print "<if true>"]
+r.if 1     [r.print "<if 1>"]
+
+r.print "--- If Else ---"
+probe r.if.else none  ['yes]['no]
+probe r.if.else false  'yes  'no 
+probe r.if.else true  ['yes]['no]
+probe r.if.else 1      'yes  'no
+
+tst "--- Now ---"
+    [type? time-blk [r.print "Timing print string."]]
+
 ] rune

trunk/thune/rune/tests/mandel.ru

@@ -3 +3 @@
 /*
   TODO
-   [ ] either
    [ ] loop
    [ ] loop.to
    [ ] if
+   [ ] if.else
    [ ] return
 */
@@ -43 +43 @@
                 loop.to 'x -39 39
         [
-            prin either mandelbrot x / 40.0 y / 40.0
+            prin if.else mandelbrot x / 40.0 y / 40.0
                                 ['*'][' ']
         ]