Changeset 15745

Timestamp:

03/17/07 11:10:25 (20 months ago)

Author:

audreyt

Message:

* Chase the TraitBlocks? change.

Location:

src/Pugs

Files:

• AST.hs (modified) (1 diff)
• Compile/Pugs.hs (modified) (1 diff)
• Eval.hs (modified) (1 diff)
• Monads.hs (modified) (1 diff)
• Parser.hs (modified) (1 diff)
• Parser/Types.hs (modified) (1 diff)

src/Pugs/AST.hs

@@ -392 +392 @@
             xs  -> die ("Cannot coerce to " ++ name) xs
     , subCont          = Nothing
-    , subPreBlocks     = []
-    , subPostBlocks    = []
-    , subFirstBlocks   = []
-    , subLastBlocks    = []
-    , subNextBlocks    = []
-    , subKeepBlocks    = []
-    , subUndoBlocks    = []
-    , subEnterBlocks   = []
-    , subLeaveBlocks   = []
-    , subControlBlocks = []
-    , subCatchBlocks   = []
+    , subTraitBlocks   = emptyTraitBlocks
     }
     where

src/Pugs/Compile/Pugs.hs

@@ -181 +181 @@
     compile MkCode{ subBody = Prim _ } = return Str.empty
     -- XXX - Ew. This signature can't be right.
-    compile (MkCode v1 v2 v3 _ v4 v5 v6 v7 v8 v9 v10 _ _ _ _ _ _ _ _ _ _ _ _) = do 
+    compile (MkCode v1 v2 v3 _ v4 v5 v6 v7 v8 v9 v10 _ _) = do
         compWith "MkCode"
             [ compile v1

src/Pugs/Eval.hs

@@ -1528 +1528 @@
     f' v'
 
-afterLeave :: VCode -> (VCode -> [VCode]) -> VCode
+afterLeave :: VCode -> (TraitBlocks -> [VCode]) -> VCode
 afterLeave code@MkCode{ subBody = Syn "block" [Val (VCode code')] } f =
     code{ subBody = Syn "block" [Val (VCode (afterLeave code' f))] }
-afterLeave code f = code{ subLeaveBlocks = subLeaveBlocks code ++ f code }
-
-beforeLeave :: VCode -> (VCode -> [VCode]) -> VCode
+afterLeave code@MkCode{ subTraitBlocks = blocks } f = code{ subTraitBlocks = blocks{ subLeaveBlocks = subLeaveBlocks blocks ++ f blocks } }
+
+beforeLeave :: VCode -> (TraitBlocks -> [VCode]) -> VCode
 beforeLeave code@MkCode{ subBody = Syn "block" [Val (VCode code')] } f =
     code{ subBody = Syn "block" [Val (VCode (afterLeave code' f))] }
-beforeLeave code f = code{ subLeaveBlocks = f code ++ subLeaveBlocks code }
-
-beforeEnter :: VCode -> (VCode -> [VCode]) -> VCode
+beforeLeave code@MkCode{ subTraitBlocks = blocks } f = code{ subTraitBlocks = blocks{ subLeaveBlocks = f blocks ++ subLeaveBlocks blocks } }
+
+beforeEnter :: VCode -> (TraitBlocks -> [VCode]) -> VCode
 beforeEnter code@MkCode{ subBody = Syn "block" [Val (VCode code')] } f =
     code{ subBody = Syn "block" [Val (VCode (beforeEnter code' f))] }
-beforeEnter code f = code{ subEnterBlocks = f code ++ subEnterBlocks code }
+beforeEnter code@MkCode{ subTraitBlocks = blocks } f = code{ subTraitBlocks = blocks{ subEnterBlocks = f blocks ++ subEnterBlocks blocks } }
 
 fromCodeExp :: Exp -> Eval VCode

src/Pugs/Monads.hs

@@ -257 +257 @@
         runBlocks subEnterBlocks
         action
-    runBlocks f = mapM_ (evalExp . Syn "block" . (:[]) . Syn "sub" . (:[]) . Val . castV) (f sub)
-    assertBlocks f name = forM_ (f sub) $ \cv -> do
+    runBlocks f = mapM_ (evalExp . Syn "block" . (:[]) . Syn "sub" . (:[]) . Val . castV) (f (subTraitBlocks sub))
+    assertBlocks f name = forM_ (f (subTraitBlocks sub)) $ \cv -> do
         rv <- fromVal =<< (evalExp . Syn "block" . (:[]) . Syn "sub" . (:[]) . Val . castV $ cv)
         if rv then return () else die (name ++ " assertion failed") (subName sub)

src/Pugs/Parser.hs

@@ -1280 +1280 @@
     (withTraitBlocks:prevLevel) <- gets s_closureTraits
     modify $ \state -> state{ s_closureTraits = if null prevLevel then [id] else prevLevel }
-    return $ withTraitBlocks sub
+    return $ sub{ subTraitBlocks = withTraitBlocks (subTraitBlocks sub) }
 
 

src/Pugs/Parser/Types.hs

@@ -138 +138 @@
     , s_outerVars     :: Set Var        -- ^ OUTER symbols we remembers
                                        
-    , s_closureTraits :: [VCode -> VCode]
+    , s_closureTraits :: [TraitBlocks -> TraitBlocks]
                                        -- ^ Closure traits: head is this block, tail is all outer blocks
     }