Changeset 12200 for src/Pugs/Eval

Timestamp:

08/14/06 06:48:18 (2 years ago)

Author:

audreyt

Message:

* Oldland method calls with newVal as invocant is now hooked into a

newland call with new toys such Captures, Feeds, etc. Yay!

pugs> vv('moose').elk(1, 2, antler => 3);
CCall "elk" CaptMeth?

{ c_invocant = VPure (MkStr? "moose")
, c_feeds = [ MkFeed?

{ a_positional = [VPure (IFinite 1),VPure (IFinite 2)]
, a_named = fromList [("antler",[VPure (IFinite 3)])]
} ]

}

Files:

• src/Pugs/Eval/Var.hs (modified) (8 diffs)

src/Pugs/Eval/Var.hs

@@ -18 +18 @@
 import Pugs.Config
 import Pugs.Monads
+import qualified Pugs.Val as Val
+import Pugs.Val hiding (Val, IValue, VUndef)
 
 findVar :: Var -> Eval (Maybe VRef)
@@ -139 +141 @@
     = NoMatchingMulti
     | NoSuchSub
-    | NoSuchMethod String
+    | NoSuchMethod !Type
 
 findSub :: String     -- ^ Name, with leading @\&@.
@@ -146 +148 @@
         -> Eval (Either FindSubFailure VCode)
 findSub name' invs args = do
-    let name = possiblyFixOperatorName name'
     case invs of
         Just _ | Just (package, name') <- breakOnGlue "::" name
@@ -152 +153 @@
             typ <- asks envPackage
             findSuperSub (mkType typ) (sig ++ name')
-        Just exp | not (':' `elem` drop 2 name) -> do
-            typ     <- evalInvType $ unwrap exp
-            if typ == mkType "Scalar::Perl5"
-                then do
-                    fmap (err $ NoSuchMethod $ show typ) (runPerl5Sub name)
-                else do
-                    findTypedSub typ name
+        Just exp | not (':' `elem` drop 2 name) -> case unwrap exp of
+            Val inv@VV{}     -> withExternalCall callMethodVV inv 
+            Val inv@PerlSV{} -> withExternalCall callMethodPerl5 inv 
+            exp' -> do
+                typ <- evalInvType exp'
+                findTypedSub typ name
         _ -> findBuiltinSub NoSuchSub name
+
     where
     err :: b -> Maybe a -> Either b a
     err _ (Just j) = Right j
     err x Nothing  = Left x
+
+    name = possiblyFixOperatorName name'
 
     findSuperSub :: Type -> String -> Eval (Either FindSubFailure VCode)
@@ -172 +175 @@
         subs'   <- either (flip findBuiltinSub name) (return . Right) subs
         case subs' of
-            Right sub | subName sub == qualified -> return (Left $ NoSuchMethod $ show typ)
+            Right sub | subName sub == qualified -> return (Left $ NoSuchMethod typ)
             _   -> return subs'
     findTypedSub :: Type -> String -> Eval (Either FindSubFailure VCode)
@@ -183 +186 @@
         maybe (fmap (err failure) $ possiblyBuildMetaopVCode name) (return . Right) sub
     evalInvType :: Exp -> Eval Type
-    evalInvType x@(Var (':':typ)) = do
-        typ' <- inferExpType x
-        return $ if typ' == mkType "Scalar::Perl5" then typ' else mkType typ
-    evalInvType (App (Var "&new") (Just inv) _) = do
-        evalInvType $ unwrap inv
-    evalInvType x@(App (Var _) (Just inv) _) = do
-        typ <- evalInvType $ unwrap inv
-        if typ == mkType "Scalar::Perl5" then return typ else inferExpType x
     evalInvType x = inferExpType $ unwrap x
-    runPerl5Sub :: String -> Eval (Maybe VCode)
-    runPerl5Sub name = do
-        metaSub <- possiblyBuildMetaopVCode name
-        if isJust metaSub then return metaSub else do
+
+    withExternalCall callMeth inv = do
+        fmap (err . NoSuchMethod $ valType inv) $ do
+            metaSub <- possiblyBuildMetaopVCode name
+            if isJust metaSub then return metaSub else callMeth
+
+    callMethodVV :: Eval (Maybe VCode)
+    callMethodVV = do
+        let (_, methName) = breakSigil name
+        -- Look up the proto for the method in VV land right here
+        -- Whether it matched or not, it's the proto's signature
+        -- that's available to the inferencer, not any of its children's
+        -- (this is because MMD in newland is performed _after_ everything
+        -- has been reduced.)
+        return . Just $ mkPrim
+            { subName     = methName
+            , subParams   = makeParams ["Object", "List", "Named"]
+            , subReturns  = mkType "Any"
+            , subBody     = Prim $ \(inv:named:pos:_) -> do
+                invVV   <- fromVal inv      :: Eval Val.Val
+                posVVs  <- fromVals pos     :: Eval [Val.Val]
+                namVVs  <- do
+                    list <- fromVal named
+                    fmap Map.fromList $ forM list $ \(k, v) -> do
+                        key <- fromVal k
+                        val <- fromVal v
+                        return (key, [val])   :: Eval (ID, [Val.Val])
+
+                -- This is the Capture object we are going to work with
+                let capt = CaptMeth invVV [MkFeed posVVs namVVs]
+
+                return . castV $ "CCall " ++ show methName ++ " " ++ show capt
+            }
+
+    callMethodPerl5 :: Eval (Maybe VCode)
+    callMethodPerl5 = do
         return . Just $ mkPrim
             { subName     = name
@@ -308 +335 @@
         if isNothing attrs || null (fromJust attrs) then fmap (err NoMatchingMulti) (findSub' name) else do
         (`fix` (fromJust attrs)) $ \run pkgs -> do
-            if null pkgs then return (Left $ NoSuchMethod $ pkg) else do
+            if null pkgs then return (Left $ NoSuchMethod $ mkType pkg) else do
             subs <- findWithPkg (head pkgs) name
             either (const $ run (tail pkgs)) (return . Right) subs
@@ -377 +404 @@
     sub <- fromVal val
     return $ subReturns sub
-inferExpType (App (Var "&new") (Just (Val (VType typ))) _) = return typ
+inferExpType (App (Var "&new") (Just inv) _) = inferExpType $ unwrap inv
 inferExpType (App (Var name) invs args) = do
     sub <- findSub name invs args