Changeset 12374 for src/Pugs/Eval

Timestamp:

08/17/06 17:31:05 (2 years ago)

Author:

audreyt

Message:

* Fix infinite loop in SUPER::new dispatch.
* Also refactoed Eval.Var with implicit parameters, so we can

more easily get a stack trace when something goes wrong, with
"make fastprof" and then "./pugs-prof t.pl +RTS -xs".

Files:

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

src/Pugs/Eval/Var.hs

@@ -150 +150 @@
     | NoSuchSub
     | NoSuchMethod !Type
+    deriving (Show)
 
 _SUPER :: ByteString
@@ -158 +159 @@
         -> [Exp]      -- ^ Other arguments
         -> Eval (Either FindSubFailure VCode)
-findSub var invs args
-    | Nothing <- invs = findBuiltinSub NoMatchingMulti var
-    | not (isQualifiedVar var) = case unwrap inv of
-        Val inv@VV{}     -> withExternalCall callMethodVV inv 
-        Val inv@PerlSV{} -> withExternalCall callMethodPerl5 inv 
-        inv' -> do
-            typ <- evalInvType inv'
-            findTypedSub (cast typ) var
-    | Just var' <- dropVarPkg _SUPER var = do
-        pkg <- asks envPackage
-        findSuperSub pkg var'
-    | otherwise = do
-        findBuiltinSub NoMatchingMulti var
+findSub var invs args =
+    let ?var  = var
+        ?invs = invs
+        ?args = args
+    in case invs of
+        Nothing -> findBuiltinSub NoMatchingMulti var
+        _ | not (isQualifiedVar var) -> case unwrap inv of
+            Val vv@VV{}     -> withExternalCall callMethodVV vv
+            Val sv@PerlSV{} -> withExternalCall callMethodPerl5 sv
+            inv' -> do
+                typ <- evalInvType inv'
+                findTypedSub (cast typ) var
+          | Just var' <- dropVarPkg _SUPER var -> do
+            pkg <- asks envPackage
+            findSuperSub pkg var'
+          | otherwise -> do
+            findBuiltinSub NoMatchingMulti var
     where
     inv = fromJust invs
 
