Changeset 12176 for src/Pugs/Prim/Match.hs

Timestamp:

08/12/06 19:55:50 (2 years ago)

Author:

audreyt

Message:

* First cut at proper compile-time role mixin support, based on

discussion on #perl6 about the semantics of "does".

class C {};
class D does C {};
D.isa(C); # False
D.does(C); # True

Composition works, and overriding role methods should work as well,
but concrete class/package names is not yet renamed, and role conflicts
is not yet validated. Still, a step toward the right direction.

Files:

• src/Pugs/Prim/Match.hs (modified) (2 diffs)

src/Pugs/Prim/Match.hs

@@ -2 +2 @@
 
 module Pugs.Prim.Match (
-    op2Match, rxSplit, rxSplit_n, matchFromMR, pkgParents
+    op2Match, rxSplit, rxSplit_n, matchFromMR, pkgParents, pkgParentClasses
 ) where
 import Pugs.Internals
@@ -279 +279 @@
     meta    <- readRef =<< fromVal ref
     fetch   <- doHash meta hash_fetchVal
-    attrs   <- fromVal =<< fetch "traits"
-    pkgs    <- mapM pkgParents attrs
+    attrs   <- fromVal =<< fetch "is"
+    attrs'  <- fromVal =<< fetch "does" -- XXX wrong
+    pkgs    <- mapM pkgParents (attrs ++ attrs')
     return $ nub (pkg:concat pkgs)
 
+-- XXX - copy and paste code; merge with above!
+pkgParentClasses :: VStr -> Eval [VStr]
+pkgParentClasses pkg = do
+    ref     <- readVar (':':'*':pkg)
+    if ref == undef then return [] else do
+    meta    <- readRef =<< fromVal ref
+    fetch   <- doHash meta hash_fetchVal
+    attrs   <- fromVal =<< fetch "is"
+    pkgs    <- mapM pkgParentClasses attrs
+    return $ nub (pkg:concat pkgs)