Changeset 8603

Timestamp:

01/07/06 10:33:51 (3 years ago)

Author:

audreyt

Message:

* Refactoring Yaml code to use implicit parameters for gaal++.

Location:

src

Files:

• Data/Yaml/Syck.hsc (modified) (1 diff)
• Pugs/Prim/Yaml.hs (modified) (2 diffs)

src/Data/Yaml/Syck.hsc

@@ -90 +90 @@
 
 emitterCallback :: SyckEmitter -> Ptr () -> IO ()
-emitterCallback e vp = emitNode e =<< thawNode vp
+emitterCallback e vp = let ?e = e in emitNode =<< thawNode vp
     
-emitNode :: SyckEmitter -> YamlNode -> IO ()
-emitNode e YamlNil = do
-    -- syck_emit_scalar(e, "string", scalar_none, 0, 0, 0, "~", 1);
+emitNode :: (?e :: SyckEmitter) -> YamlNode -> IO ()
+emitNode YamlNil = do
     withCString "string" $ \string_literal ->       
         withCString "~" $ \cs ->       
-            syck_emit_scalar e string_literal scalarNone 0 0 0 cs 1
-
-emitNode e (YamlStr str) = do
-    -- return syck_emit_scalar(e, "string", scalar_none, 0, 0, 0, SvPVX(sv), SvCUR(sv));
+            syck_emit_scalar ?e string_literal scalarNone 0 0 0 cs 1
+
+emitNode (YamlStr str) = do
     withCString "string" $ \string_literal ->       
         withCString str $ \cs ->       
-            syck_emit_scalar e string_literal scalarNone 0 0 0 cs (toEnum $ length str)
-
-emitNode e (YamlSeq seq) = do
-    -- syck_emit_seq(e, "array", seq_none);
+            syck_emit_scalar ?e string_literal scalarNone 0 0 0 cs (toEnum $ length str)
+
+emitNode (YamlSeq seq) = do
     withCString "array" $ \array_literal ->
-        syck_emit_seq e array_literal seqNone
+        syck_emit_seq ?e array_literal seqNone
     -- TODO: fix pesky warning about "integer from pointer without a cast" here
-    mapM_ (syck_emit_item e) =<< (mapM freezeNode seq)
-    syck_emit_end e
-
-emitNode e (YamlMap tag m) = do
-    -- syck_emit_map(e, "hash", map_none);
-    trace ("hash<" ++ maybe "" id tag ++">: " ++ (show m)) $ return ()
+    mapM_ (syck_emit_item ?e) =<< (mapM freezeNode seq)
+    syck_emit_end ?e
+
+emitNode (YamlMap tag m) = do
+    -- trace ("hash<" ++ maybe "" id tag ++">: " ++ (show m)) $ return ()
     withCString (maybe "hash" id tag) $ \hash_literal -> do
-        syck_emit_map e hash_literal mapNone
-        when (isJust tag) (do {syck_emit_tag e hash_literal nullPtr ; return ()})
+        syck_emit_map ?e hash_literal mapNone
+        when (isJust tag) (do {syck_emit_tag ?e hash_literal nullPtr ; return ()})
     flip mapM_ m (\(k,v) -> do
-        syck_emit_item e =<< freezeNode k
-        syck_emit_item e =<< freezeNode v)
-    syck_emit_end e
+        syck_emit_item ?e =<< freezeNode k
+        syck_emit_item ?e =<< freezeNode v)
+    syck_emit_end ?e
 
 

src/Pugs/Prim/Yaml.hs

@@ -40 +40 @@
 
 dumpYaml :: Int -> Val -> Eval Val
-dumpYaml limit v = do
-    obj  <- toYaml limit v
+dumpYaml limit v = let ?d = limit in do
+    obj  <- toYaml v
     rv   <- liftIO (emitYaml obj)
     either (fail . ("YAML Emit Error: "++))
            (return . VStr) rv
 
-toYaml :: Int -> Val -> Eval YamlNode
-toYaml 0     _          = return $ YamlStr "<deep recursion>" -- fail? make this configurable?
-toYaml _     VUndef     = return YamlNil
-toYaml _     (VStr str) = return $ YamlStr (encodeUTF8 str)
-toYaml (d+1) v@(VRef r) = do
+toYaml :: (?d :: Int) => Val -> Eval YamlNode
+toYaml _ | ?d == 0  = return $ YamlStr "<deep recursion>" -- fail? make this configurable?
+toYaml VUndef       = return YamlNil
+toYaml (VStr str)   = return $ YamlStr (encodeUTF8 str)
+toYaml v@(VRef r)   = let ?d = pred ?d in do
     t  <- evalValType v
-    ifValTypeIsa v "Hash" (hashToYaml d r) $ do
+    ifValTypeIsa v "Hash" (hashToYaml r) $ do
         v'      <- readRef r
-        nodes   <- toYaml d v'
+        nodes   <- toYaml v'
         ifValTypeIsa v "Array" (return nodes) $ case v' of
             VObject _   -> return nodes
             _           -> return (YamlMap Nothing [(YamlStr "<ref>", nodes)])
-toYaml (d+1) (VList nodes) = do
-    fmap YamlSeq $ mapM (toYaml d) nodes
-toYaml (d+1) v@(VObject obj) = do
+toYaml (VList nodes) = let ?d = pred ?d in do
+    fmap YamlSeq $ mapM toYaml nodes
+toYaml v@(VObject obj) = let ?d = pred ?d in do
     -- ... dump the objAttrs
     -- XXX this needs fixing WRT demagicalized pairs:
@@ -66 +66 @@
     -- parens, which is, of course, wrong.
     hash    <- fromVal v :: Eval VHash
-    attrs   <- toYaml d $ VRef (hashRef hash)
+    attrs   <- toYaml $ VRef (hashRef hash)
     return $ addTag (Just $ "!pugs:object/" ++ showType (objType obj)) attrs
     where
     addTag _   (YamlMap (Just x) _) = error ("can't add tag: already tagged with" ++ x)
     addTag tag (YamlMap _        m) = YamlMap tag m
-toYaml _ v = (return . YamlStr . encodeUTF8 . pretty) v
+toYaml v = (return . YamlStr . encodeUTF8 . pretty) v
 
-hashToYaml :: Int -> VRef -> Eval YamlNode
-hashToYaml d (MkRef (IHash hv)) = do
+hashToYaml :: (?d :: Int) => VRef -> Eval YamlNode
+hashToYaml (MkRef (IHash hv)) = do
     h <- hash_fetch hv
     let assocs = Map.toList h
     yamlmap <- flip mapM assocs $ \(ka, va) -> do
-        ka' <- toYaml d $ VStr ka
-        va' <- toYaml d va
+        ka' <- toYaml $ VStr ka
+        va' <- toYaml va
         return (ka', va')
     return $ YamlMap Nothing yamlmap
-hashToYaml _ r = error ("unexpected node: " ++ show r)
+hashToYaml r = error ("unexpected node: " ++ show r)
    
 {-