Changeset 4986

Show
Ignore:
Timestamp:
06/26/05 10:01:46 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
6771
Message:

* Repair smart match on types and does calls from the zero

dereference regime by explicitly fetching their metaobjects
and walking the inheritance/mixin tree ourselves.

Location:
src/Pugs
Files:
2 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Prim.hs

    r4943 r4986  
    2525import Pugs.Internals 
    2626import Pugs.Junc 
    27 import Pugs.Context 
    2827import Pugs.AST 
    2928import Pugs.Types 
    … …  
    567566    (return . VList $ vals) 
    568567 
    569 pkgParents :: VStr -> Eval [VStr] 
    570 pkgParents pkg = do 
    571     ref     <- readVar (':':'*':pkg) 
    572     if ref == undef then return [] else do 
    573     meta    <- readRef =<< fromVal ref 
    574     fetch   <- doHash meta hash_fetchVal 
    575     attrs   <- fromVal =<< fetch "traits" 
    576     pkgs    <- mapM pkgParents attrs 
    577     return $ nub (pkg:concat pkgs) 
    578  
    579568op1WalkAllNoArgs :: ([VStr] -> [VStr]) -> VStr -> Val -> Eval Val 
    580569op1WalkAllNoArgs f meth v = do 
    … …  
    813802op2 "does"  = op2 "isa" -- XXX not correct 
    814803op2 "isa"   = \x y -> do 
    815     typX <- fromVal =<< op1 "ref" x 
    816804    typY <- case y of 
    817805        VStr str -> return $ mkType str 
    818806        _        -> fromVal y 
    819     cls  <- asks envClasses 
    820     return . VBool $ isaType cls (showType typY) typX 
     807    op2Match x (VType typY) 
    821808op2 "delete" = \x y -> do 
    822809    ref <- fromVal x 

  • src/Pugs/Prim/Match.hs

    r4922 r4986  
    33 
    44module Pugs.Prim.Match ( 
    5     op2Match, rxSplit, rxSplit_n, matchFromMR 
     5    op2Match, rxSplit, rxSplit_n, matchFromMR, pkgParents 
    66) where 
    77import Pugs.Internals 
    … …  
    99import Pugs.AST 
    1010import Pugs.Types 
    11 import Pugs.Context 
    1211import Pugs.Config 
    1312import qualified RRegex.PCRE as PCRE 
    … …  
    7473-- XXX - need to generalise this 
    7574op2Match :: Val -> Val -> Eval Val 
     75 
     76op2Match x (VRef (MkRef (IScalar sv))) | scalar_iType sv == mkType "Scalar::Const" = do 
     77    y' <- scalar_fetch' sv 
     78    op2Match x y' 
     79 
    7680op2Match x (VRef y) = do 
    7781    y' <- readRef y 
    7882    op2Match x y' 
     83 
     84op2Match x y@(VObject MkObject{ objType = MkType "Class" } ) = do 
     85    fetch   <- doHash y hash_fetchVal 
     86    name    <- fromVal =<< fetch "name" 
     87    op2Match x (VType (MkType name)) 
    7988 
    8089op2Match x (VSubst (rx, subst)) | rxGlobal rx = do 
    … …  
    147156 
    148157op2Match (VType typ) (VType t) = do 
    149     cls <- asks envClasses 
    150     return $ VBool (isaType cls (showType t) typ) 
     158    typs <- pkgParents (showType typ) 
     159    return . VBool $ showType t `elem` typs 
    151160 
    152161op2Match x y@(VType _) = do 
    … …  
    154163    op2Match (VType typ) y 
    155164 
    156 op2Match x y = op2Cmp (fromVal :: Val -> Eval VStr) (==) x y 
     165op2Match x y = do 
     166    op2Cmp (fromVal :: Val -> Eval VStr) (==) x y 
    157167 
    158168op2Cmp :: (a -> Eval b) -> (b -> b -> VBool) -> a -> a -> Eval Val 
    … …  
    195205            rest <- rxSplit_n rx after (n-1) 
    196206            return $ (VStr before:matchSubPos match) ++ rest 
     207 
     208pkgParents :: VStr -> Eval [VStr] 
     209pkgParents pkg = do 
     210    ref     <- readVar (':':'*':pkg) 
     211    if ref == undef then return [] else do 
     212    meta    <- readRef =<< fromVal ref 
     213    fetch   <- doHash meta hash_fetchVal 
     214    attrs   <- fromVal =<< fetch "traits" 
     215    pkgs    <- mapM pkgParents attrs 
     216    return $ nub (pkg:concat pkgs) 
     217