Changeset 12317

Show
Ignore:
Timestamp:
08/16/06 19:28:24 (2 years ago)
Author:
audreyt
Message:

* Glorious refactoring of the Var type.

Previously, Var is type synonym to String, and all package

lookups, OUTER
handling, sigil and twigil parsing etc were done in an extremely adhoc way with String operations.

Now we split Var into several parts.
Take "&Moose::Elk::infix:<antler>" as an example:

v_sigil
VarSigil? -- SScalar
v_twigil
VarTwigil? -- TNone
v_package
Pkg -- ["Moose", "Elk"]
v_categ
VarCateg? -- C_infix
v_name
ID -- "antler"

The names are stored as interned ByteStrings? for fast comparison.

All involved types are changed from String to new types as well,

such as (envPackage
Pkg).
Location:
src
Files:
40 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs.hs

    r11933 r12317  
    303303    return () 
    304304    where 
    305     exp = App (Var "&require") Nothing [Val $ VStr fn] 
     305    exp = App (_Var "&require") Nothing [Val $ VStr fn] 
    306306 
    307307doRunSingle :: TVar Env -> RunOptions -> String -> IO () 
    … …  
    315315            ref <- liftSTM $ do 
    316316                pad <- readTVar (envGlobal env') 
    317                 readTVar $ fromJust (findSym "$*_" pad) 
     317                readTVar $ fromJust (findSym (cast "$*_") pad) 
    318318            val <- runEvalIO env' $ readRef ref 
    319319            liftSTM $ writeTVar menv env' 

  • src/Pugs/AST.hs

    r12176 r12317  
    3131import Pugs.Types 
    3232import qualified Data.Map as Map 
    33 import Pugs.AST.Internals.Instances 
     33import qualified Data.Set as Set 
     34import Pugs.AST.Internals.Instances () 
    3435import Pugs.AST.Internals 
    3536import Pugs.AST.Prag 
    … …  
    100101(Is this correct?) 
    101102-} 
    102 genMultiSym :: MonadSTM m => String -> VRef -> m PadMutator 
     103genMultiSym :: MonadSTM m => Var -> VRef -> m PadMutator 
    103104genMultiSym name ref = do 
    104105    --trace ("installing multi: " ++ name) $ return () 
    … …  
    114115(right?), shadowing any earlier or outer definition. 
    115116-} 
    116 genSym :: MonadSTM m => String -> VRef -> m PadMutator 
    117 genSym name ref = do 
     117genSym :: MonadSTM m => Var -> VRef -> m PadMutator 
     118genSym var ref = do 
    118119    --trace ("installing: " ++ name) $ return () 
    119120    tvar    <- liftSTM $ newTVar ref 
    120121    fresh   <- liftSTM $ newTVar True 
    121     return $ \(MkPad map) -> MkPad $ Map.insert name (MkEntry (fresh, tvar)) map 
     122    return $ \(MkPad map) -> MkPad $ Map.insert var (MkEntry (fresh, tvar)) map 
    122123 
    123124{-| 
    … …  
    131132    Pad _ _ exp     -> isScalarLValue exp 
    132133    Sym _ _ exp     -> isScalarLValue exp 
    133     Var ('$':_)    -> True 
     134    Var var | SScalar <- v_sigil var -> True 
    134135    Syn "${}" _     -> True -- XXX - Change tp App("&prefix:<$>") later 
    135136    Syn "$::()" _   -> True 
    … …  
    141142    where 
    142143    isSIMPLE x = case unwrap x of 
    143         App (Var ('&':'p':'r':'e':'f':'i':'x':':':op)) Nothing [y] 
    144             -> op `elem` coercePrefixOps || (op `elem` simplePrefixOps && isSIMPLE y) 
    145         App (Var ('&':'p':'r':'e':'f':'i':'x':':':op)) (Just y) [] 
    146             -> op `elem` coercePrefixOps || (op `elem` simplePrefixOps && isSIMPLE y) 
    147         App (Var ('&':'p':'o':'s':'t':'f':'i':'x':':':op)) Nothing [y] 
    148             -> op `elem` simplePostfixOps && isSIMPLE y 
    149         App (Var ('&':'p':'o':'s':'t':'f':'i':'x':':':op)) (Just y) [] 
    150             -> op `elem` simplePostfixOps && isSIMPLE y 
    151         App (Var ('&':'i':'n':'f':'i':'x':':':op)) Nothing [y, z] 
    152             -> op `elem` simpleInfixOps && isSIMPLE y && isSIMPLE z 
    153         App (Var ('&':'i':'n':'f':'i':'x':':':op)) (Just y) [z] 
    154             -> op `elem` simpleInfixOps && isSIMPLE y && isSIMPLE z 
     144        App (Var var) Nothing [y] 
     145            | C_prefix <- v_categ var 
     146            -> var `Set.member` coercePrefixOps 
     147                || (var `Set.member` simplePrefixOps && isSIMPLE y) 
     148            | C_postfix <- v_categ var 
     149            -> var `Set.member` simplePostfixOps && isSIMPLE y 
     150        App (Var var) (Just y) [] 
     151            | C_prefix <- v_categ var 
     152            -> var `Set.member` coercePrefixOps 
     153                || (var `Set.member` simplePrefixOps && isSIMPLE y) 
     154            | C_postfix <- v_categ var 
     155            -> var `Set.member` simplePostfixOps && isSIMPLE y 
     156        App (Var var) Nothing [x, y] 
     157            | C_infix <- v_categ var 
     158            -> var `Set.member` simpleInfixOps && isSIMPLE x && isSIMPLE y 
     159        App (Var var) (Just x) [y] 
     160            | C_infix <- v_categ var 
     161            -> var `Set.member` simpleInfixOps && isSIMPLE x && isSIMPLE y 
    155162        _               -> isScalarLValue x 
    156     coercePrefixOps = 
    157         [ "!","+","-","~","?","$" ] 
    158     simplePrefixOps = 
    159         [ "++","--" 
    160         , "$","&","+^","~^","?^","\\","^","=" 
    161         ] 
    162     simplePostfixOps = ["++", "--"] 
    163     simpleInfixOps = 
    164         [ "**" 
    165         , "**=" 
    166         , "*","/","%","x","+&","+<","+>","~&","~<","~>" 
    167         , "*=","/=","%=","x=","+&=","+<=","+>=","~&=","~<=","~>=" 
    168         , "+","-","~","+|","+^","~|","~^" 
    169         , "+=","-=","~=","+|=","+^=","~|=","~^=" 
    170         ] 
     163 
     164opSet :: VarCateg -> [String] -> Set Var 
     165opSet cat posts = Set.fromList $ map doMakeVar posts 
     166    where 
     167    doMakeVar name = MkVar 
     168        { v_sigil   = SCode 
     169        , v_twigil  = TNone 
     170        , v_package = emptyPkg 
     171        , v_categ   = cat 
     172        , v_name    = cast name 
     173        } 
     174 
     175coercePrefixOps, simplePrefixOps, simplePostfixOps, simpleInfixOps :: Set Var 
     176coercePrefixOps = opSet C_prefix [ "!","+","-","~","?","$" ] 
     177simplePrefixOps = opSet C_prefix 
     178    [ "++","--" 
     179    , "$","&","+^","~^","?^","\\","^","=" 
     180    ] 
     181simplePostfixOps = opSet C_postfix ["++", "--"] 
     182simpleInfixOps = opSet C_infix 
     183    [ "**" 
     184    , "**=" 
     185    , "*","/","%","x","+&","+<","+>","~&","~<","~>" 
     186    , "*=","/=","%=","x=","+&=","+<=","+>=","~&=","~<=","~>=" 
     187    , "+","-","~","+|","+^","~|","~^" 
     188    , "+=","-=","~=","+|=","+^=","~|=","~^=" 
     189    ] 
     190 
     191 
    171192 
    172193 
    … …  
    181202    Syn "namespace" [kind, pkg, y] 
    182203mergeStmts x@(Ann ann (Syn syn _)) y | (syn ==) `any` words "subst match //"  = 
    183     mergeStmts (Ann ann (App (Var "&infix:~~") Nothing [Var "$_", x])) y 
     204    mergeStmts (Ann ann (App (_Var "&infix:~~") Nothing [_Var "$_", x])) y 
    184205mergeStmts x y@(Ann ann (Syn syn _)) | (syn ==) `any` words "subst match //"  = 
    185     mergeStmts x (Ann ann (App (Var "&infix:~~") Nothing [Var "$_", y])) 
     206    mergeStmts x (Ann ann (App (_Var "&infix:~~") Nothing [_Var "$_", y])) 
    186207mergeStmts (Ann ann (Syn "sub" [Val (VCode sub)])) y | subType sub == SubBlock = 
    187208    -- bare Block in statement level; annul all its parameters and run it! 
    … …  
    196217isEmptyParams :: [Param] -> Bool 
    197218isEmptyParams [] = True 
    198 isEmptyParams [x] | [_, '_'] <- paramName x = True 
     219isEmptyParams [x] 
     220    | var <- paramName x 
     221    , _underscore == v_name var 
     222    , emptyPkg    == v_package var 
     223    , TNone       == v_twigil var 
     224    = True 
    199225isEmptyParams _ = False 
     226 
     227_underscore :: ID 
     228_underscore = cast "_"  
    200229 
    201230newPackage :: String -> String -> [String] -> [String] -> Exp 
    202231newPackage cls name classes roles = Stmts metaObj (newType name) 
    203232    where 
    204     metaObj = Sym SGlobal (':':'*':name) $! Syn ":=" 
    205         [ Var (':':'*':name) 
    206         , App (Var "&META::new") 
     233    metaObj = _Sym SGlobal (':':'*':name) $! Syn ":=" 
     234        [ _Var (':':'*':name) 
     235        , App (_Var "&META::new") 
    207236            (Just $ Val (VType $ mkType cls)) 
    208237            [ Syn "named" 
    … …  
    222251 
    223252newType :: String -> Exp 
    224 newType name = Sym SGlobal ('&':'&':'*':name) $! Syn ":=" 
    225     [ Var ('&':'*':name) 
     253newType name = _Sym SGlobal ('&':'&':'*':name) $! Syn ":=" 
     254    [ _Var ('&':'*':name) 
    226255    , typeMacro name (Val . VType . mkType $ name) 
    227256    ] 
    228257 
    229258newMetaType :: String -> Exp 
    230 newMetaType name = Sym SGlobal ('&':'&':'*':name) $! Syn ":=" 
    231     [ Var ('&':'*':name) 
    232     , typeMacro name (Var (':':'*':name)) 
     259newMetaType name = _Sym SGlobal ('&':'&':'*':name) $! Syn ":=" 
     260    [ _Var ('&':'*':name) 
     261    , typeMacro name (_Var (':':'*':name)) 
    233262    ] 
    234263 
    … …  
    236265typeMacro name exp = Syn "sub" . (:[]) . Val . VCode $ MkCode 
    237266    { isMulti       = True 
    238     , subName       = name 
     267    , subName       = cast ('&':name) 
    239268    , subEnv        = Nothing 
    240269    , subType       = SubMacro 
    … …  
    259288    fmap (MkPad . Map.fromAscList . catMaybes) . mapM checkPrim $ Map.toAscList pad 
    260289 
    261 checkPrim :: (String, PadEntry) -> Eval (Maybe (String, PadEntry)) 
    262 checkPrim ((':':'*':_), _) = return Nothing 
    263 checkPrim e@((_, MkEntry (_, tv))) = do 
    264     rv <- isPrim tv 
    265     return $ if rv then Nothing else Just e 
    266 checkPrim (key, MkEntryMulti xs) = do 
    267     xs' <- filterM (fmap not . isPrim . snd) xs 
    268     return $ if null xs' then Nothing else Just (key, MkEntryMulti xs') 
     290checkPrim :: (Var, PadEntry) -> Eval (Maybe (Var, PadEntry)) 
     291checkPrim e@(var, entry) 
     292    | SType <- v_sigil var, isGlobalVar var = return Nothing 
     293    | MkEntry (_, tv) <- entry = do 
     294        rv <- isPrim tv 
     295        return $ if rv then Nothing else Just e 
     296    | otherwise = do 
     297        let MkEntryMulti xs = entry 
     298        xs' <- filterM (fmap not . isPrim . snd) xs 
     299        return $ if null xs' then Nothing else Just (var, MkEntryMulti xs') 
    269300 
    270301isPrim :: TVar VRef -> Eval Bool 
    … …  
    282313filterUserDefinedPad (MkPad pad) = MkPad $ Map.filterWithKey doFilter pad 
    283314    where 
    284     doFilter key _ = not (key `elem` reserved) 
    285     reserved = words $ 
    286         "@*ARGS @*INC %*INC $*PUGS_HAS_HSPLUGINS $*EXECUTABLE_NAME " ++ 
    287         "$*PROGRAM_NAME $*PID $*UID $*EUID $*GID $*EGID @*CHECK @*INIT $*IN " ++ 
    288         "$*OUT $*ERR $*ARGS $/ %*ENV $*CWD @=POD $=POD $?PUGS_VERSION " ++ 
    289         "$*OS &?BLOCK_EXIT %?CONFIG $*_ $*AUTOLOAD" 
    290  
     315    doFilter key _ = key `Set.notMember` _reserved 
     316 
     317_reserved :: Set Var 
     318_reserved = Set.fromList . cast . words $ 
     319    "@*ARGS @*INC %*INC $*PUGS_HAS_HSPLUGINS $*EXECUTABLE_NAME " ++ 
     320    "$*PROGRAM_NAME $*PID $*UID $*EUID $*GID $*EGID @*CHECK @*INIT $*IN " ++ 
     321    "$*OUT $*ERR $*ARGS $/ %*ENV $*CWD @=POD $=POD $?PUGS_VERSION " ++ 
     322    "$*OS &?BLOCK_EXIT %?CONFIG $*_ $*AUTOLOAD" 

  • src/Pugs/AST/Eval.hs

    r12173 r12317  
    108108    fail str = do 
    109109        pos <- asks envPos' 
    110         shiftT . const . return $ errStrPos str pos 
     110        shiftT . const . return $ errStrPos (cast str) pos 
    111111 
    112112instance MonadTrans EvalT where 
    … …  
    183183-} 
    184184 
    185 retError :: (Show a) => VStr -> a -> Eval b 
     185retError :: (Show a) => String -> a -> Eval b 
    186186retError str a = fail $ str ++ ": " ++ show a 
    187187 

  • src/Pugs/AST/Internals.hs

    r12230 r12317  
    6565    refreshPad, lookupPad, padToList, listToPad, 
    6666    mkPrim, mkSub, showRat, showTrueRat, 
    67     cxtOfSigil, typeOfSigil, 
     67    cxtOfSigil, cxtOfSigilVar, typeOfSigil, typeOfSigilVar, 
    6868    buildParam, defaultArrayParam, defaultHashParam, defaultScalarParam, 
    6969    emptyExp, 
    … …  
    7676    errStrPos, errValPos, enterAtomicEnv, valToBool, envPos', -- for circularity 
    7777    expToEvalVal, -- Hack, should be removed once it's figured out how 
     78 
     79    _Sym, _Var, -- String -> ByteString constructors 
    7880) where 
    7981import Pugs.Internals 
    8082import Pugs.Types 
    8183import Pugs.Cont hiding (shiftT, resetT) 
    82 import System.IO.Error (try) 
    8384import qualified Data.Set       as Set 
    8485import qualified Data.Map       as Map 
    … …  
    9899import Pugs.Embed.Perl5 
    99100import qualified Pugs.Val as Val 
     101import qualified Data.ByteString.Char8 as Str 
    100102import Pugs.Val hiding (Val, IValue, VUndef) 
    101103 
    … …  
    377379    castV = VCode 
    378380    fromSV sv = return $ mkPrim 
    379         { subName     = "<anon>" 
     381        { subName     = cast "<anon>" 
    380382        , subParams   = [defaultArrayParam] 
    381383        , subReturns  = mkType "Scalar::Perl5" 
    … …  
    521523    doCast (VNum n)      = return $ showNum n 
    522524    doCast (VList l)     = fmap unwords (mapM fromVal l) 
    523     doCast (VCode s)     = return $ "<" ++ show (subType s) ++ "(" ++ subName s ++ ")>" 
     525    doCast (VCode s)     = return $ "<" ++ show (subType s) ++ "(" ++ cast (subName s) ++ ")>" 
    524526    doCast (VJunc j)     = return $ show j 
    525527    doCast (VThread t)   = return $ takeWhile isDigit $ dropWhile (not . isDigit) $ show t 
    … …  
    647649        , rxGlobal    :: !Bool  -- ^ Flag indicating \'global\' (match-all) 
    648650        , rxNumSubs   :: !Int   -- ^ The number of subpatterns present. 
    649             , rxStringify :: !Bool 
     651        , rxStringify :: !Bool 
    650652        , rxRuleStr   :: !String -- ^ The rule string, for user reference. 
    651653        , rxAdverbs   :: !Val 
    … …  
    784786    , isWritable    :: !Bool        -- ^ Is it writable (i.e. `is rw`)? 
    785787    , isLazy        :: !Bool        -- ^ Is it call-by-name (short-circuit)? 
    786     , paramName     :: !String      -- ^ Parameter name 
     788    , paramName     :: !Var         -- ^ Parameter name 
    787789    , paramContext  :: !Cxt         -- ^ Parameter context: slurpiness and type 
    788790    , paramDefault  :: !Exp         -- ^ Default expression (to evaluate to) 
    … …  
    826828data VCode = MkCode 
    827829    { isMulti       :: !Bool        -- ^ Is this a multi sub\/method? 
    828     , subName       :: !String      -- ^ Name of the closure 
     830    , subName       :: !ByteString  -- ^ Name of the closure 
    829831    , subType       :: !SubType     -- ^ Type of the closure 
    830832    , subEnv        :: !(Maybe Env) -- ^ Lexical pad for sub\/method 
    … …  
    848850mkPrim = MkCode 
    849851    { isMulti = True 
    850     , subName = "" 
     852    , subName = cast "&" 
    851853    , subType = SubPrim 
    852854    , subEnv = Nothing 
    … …  
    864866mkSub = MkCode 
    865867    { isMulti = False 
    866     , subName = "" 
     868    , subName = cast "&" 
    867869    , subType = SubBlock 
    868870    , subEnv = Nothing 
    … …  
    922924    | NonTerm !Pos                      -- ^ Parse error 
    923925    deriving (Show, Eq, Ord, Typeable) {-!derive: YAML_Pos!-} 
     926 
     927_Sym :: Scope -> String -> Exp -> Exp 
     928_Sym scope str exp = Sym scope (cast str) exp 
     929 
     930_Var :: String -> Exp 
     931_Var str = Var (cast str) 
    924932 
    925933instance Value Exp where 
    … …  
    988996    compare _ _ = EQ 
    989997 
    990 extractPlaceholderVarsExp :: Exp -> ([Exp], [String]) -> ([Exp], [String]) 
     998extractPlaceholderVarsExp :: Exp -> ([Exp], [Var]) -> ([Exp], [Var]) 
    991999extractPlaceholderVarsExp ex (exps, vs) = (ex':exps, vs') 
    9921000    where 
    … …  
    9941002 
    9951003{-| Deduce the placeholder vars ($^a, $^x etc.) used by a block). -} 
    996 extractPlaceholderVars :: Exp -> [String] -> (Exp, [String]) 
     1004extractPlaceholderVars :: Exp -> [Var] -> (Exp, [Var]) 
    9971005extractPlaceholderVars (App n invs args) vs = (App n' invs' args', vs''') 
    9981006    where 
    … …  
    10081016    (exps', vs') = foldr extractPlaceholderVarsExp ([], vs) exps 
    10091017    vs'' = case n of 
    1010         "when"  -> nub $ vs' ++ ["$_"] 
    1011         "given" -> delete "$_" vs' 
     1018        "when"  -> nub (cast "$_" : vs') 
     1019        "given" -> delete (cast "$_") vs' 
    10121020        _       -> vs' 
    1013 extractPlaceholderVars (Var name) vs 
    1014     | (sigil:'^':identifer) <- name 
    1015     , name' <- (sigil : identifer) 
    1016     = (Var name', nub (name':vs)) 
    1017     | name == "$_" 
    1018     = (Var name, nub (name:vs)) 
     1021extractPlaceholderVars (Var var) vs 
     1022    | TImplicit <- v_twigil var 
     1023    , var' <- var{ v_twigil = TNone } 
     1024    = (Var var', nub (var':vs)) 
     1025    | var == cast "$_" 
     1026    = (Var var, nub (var:vs)) 
    10191027    | otherwise 
    1020     = (Var name, vs) 
     1028    = (Var var, vs) 
    10211029extractPlaceholderVars (Ann ann ex) vs = ((Ann ann ex'), vs') 
    10221030    where 
    … …  
    10421050    , isWritable    = (name == "$_") 
    10431051    , isLazy        = False 
    1044     , paramName     = name 
     1052    , paramName     = cast name 
    10451053    , paramContext  = if '*' `elem` sigil 
    10461054        then CxtSlurpy typ' 
    … …  
    10571065defaultArrayParam   = buildParam "" "*" "@_" (Val VUndef) 
    10581066defaultHashParam    = buildParam "" "*" "%_" (Val VUndef) 
    1059 defaultScalarParam  = buildParam "" "?" "$_" (Var "$_") 
    1060  
    1061 type DebugInfo = Maybe (TVar (Map String String)) 
     1067defaultScalarParam  = buildParam "" "?" "$_" (Var $ cast "$_") 
     1068 
     1069type DebugInfo = Maybe (TVar (Map ID String)) 
    10621070 
    10631071{-| 
    … …  
    10751083    , envImplicit:: !(Map Var ())        -- ^ Set of implicit variables 
    10761084    , envGlobal  :: !(TVar Pad)          -- ^ Global pad for variable lookup 
    1077     , envPackage :: !String              -- ^ Current package 
     1085    , envPackage :: !Pkg                 -- ^ Current package 
    10781086    , envClasses :: !ClassTree           -- ^ Current class tree 
    10791087    , envEval    :: !(Exp -> Eval Val)   -- ^ Active evaluator 
    … …  
    11551163            if isFresh then do { writeTVar fresh False; return orig } else do 
    11561164            -- regen TVar -- this is not the first time entering this scope 
    1157             ref <- newObject (typeOfSigil $ head name) 
     1165            ref <- newObject (typeOfSigilVar name) 
    11581166            tvar' <- newTVar ref 
    11591167            return (fresh, tvar') 
    … …  
    11861194    show pad = "MkPad (padToList " ++ show (padToList pad) ++ ")" 
    11871195 
    1188 findSymRef :: String -> Pad -> Eval VRef 
     1196findSymRef :: Var -> Pad -> Eval VRef 
    11891197findSymRef name pad = do 
    11901198    case findSym name pad of 
    … …  
    11921200        Nothing  -> fail $ "Cannot find variable: " ++ show name 
    11931201 
    1194 findSym :: String -> Pad -> Maybe (TVar VRef) 
     1202findSym :: Var -> Pad -> Maybe (TVar VRef) 
    11951203findSym name pad = case lookupPad name pad of 
    11961204    Just (x:_)  -> Just x 
    … …  
    12101218 
    12111219lookupPad key (MkPad map) = case Map.lookup (possiblyFixOperatorName key) map of 
    1212         Just (MkEntryMulti xs)   -> Just [tvar | (_, tvar) <- xs] 
    1213         Just (MkEntry (_, tvar)) -> Just [tvar] 
    1214         Nothing -> Nothing 
     1220    Just (MkEntryMulti xs)   -> Just [tvar | (_, tvar) <- xs] 
     1221    Just (MkEntry (_, tvar)) -> Just [tvar] 
     1222    Nothing -> Nothing 
    12151223 
    12161224{-| 
    … …  
    12201228-} 
    12211229padToList :: Pad -> [(Var, [(TVar Bool, TVar VRef)])] 
    1222 padToList (MkPad map) = (Map.assocs . Map.map entryToList) map 
     1230padToList (MkPad map) = [ (cast k, entryToList v) | (k, v) <- Map.assocs map ] 
    12231231    where 
    12241232    entryToList (MkEntry x)         = [x] 
    … …  
    12261234 
    12271235listToPad :: [(Var, [(TVar Bool, TVar VRef)])] -> Pad 
    1228 listToPad = MkPad . Map.map listToEntry . Map.fromList 
     1236listToPad entries = MkPad (Map.fromList [ (cast k, listToEntry v) | (k, v) <- entries ]) 
    12291237    where 
    12301238    listToEntry [x] = MkEntry x 
    … …  
    12741282 
    12751283readVar :: Var -> Eval Val 
    1276 readVar name@(_:'*':_) = do 
    1277     glob <- askGlobal 
    1278     case findSym name glob of 
    1279         Just tvar -> do 
    1280             ref <- liftSTM $ readTVar tvar 
    1281             readRef ref 
    1282         _        -> return undef 
    1283 readVar name@(sigil:rest) = do 
    1284     lex <- asks envLexical 
    1285     case findSym name lex of 
    1286         Just tvar -> do 
    1287             ref <- liftSTM $ readTVar tvar 
    1288             readRef ref 
    1289         _  -> readVar (sigil:'*':rest) 
    1290 readVar _ = return undef 
     1284readVar var 
     1285    | isGlobalVar var = do 
     1286        glob <- askGlobal 
     1287        case findSym var glob of 
     1288            Just tvar -> do 
     1289                ref <- liftSTM $ readTVar tvar 
     1290                readRef ref 
     1291            _        -> return undef 
     1292    | otherwise = do 
     1293        lex <- asks envLexical 
     1294        case findSym var lex of 
     1295            Just tvar -> do 
     1296                ref <- liftSTM $ readTVar tvar 
     1297                readRef ref 
     1298            -- XXX - fallback to global should be eliminated here 
     1299            _  -> readVar (toGlobalVar var) 
    12911300 
    12921301{-| 
    … …  
    16731682        , envLValue  = False 
    16741683        , envGlobal  = glob 
    1675         , envPackage = "main" 
     1684        , envPackage = cast "Main" 
    16761685        , envClasses = initTree 
    16771686        , envEval    = const (return VUndef) 
    … …  
    17041713    asYAML x = asYAMLmap "Map" $ Map.toAscList (Map.map asYAML x) 
    17051714    fromYAML node = fmap Map.fromList (fromYAMLmap node) 
     1715instance YAML a => YAML (Map Var a) where 
     1716    asYAML x = asYAMLmap "Map" . sortBy (\x y -> fst x `compare` fst y) $ 
     1717        [ (cast k, asYAML v) | (k, v) <- Map.toList x ] 
     1718    fromYAML node = do 
     1719        list <- fromYAMLmap node 
     1720        fmap Map.fromList . forM list $ \(k, v) -> do 
     1721            return (cast k, v) 
    17061722instance Typeable a => YAML (IVar a) where 
    17071723    asYAML x = asYAML (MkRef x) 
    … …  
    17671783    showJSON x = showJSON (cast x :: ByteString) 
    17681784 
     1785instance YAML Var where 
     1786    asYAML x = asYAML (cast x :: String) 
     1787    fromYAML = fmap (cast :: String -> Var) . fromYAML 
     1788  
     1789instance Perl5 Var where 
     1790    showPerl5 x = showPerl5 (cast x :: String) 
     1791instance JSON Var where 
     1792    showJSON x = showJSON (cast x :: String) 
     1793 
    17691794instance YAML VControl 
    17701795instance YAML (Set Val) 
    … …  
    18361861    {-!derive: YAML_Pos, JSON, Perl5!-} 
    18371862 
    1838 data Pad = MkPad { padEntries :: Map Var PadEntry } 
     1863data Pad = MkPad { padEntries :: IntMap PadEntry } 
    18391864    {-!derive: YAML_Pos!-} 
    18401865 

  • src/Pugs/AST/Internals.hs-boot

    r12173 r12317  
    66import Pugs.AST.Pos 
    77import Pugs.AST.SIO 
    8 import Pugs.Cont hiding (shiftT, resetT) 
    98import Control.Concurrent.STM 
    109import Data.Dynamic 

  • src/Pugs/AST/Internals/Instances.hs