Changeset 16344

Timestamp:

05/17/07 23:20:11 (18 months ago)

Author:

audreyt

Message:

* Finally, circular loading of TVars.

Files:

• src/DrIFT/YAML.hs (modified) (1 diff)
• src/Pugs/Eval.hs (modified) (2 diffs)
• src/Pugs/Monads.hs (modified) (1 diff)
• src/Pugs/Parser.hs (modified) (1 diff)
• src/Pugs/Parser/Util.hs (modified) (1 diff)
• src/Pugs/Prim.hs (modified) (1 diff)
• src/Pugs/Run.hs (modified) (1 diff)
• third-party/HsSyck/Data/Yaml/Syck.hsc (modified) (5 diffs)

src/DrIFT/YAML.hs

@@ -253 +253 @@
     fromYAMLElem = (newTVarIO =<<) . fromYAMLElem
 
+
 asYAMLanchor :: a -> EmitAs YamlNode -> EmitAs YamlNode
 asYAMLanchor x m = do

src/Pugs/Eval.hs

@@ -274 +274 @@
 reduceVar var@MkVar{ v_sigil = sig, v_twigil = twi, v_name = name, v_package = pkg }
     | TAttribute <- twi
-    = reduceSyn (show sig ++ "{}") [ Syn "{}" [_Var "&self", Val (VStr $ cast name)] ]
+    = reduceSyn (show sig ++ "{}") [ Syn "{}" [_Var "$__SELF__", Val (VStr $ cast name)] ]
     | TPrivate <- twi
-    = reduceSyn (show sig ++ "{}") [ Syn "{}" [_Var "&self", Val (VStr $ cast name)] ]
+    = reduceSyn (show sig ++ "{}") [ Syn "{}" [_Var "$__SELF__", Val (VStr $ cast name)] ]
     | otherwise = do
         v <- findVar var
@@ -1461 +1461 @@
     applyMacroResult VUndef         = retEmpty
     applyMacroResult _              = fail "Macro did not return an AST, a Str or a Code!"
-    fixSub MkCode{ subType = SubPrim } env = env
     fixSub sub env = env
         { -- envLexical = subPad sub -- XXX - fake in-pad knowledge?

src/Pugs/Monads.hs

@@ -232 +232 @@
         runBlocks (filter (rejectKeepUndo rv . subName) . subLeaveBlocks)
 
-        when (rv == VControl (ControlLoop LoopLast)) $
-            -- We won't have a chance to run the LAST block
-            -- once we exit outside the lexical block, so do it now
-            runBlocks subLastBlocks
-
-        assertBlocks subPostBlocks "POST"
-        case rv of
-            VControl l@(ControlLeave ftyp depth val) -> do
-                let depth' = if ftyp typ then depth - 1 else depth
-                if depth' < 0
-                    then return val
-                    else retControl l{ leaveDepth = depth' }
-            VControl ControlExit{}  -> retShift rv
-            VError{}                -> do
-                -- XXX - Implement CATCH block here
-                retShift rv
-            _ -> return rv
+    when (rv == VControl (ControlLoop LoopLast)) $
+        -- We won't have a chance to run the LAST block
+        -- once we exit outside the lexical block, so do it now
+        runBlocks subLastBlocks
+
+    assertBlocks subPostBlocks "POST"
+    case rv of
+        VControl l@(ControlLeave ftyp depth val) -> do
+            let depth' = if ftyp typ then depth - 1 else depth
+            if depth' < 0
+                then return val
+                else retControl l{ leaveDepth = depth' }
+        VControl ControlExit{}  -> retShift rv
+        VError{}                -> do
+            -- XXX - Implement CATCH block here
+            retShift rv
+        _ -> return rv
     where
     rejectKeepUndo VUndef     = (/= __"KEEP")

src/Pugs/Parser.hs

@@ -2067 +2067 @@
             let methName = ('&':cast (v_name var))
             postApp <- ruleInvocationArguments Nothing methName False
-            return $ Syn (shows (v_sigil var) "{}") [postApp (_Var "&self")]
+            return $ Syn (shows (v_sigil var) "{}") [postApp (_Var "$__SELF__")]
         _   -> return exp
 

src/Pugs/Parser/Util.hs

@@ -189 +189 @@
     , isWritable    = True
     , isLazy        = False
-    , paramName     = cast "&self"
+    , paramName     = cast "$__SELF__"
     , paramContext  = CxtItem typ
     , paramDefault  = Noop

src/Pugs/Prim.hs

@@ -88 +88 @@
     return $ VStr tmp
 op0 "Pugs::Internals::pi" = const $ return $ VNum pi
-op0 "self"    = const $ expToEvalVal (_Var "&self")
+op0 "self"    = const $ expToEvalVal (_Var "$__SELF__")
 op0 "say"     = const $ op1 "IO::say" (VHandle stdout)
 op0 "print"   = const $ op1 "IO::print" (VHandle stdout)

src/Pugs/Run.hs

@@ -277 +277 @@
         -- print "Loading yaml..."
         --(glob, ast) <- fromYAML yml
+        cleanSeen
         MkCompUnit _ glob ast <- io $ fromYAML yml
         -- print "Loading done!"
+        z   <- stm $ join (findSym (cast "&*__fail") glob)
+        -- j   <- showYaml z
+        -- print j
         stm $ modifyTVar (envGlobal env) (`unionPads` glob)
         runEnv env{ envBody = ast, envDebug = Nothing }

third-party/HsSyck/Data/Yaml/Syck.hsc

@@ -71 +71 @@
     deriving (Show, Ord, Eq, Enum)
 
+maxId :: SYMID
+maxId = maxBound
+
 nilNode :: YamlNode
-nilNode = MkNode 0 ENil Nothing ASingleton
+nilNode = MkNode maxId ENil Nothing ASingleton
 
 {-# INLINE unpackBuf #-}
@@ -87 +90 @@
 
 mkNode :: YamlElem -> YamlNode
-mkNode x = MkNode 0 x Nothing ASingleton
+mkNode x = MkNode maxId x Nothing ASingleton
 
 mkTagNode :: String -> YamlElem -> YamlNode
-mkTagNode tag e = MkNode 0 e (Just $! packBuf tag) ASingleton
+mkTagNode tag e = MkNode maxId e (Just $! packBuf tag) ASingleton
 
 mkTagStrNode :: String -> String -> YamlNode
@@ -185 +188 @@
 emitNode freeze e n | ESeq sq <- n_elem n = do
     withTag n (Ptr "array"##) $ \tag ->
-        syck_emit_seq e tag seqInline
+--      syck_emit_seq e tag seqInline
+        syck_emit_seq e tag seqNone
     mapM_ (syck_emit_item e) =<< mapM freeze sq
     syck_emit_end e
@@ -191 +195 @@
 emitNode freeze e n | EMap m <- n_elem n = do
     withTag n (Ptr "map"##) $ \tag ->
-        syck_emit_map e tag mapInline
+--      syck_emit_map e tag mapInline
+        syck_emit_map e tag mapNone
     flip mapM_ m (\(k,v) -> do
         syck_emit_item e =<< freeze k
@@ -262 +267 @@
 
     return (fromIntegral symId)
+
+    return symId
 
 badAnchorHandlerCallback :: BadAnchorTable -> SyckBadAnchorHandler