Changeset 15710 for src/Pugs/Eval.hs

Timestamp:

03/14/07 16:33:44 (21 months ago)

Author:

audreyt

Message:

* Chase "is context" pad structure changes in other modules.

This concludes the contextual-declarations batch.

Files:

• src/Pugs/Eval.hs (modified) (6 diffs)

src/Pugs/Eval.hs

@@ -246 +246 @@
 reduce (Pad scope lexEnv exp) = reducePad scope lexEnv exp
 
-reduce (Sym scope name init exp) = reduceSym scope name init exp
+reduce (Sym scope name flags init rest) = reduceSym scope name flags init rest
 
 -- Reduction for no-operations
@@ -289 +289 @@
                     -- '$Qualified::Var' is not found.  Vivify at lvalue context.
                     lv <- asks envLValue
-                    if not lv then retEmpty else evalExp (Sym SOur var Noop (Var var))
+                    if not lv then retEmpty else evalExp (Sym SOur var mempty Noop (Var var))
                 | otherwise -> do
                     s <- isStrict
                     if s then do die "Undeclared variable" var
                          else do lv <- asks envLValue
-                                 if lv then evalExp (Sym SOur var Noop (Var var)) else retEmpty
+                                 if lv then evalExp (Sym SOur var mempty Noop (Var var)) else retEmpty
 
 _scalarContext :: Cxt
@@ -344 +344 @@
 
 reducePad :: Scope -> Pad -> Exp -> Eval Val
-{-
-reducePad SEnv lex@(MkPad lex') exp = do
-    local (\e -> e{ envImplicit = Map.map (const ()) lex' `Map.union` envImplicit e }) $
-        reducePad SMy lex exp
--}
-reducePad SMy lex exp = do
+reducePad scope lex exp = do
     -- heuristics: if we are repeating ourselves, generate a new TVar.
-    lex' <- refreshPad lex
-    local (\e -> e{ envLexical = lex' `unionPads` envLexical e }) $ do
-        evalExp exp
+    lex' <- case scope of
+        SMy -> refreshPad lex
+        _   -> return lex
+    let implicits = Map.map (const ()) . Map.filter (ef_isContext . pe_flags) $ padEntries lex'
+    local (\e -> e
+        { envLexical    = lex' `unionPads` envLexical e
+        , envImplicit   = implicits `Map.union` envImplicit e
+        }) $ evalExp exp
 
 {-
@@ -387 +387 @@
 -}
 
-reducePad _ lex exp = do
-    local (\e -> e{ envLexical = lex `unionPads` envLexical e }) $ do
-        evalExp exp
-        
-reduceSym :: Scope -> Var -> Exp -> Exp -> Eval Val
-reduceSym scope var init exp
+reduceSym :: Scope -> Var -> EntryFlags -> Exp -> Exp -> Eval Val
+reduceSym scope var flags init rest
     | not (isLexicalVar var) = do
         qn  <- toQualified var
         ref <- createRef
-        sym <- genSymScoped scope qn ref
+        sym <- genSymScoped scope qn ref flags
         addGlobalSym sym
-        evalExp exp
+        evalExp rest
     | SOur <- scope = do
         ref     <- createRef
-        entry   <- genPadEntryScoped scope ref
+        entry   <- genPadEntryScoped scope ref flags
         qn      <- toQualified var
         addGlobalSym (mkPadMutator qn entry ref)
-        enterLex [ mkPadMutator var entry ref ] $ evalExp exp
+        enterLex [ mkPadMutator var entry ref ] $ evalExp rest
     | otherwise = do
         ref <- createRef
-        sym <- genSymScoped scope var ref
-        enterLex [ sym ] $ evalExp exp
+        sym <- genSymScoped scope var ref flags
+        enterLex [ sym ] $ evalExp rest
     where
     createRef | Noop <- init = newObject (typeOfSigilVar var)
@@ -488 +484 @@
                 _           -> regenerateContent
             return (var, entry')
-    clonePadEntry x@EntryConstant{} _ = return x
-    clonePadEntry x@EntryStatic{} f = do
+    clonePadEntry x@PEConstant{} _ = return x
+    clonePadEntry x@PEStatic{} f = do
         tvar'   <- newTVar =<< f x
         return x{ pe_store = tvar' }
-    clonePadEntry x@EntryLexical{} f = do
+    clonePadEntry x@PELexical{} f = do
         tvar'   <- newTVar =<< f x
         fresh'  <- newTVar False
@@ -673 +669 @@
                 _ | isGlobalVar var || v_package var `notElem` [emptyPkg, callerPkg, outerPkg, contextPkg] -> do
                     -- '$Qualified::Var' is not found.  Vivify at lvalue context.
-                    evalExp (Sym SOur var Noop Noop)
+                    evalExp (Sym SOur var mempty Noop Noop)
                     rv' <- findVarRef var
                     case rv' of
-                        Just EntryConstant{}    -> die "Bind to constant variable" var
+                        Just PEConstant{}    -> die "Bind to constant variable" var
                         Just entry              -> return (entry, ref)
                         _                       -> die "Bind to undeclared variable" var