Changeset 3443

Show
Ignore:
Timestamp:
05/19/05 17:57:17 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
5016
Message:

* We have OUTER:: scope now.
* Closure (VCode) now captures over the entire Env, instead

of just the envLexical slot. This is currently only used to

restore the original OUTER
scope when calling a subroutine, but once we switch to oleg's CC_2CPST for Eval monad, this will get us rubyish coroutines (and serialised subcontinuations) for free.
Location:
src/Pugs
Files:
4 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/AST/Internals.hs

    r3372 r3443  
    5454    retError, retControl, retEmpty, retIVar, readIVar, writeIVar, 
    5555    fromVals, refType, 
    56     mkPad, lookupPad, padToList, diffPads, unionPads, 
     56    mkPad, lookupPad, padToList, diffPads, unionPads, subPad, updateSubPad, 
    5757    mkPrim, mkSub, 
    5858    cxtOfSigil, typeOfSigil, 
    … …  
    679679    , subName       :: !String      -- ^ Name of the closure 
    680680    , subType       :: !SubType     -- ^ Type of the closure 
    681     , subPad        :: !Pad        -- ^ Lexical pad for sub\/method 
     681    , subEnv        :: !(Maybe Env) -- ^ Lexical pad for sub\/method 
    682682    , subAssoc      :: !String      -- ^ Associativity 
    683683    , subParams     :: !Params      -- ^ Parameters list 
    … …  
    700700    , subName = "&?" 
    701701    , subType = SubPrim 
    702     , subPad = mkPad [] 
     702    , subEnv = Nothing 
    703703    , subAssoc = "pre" 
    704704    , subParams = [] 
    … …  
    715715    , subName = "&?" 
    716716    , subType = SubBlock 
    717     , subPad = mkPad [] 
     717    , subEnv = Nothing 
    718718    , subAssoc = "pre" 
    719719    , subParams = [] 
    … …  
    913913    , envEval    :: !(Exp -> Eval Val)   -- ^ Active evaluator 
    914914    , envCaller  :: !(Maybe Env)         -- ^ Caller's env 
     915    , envOuter   :: !(Maybe Env)         -- ^ Outer block's env 
    915916    , envBody    :: !Exp                 -- ^ Current AST expression 
    916917    , envDepth   :: !Int                 -- ^ Recursion depth 
    … …  
    10031004unionPads :: Pad -> Pad -> Pad 
    10041005unionPads (MkPad map1) (MkPad map2) = MkPad $ Map.union map1 map2 
     1006 
     1007updateSubPad :: VCode -> (Pad -> Pad) -> VCode 
     1008updateSubPad sub f = sub 
     1009    { subEnv = fmap (\e -> e{ envLexical = f (subPad sub) }) (subEnv sub)  
     1010    } 
     1011 
     1012subPad :: VCode -> Pad 
     1013subPad sub = maybe (mkPad []) envLexical (subEnv sub) 
    10051014 
    10061015type Eval x = EvalT (ContT Val (ReaderT Env SIO)) x 

  • src/Pugs/Eval.hs

    r3417 r3443  
    7878            , envEval    = evaluate 
    7979            , envCaller  = Nothing 
     80            , envOuter   = Nothing 
    8081            , envDepth   = 0 
    8182            , envID      = uniq 
    … …  
    191192        maybeCaller <- asks envCaller 
    192193        case maybeCaller of 
    193             Just caller -> local (const caller) $ do 
     194            Just env -> local (const env) $ do 
    194195                findVarRef (sig ++ name') 
    195196            Nothing -> retError "cannot access CALLER:: in top level" name 
     197    | Just (package, name') <- breakOnGlue "::" name 
     198    , Just (sig, "") <- breakOnGlue "OUTER" package = do 
     199        maybeOuter <- asks envOuter 
     200        case maybeOuter of 
     201            Just env -> local (const env) $ do 
     202                findVarRef (sig ++ name') 
     203            Nothing -> retError "cannot access OUTER:: in top level" name 
    196204    | ('$':'?':_) <- name = do 
    197205        rv  <- getMagical name 
    … …  
    349357        let [exp] = exps 
    350358        (VCode sub) <- enterEvalContext (cxtItem "Code") exp 
    351         lex <- asks envLexical 
    352         retVal $ VCode sub{ subPad = lex } 
     359        env <- ask 
     360        retVal $ VCode sub{ subEnv = Just env } 
    353361    "if" -> doCond id  
    354362    "unless" -> doCond not 
    … …  
    370378                genSymCC "&next" $ \symNext -> do 
    371379                    genSymPrim "&redo" (const $ runBody vs sub') $ \symRedo -> do 
    372                         apply sub'{ subPad = symRedo . symNext $ subPad sub' } [] $ 
     380                        apply (updateSubPad sub' (symRedo . symNext)) [] $ 
    373381                            map (Val . VRef . MkRef) these 
    374382                runBody rest sub' 
    … …  
    376384            let munge sub | subParams sub == [defaultArrayParam] = 
    377385                    munge sub{ subParams = [defaultScalarParam] } 
    378                 munge sub = sub{ subPad = symLast $ subPad sub } 
     386                munge sub = updateSubPad sub symLast 
    379387            runBody elms $ munge sub 
    380388    "loop" -> do 

  • src/Pugs/Monads.hs

    r3291 r3443  
    147147    env <- ask 
    148148    exitRec <- genSubs env "&?BLOCK_EXIT" $ escSub esc 
    149     enterLex exitRec action 
     149    local (\e -> e{ envOuter = Just env }) $ enterLex exitRec action 
    150150    where 
    151151    escSub esc env = mkPrim 
    … …  
    176176            blockRec <- genSym "&?BLOCK" (codeRef (orig sub)) 
    177177            return $ \e -> e 
    178                 { envLexical = combine [blockRec] 
     178                { envOuter = Just env 
     179                , envLexical = combine [blockRec] 
    179180                    (subPad sub `unionPads` envLexical env) } 
    180181        | otherwise = do 
    … …  
    185186            callerRec <- genSubs env "&?CALLER_CONTINUATION" (ccSub cc) 
    186187            return $ \e -> e 
    187                 { envLexical = combine (concat [subRec, callerRec]) (subPad sub) } 
     188                { envLexical = combine (concat [subRec, callerRec]) (subPad sub) 
     189                , envOuter   = maybe Nothing envOuter (subEnv sub) 
     190                } 
    188191    ccSub cc env = mkPrim 
    189192        { subName = "CALLER_CONTINUATION" 

  • src/Pugs/Parser.hs

    r3437 r3443  
    331331            { isMulti       = isMulti 
    332332            , subName       = name' 
    333             , subPad        = envLexical env 
     333            , subEnv        = Just env 
    334334            , subType       = if isMethod then SubMethod else SubRoutine 
    335335            , subAssoc      = "pre" 
    … …  
    439439                    { isMulti       = False 
    440440                    , subName       = name 
    441                     , subPad        = mkPad [] -- XXX really? 
     441                    , subEnv        = Nothing 
    442442                    , subReturns    = if null typ then typeOfSigil sigil else mkType typ 
    443443                    , subBody       = fun 
    … …  
    761761    unless (isNothing formal || null names) $  
    762762        fail "Cannot mix placeholder variables with formal parameters" 
     763    env <- getState 
    763764    let sub = MkCode 
    764765            { isMulti       = False 
    765766            , subName       = "<anon>" 
    766             , subPad        = mkPad [] 
     767            , subEnv        = Just env 
    767768            , subType       = typ 
    768769            , subAssoc      = "pre"