Changeset 2957

Timestamp:

05/11/05 02:32:56 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

4498

Message:

* $obj.clone() support.
* $obj ~~ Class support.

Files:

• src/Pugs/AST.hs (modified) (1 diff)
• src/Pugs/AST/Internals.hs (modified) (1 diff)
• src/Pugs/Prim.hs (modified) (2 diffs)
• src/Pugs/Prim/Match.hs (modified) (2 diffs)
• t/oo/class/basic.t (modified) (1 diff)

src/Pugs/AST.hs

@@ -50 +50 @@
     newScalar, newArray, newHandle, newObject,
     proxyScalar, constScalar, lazyScalar, lazyUndef, constArray,
-    retError, retControl, retEmpty, retIVar, writeIVar,
+    retError, retControl, retEmpty, retIVar, readIVar, writeIVar,
     fromVals, refType,
     mkPad, lookupPad, padToList, diffPads, unionPads,

src/Pugs/AST/Internals.hs

@@ -1153 +1153 @@
 
 data VObject = MkObject
-    { objType   :: VType
-    , objAttrs  :: IHash
+    { objType   :: !VType
+    , objAttrs  :: !IHash
     }
     deriving (Show, Eq, Ord, Typeable)

src/Pugs/Prim.hs

@@ -60 +60 @@
 op1 :: Ident -> Val -> Eval Val
 op1 "!"    = op1Cast (VBool . not)
+op1 "clone" = \x -> do
+    (VObject o) <- fromVal x
+    attrs   <- readIVar (IHash $ objAttrs o)
+    attrs'  <- liftSTM $ newTVar Map.empty
+    writeIVar (IHash attrs') attrs
+    return $ VObject o{ objAttrs = attrs' }
 op1 "chop" = \x -> do
     ref <- fromVal x
@@ -1187 +1193 @@
 \\n   Int       pre     kill    (Int, List)\
 \\n   Object    pre     new     (Type: Named)\
+\\n   Object    pre     clone   (Object)\
 \\n   List      pre     Pugs::Internals::runInteractiveCommand    (?Str=$_)\
 \\n   List      pre     Pugs::Internals::openFile    (?Str,?Str=$_)\

src/Pugs/Prim/Match.hs

@@ -9 +9 @@
 import Pugs.AST
 import Pugs.Types
+import Pugs.Context
 import Pugs.Config
 import qualified RRegex.PCRE as PCRE
@@ -67 +68 @@
     y' <- readRef y
     op2Match x y'
+
+op2Match x (VType t) = do
+    typ <- evalValType x
+    cls <- asks envClasses
+    return $ VBool (isaType cls (showType t) typ)
 
 op2Match x (VSubst (rx, subst)) | rxGlobal rx = do

t/oo/class/basic.t

@@ -14 +14 @@
 # L<S12/"Classes">
 
-eval 'class Foo {}';
+class Foo {};
 
-my $foo = eval 'Foo.new()';
-eval_ok('$foo ~~ Foo', '... smartmatch our $foo to the Foo class', :todo);
+my $foo = Foo.new();
+ok($foo ~~ Foo, '... smartmatch our $foo to the Foo class');
 
-my $foo_clone = eval '$foo.clone()';
-eval_ok('$foo_clone ~~ Foo', '... smartmatch our $foo_clone to the Foo class', :todo<feature>);
+my $foo_clone = $foo.clone();
+ok($foo_clone ~~ Foo, '... smartmatch our $foo_clone to the Foo class');
 
 # L<S12/"Classes" /An \"isa\" is just a trait that happens to be another class\:/>