Changeset 16333

Timestamp:

05/17/07 23:13:29 (18 months ago)

Author:

audreyt

Message:

* More pad refactoring.

Location:

src/Pugs

Files:

• AST/Internals.hs (modified) (3 diffs)
• AST/Internals/Instances.hs (modified) (2 diffs)
• AST/Pad.hs (modified) (1 diff)
• Parser.hs (modified) (1 diff)

src/Pugs/AST/Internals.hs

@@ -17 +17 @@
     SlurpLimit, -- VInt, Exp
     
+    emptyPad,
+
     VRef(..), -- uses IVar
     VOpaque(..), -- uses Value
@@ -1042 +1044 @@
     , subBody           :: !Exp         -- ^ Body of the closure
     , subCont           :: !(Maybe (TVar VThunk)) -- ^ Coroutine re-entry point
+    , subStarted        :: !(Maybe (TVar Bool))   -- ^ Whether START was run
     , subTraitBlocks    :: !TraitBlocks
     }
@@ -1411 +1414 @@
 newtype Pad = MkPad { padEntries :: Map Var PadEntry }
     deriving (Eq, Ord, Typeable)
+
+{-|
+An empty Pad with no symbols.
+-}
+
+emptyPad :: Pad
+emptyPad = MkPad Map.empty
 
 newtype EntryFlags = MkEntryFlags { ef_isContext :: Bool }

src/Pugs/AST/Internals/Instances.hs

@@ -513 +513 @@
     fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
         "MkCode" -> do
-            let liftM13 f m1 m2 m3 m4 m5 m6 m7 m8 m9 m10 m11 m12 m13 = do
-                {x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7; x8 <- m8; x9 <- m9; x10 <- m10; x11 <- m11; x12 <- m12; x13 <- m13; return (f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13)}
-            let ESeq [aa, ab, ac, ad, ae, af, ag, ah, ai, aj, ak, al, am] = e
-            liftM13 MkCode (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae) (fromYAML af) (fromYAML ag) (fromYAML ah) (fromYAML ai) (fromYAML aj) (fromYAML ak) (fromYAML al) (fromYAML am)
+            let liftM16 f m1 m2 m3 m4 m5 m6 m7 m8 m9 m10 m11 m12 m13 m14 m15 m16 = do
+                {x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7; x8 <- m8; x9 <- m9; x10 <- m10; x11 <- m11; x12 <- m12; x13 <- m13; x14 <- m14; x15 <- m15; x16 <- m16; return (f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16)}
+            let ESeq [aa, ab, ac, ad, ae, af, ag, ah, ai, aj, ak, al, am, an, ao, ap] = e
+            liftM16 MkCode (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae) (fromYAML af) (fromYAML ag) (fromYAML ah) (fromYAML ai) (fromYAML aj) (fromYAML ak) (fromYAML al) (fromYAML am) (fromYAML an) (fromYAML ao) (fromYAML ap)
         _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkCode"] ++ " in node " ++ show e
     fromYAML _ = fail "no tag found"
-    asYAML (MkCode aa ab ac ad ae af ag ah ai aj ak al am) =
+    asYAML (MkCode aa ab ac ad ae af ag ah ai aj ak al am an ao ap) =
            asYAMLseq "MkCode"
            [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae, asYAML af,
             asYAML ag, asYAML ah, asYAML ai, asYAML aj, asYAML ak, asYAML al,
-            asYAML am]
+            asYAML am, asYAML an, asYAML ao, asYAML ap]
 
 instance YAML TraitBlocks where
@@ -609 +609 @@
     asYAML (NonTerm aa) = asYAMLseq "NonTerm" [asYAML aa]
 
+instance YAML LexPads where
+    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
+        "PRuntime" -> do
+            let ESeq [aa] = e
+            liftM PRuntime (fromYAML aa)
+        "PCompiling" -> do
+            let ESeq [aa] = e
+            liftM PCompiling (fromYAML aa)
+        _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["PRuntime","PCompiling"] ++ " in node " ++ show e
+    fromYAML _ = fail "no tag found"
+    asYAML (PRuntime aa) = asYAMLseq "PRuntime" [asYAML aa]
+    asYAML (PCompiling aa) = asYAMLseq "PCompiling" [asYAML aa]
+
 instance YAML InitDat where
     fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of

src/Pugs/AST/Pad.hs

@@ -10 +10 @@
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+
+instance Monoid Pad where
+    mempty  = emptyPad
+    mappend = unionPads
+    mconcat = MkPad . Map.unionsWith mergePadEntry . map padEntries
 
 {-|

src/Pugs/Parser.hs

@@ -1273 +1273 @@
             , subBody       = fun
             , subCont       = Nothing
+            , subTraitBlocks= bi_traits block emptyTraitBlocks
             }
     return (Syn "sub" [Val $ VCode sub])