Changeset 511

Timestamp:

02/12/08 17:04:10 (7 months ago)

Author:

krobillard

Message:

Call functions now have access to the invocation cell using UR_CALL_CELL.
Find, match, and parse are now case-insensitive by default and accept a /case
selector.

Files:

• trunk/thune/eval.c (modified) (3 diffs)
• trunk/thune/internal.h (modified) (1 diff)
• trunk/thune/math.c (modified) (1 diff)
• trunk/thune/parse.c (modified) (5 diffs)
• trunk/thune/project.r (modified) (1 diff)
• trunk/thune/series.c (modified) (12 diffs)
• trunk/thune/thread.c (modified) (1 diff)
• trunk/thune/thune.c (modified) (1 diff)
• trunk/thune/urlan.c (modified) (1 diff)
• trunk/thune/urlan.h (modified) (2 diffs)
• trunk/thune/urlan_atoms.h (modified) (1 diff)

trunk/thune/eval.c

@@ -118 +118 @@
-        switch( ur_type(val) )
-        {
+            case UT_CALL:
+                // TODO: Avoid copying call cell here. Maybe we should
+                //       move ur_wordCell() outside of ur_getSelector()?
+                ur_copyCell( res, *val );
+                return 1;
+
-            case UT_CONTEXT:
-            case UT_PORT:
@@ -138 +144 @@
-                unsigned int n;
-                n = ATOM_OFF( ur_sel(sel), UR_ATOM_R );
-se
+va
-                {
-
-
+
-                    return 1;
-                }
@@ -153 +158 @@
-                if( n < 3 )
-                {
-
-
+
-                    return 1;
-                }

trunk/thune/internal.h

@@ -33 +33 @@
-#define LOCK_ATOMS      LOCK_GLOBAL
-#define UNLOCK_ATOMS    UNLOCK_GLOBAL
+
+
+#define UR_IS_ANY2(cell, t1, t2) \
+        (ur_is(cell, t1) || ur_is(cell, t2))
+
+#define UR_IS_ANY3(cell, t1, t2, t3) \
+        ((1 << ur_type(cell)) & ((1<<t1) | (1<<t2) | (1<<t3)))
-
-

trunk/thune/math.c

@@ -385 +385 @@
-
-
-#define UR_IS_ANY3(cell, t1, t2, t3) \
-    ((1 << ur_type(cell)) & ((1<<t1) | (1<<t2) | (1<<t3)))
-
-
-static void logicError( UThread* ut, const char* name )
-{

trunk/thune/parse.c

@@ -35 +35 @@
-
-extern int ur_matchString( const UString* strA, int iA,
-
+, int matchCase
-extern int ur_findString( const UString* strA, int iA,
-
+, int matchCase
-
-
@@ -229 +229 @@
-                            UString* pat = ur_bin(tval);
-                            pos = ur_findString( istr, pos,
-
+
+
-                            if( pos < 0 )
-                                goto failed;
@@ -400 +401 @@
-                UString* pat = ur_bin( tval );
-
-
-
-
-
-
-
-
+
+
-                if( pos )
-                    ++rit;
@@ -485 +481 @@
-                while( count < repMax )
-                {
-
+
+
-                    if( ! p2 )
-                        break;
@@ -1059 +1056 @@
-    ser   = ur_s_prev(tos);
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-        {
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-            UR_S_DROP;
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-            return;
-        }
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-        {
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-        }
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-}
-

trunk/thune/project.r

@@ -14 +14 @@
-default [
-    warn
-;
- 
+ 
+;
-
-    cflags {-DLANG_THUNE}

trunk/thune/series.c

@@ -20 +20 @@
-
-#include "internal.h"
+#include "urlan_atoms.h"
-#include "charset.h"
-#include "list.h"
@@ -2695 +2696 @@
-
-
+inline int ur_toLower( int c )
+{
+    if( (c >= 'A') && (c <= 'Z') )
+        c += 'a' - 'A';
+    return c;
+}
+
+
-/**
-  Returns index in strA where match is complete or zero if strings do not
-  match.
-*/
-
+
+
-{
-    const char* sit  = strA->ptr.c + iA;
@@ -2709 +2719 @@
-    assert( iB <= strB->used );
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-    }
-    return sit - strA->ptr.c;
@@ -2726 +2751 @@
-*/
-int ur_findString( const UString* strA, int iA,
-
+, int matchCase
-{
-    const char* it   = strA->ptr.c + iA;
@@ -2736 +2761 @@
-    assert( iB <= strB->used );
-
+    if( matchCase )
+    {
+        while( it != end )
+        {
+            if( *it == *pat )
+            {
+                const char* sit = it;
+                const char* pit = pat;
+                while( pit != pend )
+                {
+                    if( *sit != *pit )
+                        break;
+                    ++sit;
+                    ++pit;
+                }
+                if( pit == pend )
+                {
+                    return it - strA->ptr.c;
+                }
+            }
+            ++it;
+        }
+    }
+    else
+    {
+        while( it != end )
+        {
+            if( *it == *pat )
+            {
+                const char* sit = it;
+                const char* pit = pat;
+                while( pit != pend )
+                {
+                    if( ur_toLower(*sit) != ur_toLower(*pit) )
+                        break;
+                    ++sit;
+                    ++pit;
+                }
+                if( pit == pend )
+                {
+                    return it - strA->ptr.c;
+                }
+            }
+            ++it;
+        }
+    }
+
+    return -1;
+}
+
+
+/**
+  Returns index in strA where strB is found or -1 if strB is not found.
+*/
+int ur_findStringRev( const UString* strA, int iA,
+                      const UString* strB, int iB )
+{
+    const char* end  = strA->ptr.c + iA;
+    const char* it   = strA->ptr.c + strA->used;
+    const char* pat  = strB->ptr.c + iB;
+    const char* pend = strB->ptr.c + strB->used;
+
+    assert( iA <= strA->used );
+    assert( iB <= strB->used );
+
-    while( it != end )
-    {
+        --it;
-        if( *it == *pat )
-        {
@@ -2754 +2845 @@
-            }
-        }
-        ++it;
-    }
-    return -1;
-}
-
-
-/**
-  Returns index in strA where strB is found or -1 if strB is not found.
-*/
-int ur_findStringRev( const UString* strA, int iA,
-                      const UString* strB, int iB )
-{
-    const char* end  = strA->ptr.c + iA;
-    const char* it   = strA->ptr.c + strA->used;
-    const char* pat  = strB->ptr.c + iB;
-    const char* pend = strB->ptr.c + strB->used;
-
-    assert( iA <= strA->used );
-    assert( iB <= strB->used );
-
-    while( it != end )
-    {
-        --it;
-        if( *it == *pat )
-        {
-            const char* sit = it;
-            const char* pit = pat;
-            while( pit != pend )
-            {
-                if( *sit != *pit )
-                    break;
-                ++sit;
-                ++pit;
-            }
-            if( pit == pend )
-            {
-                return it - strA->ptr.c;
-            }
-        }
-    }
-    return -1;
@@ -2861 +2913 @@
-            else if( ur_is(tos, UT_STRING) || ur_is(tos, UT_BINARY) )
-            {
+                UCell* inv;
-                UString* s2 = ur_bin(tos);
-                if( s2->used )
-                {
+                    inv = UR_CALL_CELL;
-                    found = ur_findString( s1, res->series.it,
-
+
+
-                    if( found > -1 )
-                    {
@@ -3006 +3061 @@
-
-
-*
+
-  Returns sit where match is complete or zero if string starting with sit
-  does not match all of pattern pit to pend.
-*/
-1
- 
+
+
-{
-    while( pit != pend )
@@ -3026 +3081 @@
-
-
+static const char* ur_matchI( const char* sit, const char* send,
+                              const char* pit, const char* pend )
+{
+    while( pit != pend )
+    {
+        if( sit == send )
+            return 0;
+        if( ur_toLower(*sit) != ur_toLower(*pit) )
+            return 0;
+        ++sit;
+        ++pit;
+    }
+    return sit;
+}
+
+
-/*
-  (series value -- series)
@@ -3032 +3103 @@
-{
-    UCell* res;
-
+
-    UR_S_DROP;
-    res = ur_s_prev(tos);
@@ -3041 +3112 @@
-        case UT_STRING:
-        {
+            UCell* inv = UR_CALL_CELL;
+
-            if( ur_is(tos, UT_CHAR) )
-            {
@@ -3067 +3140 @@
-                ur_binaryMem( ut, tos, &pA, &pB );
-
-
+
+
+
+
-                if( eom )
-                {

trunk/thune/thread.c

@@ -48 +48 @@
-        ut->env = env;
-        ut->flags = 0;
+        ut->invocation = 0;
-
-        ur_threadInitStore( ut, binCount, blkCount );

trunk/thune/thune.c

@@ -988 +988 @@
-
-        case UT_CALL:
+            ut->invocation = pc - 1;
-            val->call.addr( ut, UR_TOS );
-#if defined(UR_CONFIG_EMH) || defined(UR_CONFIG_DT_CODE)

trunk/thune/urlan.c

@@ -306 +306 @@
-    FIXED_ATOM( "*",      1, UR_ATOM_ASTERISK )
-    
+    FIXED_ATOM( "case",   4, UR_ATOM_CASE )
-    FIXED_ATOM( "reader-macros", 13, UR_ATOM_READER_MACROS )
-

trunk/thune/urlan.h

@@ -449 +449 @@
-    short     _pad;
-    LocalFrame* localFT;
+    UCell*  invocation;
-
-    UCell*  tos;
@@ -748 +749 @@
-#define UR_CALL_UNUSED_TOS  (void) tos;
-#define UR_EXTERN_CALL(func)    extern void func(UThread*, UCell*)
+#define UR_CALL_CELL        ut->invocation
-#define ur_intern(s,l)      ur_internT(ut,s,l)
-

trunk/thune/urlan_atoms.h

@@ -47 +47 @@
-#define UR_ATOM_PLUS            110
-#define UR_ATOM_ASTERISK                111
-
+
+