-    findSuperSub :: Pkg -> Var -> Eval (Either FindSubFailure VCode)
-    findSuperSub pkg var = do
---          qualified = Str.concat [Str.take 1 name, pkg, __"::", Str.tail name]
-        subs    <- findWithSuper pkg var
-        subs'   <- either (flip findBuiltinSub var) (return . Right) subs
-        case subs' of
---          Right sub | subName sub == qualified -> return (Left $ NoSuchMethod typ)
-            _   -> return subs'
-    findTypedSub :: Pkg -> Var -> Eval (Either FindSubFailure VCode)
-    findTypedSub pkg var = do
-        subs    <- findWithPkg pkg var
-        either (flip findBuiltinSub var) (return . Right) subs
-    findBuiltinSub :: FindSubFailure -> Var -> Eval (Either FindSubFailure VCode)
-    findBuiltinSub failure var = do
-        sub <- findSub' var
-        maybe (fmap (err failure) $ possiblyBuildMetaopVCode var) (return . Right) sub
-    evalInvType :: Exp -> Eval Type
-    evalInvType x = inferExpType $ unwrap x
-
-    withExternalCall callMeth inv = do
-        fmap (err . NoSuchMethod $ valType inv) $ do
-            metaSub <- possiblyBuildMetaopVCode var
-            if isJust metaSub then return metaSub else callMeth
-
-    callMethodVV :: Eval (Maybe VCode)
-    callMethodVV = do
-        let methName = cast (v_name var)
-        -- 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
+findSuperSub :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp])
+    => Pkg -> Var -> Eval (Either FindSubFailure VCode)
+findSuperSub pkg var = do
+    subs    <- findWithSuper pkg var
+    subs'   <- either (flip findBuiltinSub var) (return . Right) subs
+    case subs' of
+        -- Recursion prevention -- SUPER::foo should not go back to ThisClas::foo
+        Right sub | cast (Str.cons '&' $ subName sub) == var{ v_package = pkg } -> do
+            return (Left . NoSuchMethod $ cast pkg)
+        _   -> do
+            return subs'
+
+findTypedSub :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp])
+    => Pkg -> Var -> Eval (Either FindSubFailure VCode)
+findTypedSub pkg var = do
+    subs    <- findWithPkg pkg var
+    either (flip findBuiltinSub var) (return . Right) subs
+
+evalInvType :: Exp -> Eval Type
+evalInvType x = inferExpType $ unwrap x
+
+withExternalCall callMeth inv = do
+    fmap (err . NoSuchMethod $ valType inv) $ do
+        metaSub <- possiblyBuildMetaopVCode ?var
+        if isJust metaSub then return metaSub else callMeth
+
+callMethodVV :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp])
+    => Eval (Maybe VCode)
+callMethodVV = do
+    let methName = cast (v_name ?var)
+    -- 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 :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp])
+    => Eval (Maybe VCode)
+callMethodPerl5 = do
+    let name = cast (v_name ?var)
+    return . Just $ mkPrim
+        { subName     = name
+        , subParams   = makeParams ["Object", "List", "Named"]
+        , subReturns  = mkType "Scalar::Perl5"
+        , subBody     = Prim $ \(inv:named:pos:_) -> do
+            sv      <- fromVal inv
+            posSVs  <- fromVals pos
+            namSVs  <- fmap concat (fromVals named)
+            let svs = posSVs ++ namSVs
+            found   <- liftIO $ canPerl5 sv name
+            found'  <- liftIO $ if found
+                then return found
+                else canPerl5 sv (__"AUTOLOAD")
+            if not found'
+                then do
+                    -- XXX - when svs is empty, this could call back here infinitely
+                    --       add an extra '&' to force no-reinterpretation.
+                    evalExp $
+                        App (Var ?var{ v_sigil = SCodeMulti }) Nothing
+                            (map (Val . PerlSV) (sv:svs))
+                else do
+                    subSV   <- liftIO . bufToSV $ name
+                    runInvokePerl5 subSV sv svs
+        }
+
+findWithPkg :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp])
+    => Pkg -> Var -> Eval (Either FindSubFailure VCode)
+findWithPkg pkg var = do
+    subs <- findSub' var{ v_package = pkg }
+    maybe (findWithSuper pkg var) (return . Right) subs
+
+findWithSuper :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp])
+    => Pkg -> Var -> Eval (Either FindSubFailure VCode)
+findWithSuper pkg var = do
+    -- get superclasses
+    attrs <- fmap (fmap (filter (/= pkg) . nub)) $ findAttrs pkg
+    if isNothing attrs || null (fromJust attrs) then fmap (err NoMatchingMulti) (findSub' var) else do
+    (`fix` (fromJust attrs)) $ \run pkgs -> do
+        if null pkgs then return (Left $ NoSuchMethod (cast pkg)) else do
+        subs <- findWithPkg (head pkgs) var
+        either (const $ run (tail pkgs)) (return . Right) subs
+
+findSub' :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp]) => Var -> Eval (Maybe VCode)
+findSub' var = do
+    subSyms     <- findSyms var
+    lens        <- mapM argSlurpLen (unwrap $ maybeToList ?invs ++ ?args)
+    doFindSub (sum lens) subSyms
+
+argSlurpLen :: Exp -> Eval Int
+argSlurpLen (Val val) = valSlurpLen val
+argSlurpLen (Var name) = do
+    val <- evalExp (Var name)
+    valSlurpLen val
+argSlurpLen (Syn "," list) =  return $ length list
+argSlurpLen _ = return 1 -- XXX
+
+valSlurpLen :: Val -> Eval Int
+valSlurpLen (VList list) = return $ length list
+valSlurpLen (VRef (MkRef (IArray av))) = array_fetchSize av
+valSlurpLen (VRef (MkRef (IHash hv))) = hash_fetchSize hv
+valSlurpLen _  = return 1 -- XXX
+
+doFindSub :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp])
+    => Int -> [(Var, Val)] -> Eval (Maybe VCode)
+doFindSub slurpLen subSyms = do
+    subs' <- subs slurpLen subSyms
+    -- let foo (x, sub) = show x ++ show (map paramContext $ subParams sub)
+    -- trace (unlines $ map foo $ sort subs') return ()
+    return $ case sort subs' of
+        ((_, sub):_)    -> Just sub
+        _               -> Nothing
+
+subs :: (?invs :: Maybe Exp, ?args :: [Exp])
+    => Int -> [(Var, Val)] -> Eval [((Bool, Bool, Int, Int), VCode)]
+subs slurpLen subSyms = fmap catMaybes . forM subSyms $ \(_, val) -> do
+    sub@(MkCode{ subReturns = ret, subParams = prms }) <- fromVal val
+    let rv = return $ arityMatch sub (length (maybeToList ?invs ++ ?args)) slurpLen
+    maybeM rv $ \fun -> do
+        -- if deltaFromCxt ret == 0 then return Nothing else do
+        let pairs = map (typeOfCxt . paramContext) prms
+                        `zip` (map unwrap $ maybeToList ?invs ++ ?args)
+        deltaCxt    <- deltaFromCxt ret
+        deltaArgs   <- mapM deltaFromPair pairs
+        let bound = either (const False) (const True) $ bindParams sub ?invs ?args
+        return ((isMulti sub, bound, sum deltaArgs, deltaCxt), fun)
+
+findBuiltinSub :: (?var :: Var, ?invs :: Maybe Exp, ?args :: [Exp])
+    => FindSubFailure -> Var -> Eval (Either FindSubFailure VCode)
+findBuiltinSub failure var = do
+    sub <- findSub' var
+    maybe (fmap (err failure) $ possiblyBuildMetaopVCode var) (return . Right) sub
+
+firstArg :: (?args :: [Exp]) => [Exp]
+firstArg = [maybe (Val undef) id (listToMaybe ?args)]
+
+buildPrefixHyper name var = do
+    let rv = fmap (either (const Nothing) Just) $
+            findSub var Nothing firstArg
+    maybeM rv $ \code -> return $ mkPrim
+        { subName     = name
+        , subType     = SubPrim
+        , subAssoc    = subAssoc code
+        , subParams   = subParams code
+        , subReturns  = mkType "List"
+        , subBody     = Prim
+            (\x -> op1HyperPrefix code (listArg x))
+        }
+
+buildPostfixHyper name var = do
+    let rv = fmap (either (const Nothing) Just) $
+            findSub var Nothing firstArg
+    maybeM rv $ \code -> return $ mkPrim
+        { subName     = name
+        , subType     = SubPrim
+        , subAssoc    = subAssoc code
+        , subParams   = subParams code
+        , subReturns  = mkType "List"
+        , subBody     = Prim
+            (\x -> op1HyperPostfix code (listArg x))
+        }
+
+buildInfixHyper name var = do
+    let rv = fmap (either (const Nothing) Just) $
+            findSub var Nothing (take 2 (?args ++ [Val undef, Val undef]))
+    maybeM rv $ \code -> return $ mkPrim
+        { subName     = name
+        , subType     = SubPrim
+        , subAssoc    = subAssoc code
+        , subParams   = makeParams ["Any", "Any"]
+        , subReturns  = mkType "List"
+        , subBody     = Prim (\[x, y] -> op2Hyper code x y)
+        }
+
+possiblyBuildMetaopVCode :: (?args :: [Exp]) => Var -> Eval (Maybe VCode)
+possiblyBuildMetaopVCode var@MkVar{ v_categ = cat, v_name = name }
+    | C_prefix <- cat, '\171' <- Str.last buf = do
+        buildPrefixHyper buf var{ v_name = cast $ Str.init buf }
+    | C_prefix <- cat, __"<<" `Str.isSuffixOf` buf = do
+        buildPrefixHyper buf var{ v_name = cast $ dropEnd 2 buf }
+    | C_postfix <- cat, '\187' <- Str.head buf = do
+        buildPostfixHyper buf var{ v_name = cast $ Str.tail buf }
+    | C_postfix <- cat, __">>" `Str.isPrefixOf` buf = do
+        buildPostfixHyper buf var{ v_name = cast $ Str.drop 2 buf }
+    | C_infix <- cat, '\187' <- Str.head buf, '\171' <- Str.last buf = do
+        buildInfixHyper buf var{ v_name = cast $ Str.init (Str.tail buf) }
+    | C_infix <- cat, __">>" `Str.isPrefixOf` buf, __"<<" `Str.isSuffixOf` buf = do
+        buildInfixHyper buf var{ v_name = cast $ Str.take 2 (dropEnd 2 buf) }
+    | C_prefix <- cat, '[' <- Str.head buf, ']' <- Str.last buf = do
+        -- Strip the trailing "]" from op
+        let (op, keep)
+                | Str.index buf 1 == '\\'   = (Str.drop 2 (Str.init buf), True)
+                | otherwise                 = (Str.tail (Str.init buf), False)
+
+        -- We try to find the userdefined sub.
+        -- We use the first two elements of invs as invocants, as these are the
+        -- types of the op.
+            rv = fmap (either (const Nothing) Just) $
+                findSub (var{ v_categ = C_infix, v_name = cast op }) Nothing
+                    (take 2 $ ?args ++ [Val undef, Val undef])
+        maybeM rv $ \code -> return $ mkPrim
+            { subName     = buf
+            , subType     = SubPrim
+            , subAssoc    = "spre"
+            , subParams   = makeParams $
+                if any isLValue (subParams code)
+                    then ["rw!List"] -- XXX - does not yet work for the [=] case
+                    else ["List"]
+            , subReturns  = anyType
+            , subBody     = Prim $ \[vs] -> do
+                list_of_args <- fromVal vs
+                op2Reduce keep list_of_args (VCode code)
             }
-
-    callMethodPerl5 :: Eval (Maybe VCode)
-    callMethodPerl5 = do
-        return . Just $ mkPrim
-            { subName     = cast (v_name var)
-            , subParams   = makeParams ["Object", "List", "Named"]
-            , subReturns  = mkType "Scalar::Perl5"
-            , subBody     = Prim $ \(inv:named:pos:_) -> do
-                sv      <- fromVal inv
-                posSVs  <- fromVals pos
-                namSVs  <- fmap concat (fromVals named)
-                let svs = posSVs ++ namSVs
-                found   <- liftIO $ canPerl5 sv (cast $ v_name var)
-                found'  <- liftIO $ if found
-                    then return found
-                    else canPerl5 sv (__"AUTOLOAD")
-                if not found'
-                    then do
-                        -- XXX - when svs is empty, this could call back here infinitely
-                        --       add an extra '&' to force no-reinterpretation.
-                        evalExp $
-                            App (Var var{ v_sigil = SCodeMulti }) Nothing
-                                (map (Val . PerlSV) (sv:svs))
-                    else do
-                        subSV   <- liftIO . bufToSV . cast $ v_name var
-                        runInvokePerl5 subSV sv svs
-            }
-
-    findWithPkg :: Pkg -> Var -> Eval (Either FindSubFailure VCode)
-    findWithPkg pkg var = do
-        subs <- findSub' var{ v_package = pkg }
-        maybe (findWithSuper pkg var) (return . Right) subs
-
-    findWithSuper :: Pkg -> Var -> Eval (Either FindSubFailure VCode)
-    findWithSuper pkg var = do
-        -- get superclasses
-        attrs <- fmap (fmap (filter (/= pkg) . nub)) $ findAttrs pkg
-        if isNothing attrs || null (fromJust attrs) then fmap (err NoMatchingMulti) (findSub' var) else do
-        (`fix` (fromJust attrs)) $ \run pkgs -> do
-            if null pkgs then return (Left $ NoSuchMethod (cast pkg)) else do
-            subs <- findWithPkg (head pkgs) var
-            either (const $ run (tail pkgs)) (return . Right) subs
-    findSub' :: Var -> Eval (Maybe VCode)
-    findSub' var = do
-        subSyms     <- findSyms var
-        lens        <- mapM argSlurpLen (unwrap $ maybeToList invs ++ args)
-        doFindSub (sum lens) subSyms
-    argSlurpLen :: Exp -> Eval Int
-    argSlurpLen (Val val) = valSlurpLen val
-    argSlurpLen (Var name) = do
-        val <- evalExp (Var name)
-        valSlurpLen val
-    argSlurpLen (Syn "," list) =  return $ length list
-    argSlurpLen _ = return 1 -- XXX
-
-    valSlurpLen :: Val -> Eval Int
-    valSlurpLen (VList list) = return $ length list
-    valSlurpLen (VRef (MkRef (IArray av))) = array_fetchSize av
-    valSlurpLen (VRef (MkRef (IHash hv))) = hash_fetchSize hv
-    valSlurpLen _  = return 1 -- XXX
-
-    doFindSub :: Int -> [(Var, Val)] -> Eval (Maybe VCode)
-    doFindSub slurpLen subSyms = do
-        subs' <- subs slurpLen subSyms
-        -- let foo (x, sub) = show x ++ show (map paramContext $ subParams sub)
-        -- trace (unlines $ map foo $ sort subs') return ()
-        return $ case sort subs' of
-            ((_, sub):_)    -> Just sub
-            _               -> Nothing
-    subs :: Int -> [(Var, Val)] -> Eval [((Bool, Bool, Int, Int), VCode)]
-    subs slurpLen subSyms = fmap catMaybes . forM subSyms $ \(_, val) -> do
-        sub@(MkCode{ subReturns = ret, subParams = prms }) <- fromVal val
-        let rv = return $ arityMatch sub (length (maybeToList invs ++ args)) slurpLen
-        maybeM rv $ \fun -> do
-            -- if deltaFromCxt ret == 0 then return Nothing else do
-            let pairs = map (typeOfCxt . paramContext) prms
-                            `zip` (map unwrap $ maybeToList invs ++ args)
-            deltaCxt    <- deltaFromCxt ret
-            deltaArgs   <- mapM deltaFromPair pairs
-            let bound = either (const False) (const True) $ bindParams sub invs args
-            return ((isMulti sub, bound, sum deltaArgs, deltaCxt), fun)
-
-    firstArg = [maybe (Val undef) id (listToMaybe args)]
-
-    buildPrefixHyper name var = do
-        let rv = fmap (either (const Nothing) Just) $
-                findSub var Nothing firstArg
-        maybeM rv $ \code -> return $ mkPrim
-            { subName     = name
-            , subType     = SubPrim
-            , subAssoc    = subAssoc code
-            , subParams   = subParams code
-            , subReturns  = mkType "List"
-            , subBody     = Prim
-                (\x -> op1HyperPrefix code (listArg x))
-            }
-
-    buildPostfixHyper name var = do
-        let rv = fmap (either (const Nothing) Just) $
-                findSub var Nothing firstArg
-        maybeM rv $ \code -> return $ mkPrim
-            { subName     = name
-            , subType     = SubPrim
-            , subAssoc    = subAssoc code
-            , subParams   = subParams code
-            , subReturns  = mkType "List"
-            , subBody     = Prim
-                (\x -> op1HyperPostfix code (listArg x))
-            }
-
-    buildInfixHyper name var = do
-        let rv = fmap (either (const Nothing) Just) $
-                findSub var Nothing (take 2 (args ++ [Val undef, Val undef]))
-        maybeM rv $ \code -> return $ mkPrim
-            { subName     = name
-            , subType     = SubPrim
-            , subAssoc    = subAssoc code
-            , subParams   = makeParams ["Any", "Any"]
-            , subReturns  = mkType "List"
-            , subBody     = Prim (\[x, y] -> op2Hyper code x y)
-            }
-
-    possiblyBuildMetaopVCode :: Var -> Eval (Maybe VCode)
-    possiblyBuildMetaopVCode var@MkVar{ v_categ = cat, v_name = name }
-        | C_prefix <- cat, '\171' <- Str.last buf = do
-            buildPrefixHyper buf var{ v_name = cast $ Str.init buf }
-        | C_prefix <- cat, __"<<" `Str.isSuffixOf` buf = do
-            buildPrefixHyper buf var{ v_name = cast $ dropEnd 2 buf }
-        | C_postfix <- cat, '\187' <- Str.head buf = do
-            buildPostfixHyper buf var{ v_name = cast $ Str.tail buf }
-        | C_postfix <- cat, __">>" `Str.isPrefixOf` buf = do
-            buildPostfixHyper buf var{ v_name = cast $ Str.drop 2 buf }
-        | C_infix <- cat, '\187' <- Str.head buf, '\171' <- Str.last buf = do
-            buildInfixHyper buf var{ v_name = cast $ Str.init (Str.tail buf) }
-        | C_infix <- cat, __">>" `Str.isPrefixOf` buf, __"<<" `Str.isSuffixOf` buf = do
-            buildInfixHyper buf var{ v_name = cast $ Str.take 2 (dropEnd 2 buf) }
-        | C_prefix <- cat, '[' <- Str.head buf, ']' <- Str.last buf = do
-            -- Strip the trailing "]" from op
-            let (op, keep)
-                    | Str.index buf 1 == '\\'   = (Str.drop 2 (Str.init buf), True)
-                    | otherwise                 = (Str.tail (Str.init buf), False)
-
-            -- We try to find the userdefined sub.
-            -- We use the first two elements of invs as invocants, as these are the
-            -- types of the op.
-                rv = fmap (either (const Nothing) Just) $
-                    findSub (var{ v_categ = C_infix, v_name = cast op }) Nothing
-                        (take 2 $ args ++ [Val undef, Val undef])
-            maybeM rv $ \code -> return $ mkPrim
-                { subName     = buf
-                , subType     = SubPrim
-                , subAssoc    = "spre"
-                , subParams   = makeParams $
-                    if any isLValue (subParams code)
-                        then ["rw!List"] -- XXX - does not yet work for the [=] case
-                        else ["List"]
-                , subReturns  = anyType
-                , subBody     = Prim $ \[vs] -> do
-                    list_of_args <- fromVal vs
-                    op2Reduce keep list_of_args (VCode code)
-                }
-            -- Now we construct the sub. Is there a more simple way to do it?
-        | otherwise = return Nothing
-        where
-        buf = cast name
+        -- Now we construct the sub. Is there a more simple way to do it?
+    | otherwise = return Nothing
+    where
+    buf = cast name
 
 metaVar :: Pkg -> Var
@@ -567 +591 @@
 findSyms :: Var -> Eval [(Var, Val)]
 findSyms var = do
-    runMaybeT (findLexical `mplus` findPackage `mplus` findGlobal)
-        >>= maybe (return []) return
+    runMaybeT findAll >>= maybe (return []) return
     where
+    findAll
+        | isGlobalVar var       = findGlobal
+        | isQualifiedVar var    = findQualified
+        | otherwise             = findLexical `mplus` findPackage
+
+    -- $x should look up $x in the current pad first.
     findLexical :: MaybeT Eval [(Var, Val)]
     findLexical = do
         lex <- lift $ asks envLexical
-        padSym lex var{ v_package = emptyPkg }
+        padSym lex var
         
+    -- $x then fallbacks to $This::Package::x, or maybe $*x.
     findPackage :: MaybeT Eval [(Var, Val)]
     findPackage = do
         glob <- lift $ askGlobal
         pkg  <- lift $ asks envPackage
-        padSym glob var `mplus` padSym glob (toPackage pkg var)
-
+        padSym glob var
+            `mplus` padSym glob (toPackage pkg var)
+            `mplus` padSym glob (toGlobalVar var)
+
+    -- $Foo::x is just $Foo::x, or maybe $*Foo::x.
+    findQualified :: MaybeT Eval [(Var, Val)]
+    findQualified = do
+        glob <- lift $ askGlobal
+        padSym glob var
+            `mplus` padSym glob (toGlobalVar var)
+
+    -- $*Foo::x is just that.
     findGlobal :: MaybeT Eval [(Var, Val)]
     findGlobal = do