Permalink
Browse files

Added support for ExportRef. Still need to communicate exportation to…

… the database, if we want to do it that way.

Code needs refactoring, it's getting pretty tightly coupled.
  • Loading branch information...
1 parent a351468 commit 346ced88d9b6a3f8c64699c7984948c6ccf24766 @luqui committed Nov 17, 2008
Showing with 43 additions and 6 deletions.
  1. +6 −1 Udon/DataDesc.hs
  2. +31 −4 Udon/Database.hs
  3. +5 −0 Udon/DynRef.hs
  4. +1 −1 Udon/Request.hs
View
@@ -70,7 +70,7 @@ sequ i pa j = DataDesc {
ref :: DataDesc a -> DataDesc (ExtRef a)
ref pa = DataDesc {
- ddDump = \(ExtRef h v) -> Dump (liftPut $ binHashPut h) $
+ ddDump = \(ExtRef h v) -> Dump (putHash h) $
case v of
Nothing -> []
Just x -> [(h, ddDump pa x)],
@@ -82,5 +82,10 @@ binary = DataDesc {
ddDump = \a -> Dump (liftPut $ put a) [],
ddRead = liftGet get }
+instance Data Hash where
+ desc = DataDesc {
+ ddDump = \h -> Dump (putHash h) [],
+ ddRead = getHash }
+
instance Data a => Data (ExtRef a) where
desc = ref desc
View
@@ -1,7 +1,9 @@
module Udon.Database
( Data(..)
, Database(..)
- , writeRoot
+ , writeData
+ , makeDynRef
+ , exportDyn
)
where
@@ -20,6 +22,18 @@ data Database m
, store :: Hash -> Blob -> m ()
}
+newtype ExportRef = ExportRef Hash
+ deriving (Eq, Ord)
+
+instance Show ExportRef where
+ show (ExportRef h) = "ExportRef \"" ++ showHash h ++ "\""
+
+instance Binary ExportRef where
+ put (ExportRef h) = binHashPut h
+ get = fmap ExportRef binHashGet
+
+
+
writeChunk :: (Monad m) => Database m -> Chunk -> m ()
writeChunk db chunk = store db (hashBlob enc) enc
where
@@ -39,7 +53,20 @@ writeDump db = \dump@(Dump rput _) -> do
store db hash (encode . snd . runChunkPut $ rput)
mapM_ (uncurry go) subs
-writeRoot :: (Monad m, Data a) => Database m -> DynType a -> ExtRef a -> m DynRef
-writeRoot db dyntype ref = do
- hash <- writeDump db $ ddDump desc ref
+writeData :: (Monad m, Data a) => Database m -> a -> m Hash
+writeData db x = writeDump db (ddDump desc x)
+
+-- Writes data in the extref to the database and returns the dynref.
+-- Could be done better, bundling unwritten data with the dynref, as
+-- is done with extref, but that has proven pretty tricky to do.
+makeDynRef :: (Monad m, Data a) => Database m -> DynType a -> ExtRef a -> m DynRef
+makeDynRef db dyntype ref = do
+ hash <- writeData db (unsafeExtRefValue ref)
return $ unsafeExtRefToDynRef dyntype ref
+
+exportDyn :: (Monad m) => Database m -> DynRef -> m ExportRef
+exportDyn db dynref = do
+ -- This should mark something "exported" in the database, perhaps,
+ -- so that it is treated as part of the root set for GC.
+ hash <- writeData db dynref
+ return (ExportRef hash)
View
@@ -7,6 +7,8 @@ where
import Data.Typeable
import Udon.Hash
import Udon.DataDesc
+import qualified Udon.DescCombinators as D
+import Udon.DescInstances ()
type TypeID = String
newtype DynType a = DynType TypeID
@@ -17,6 +19,9 @@ makeDynType = DynType . show . typeOf
data DynRef = DynRef TypeID Hash
+instance Data DynRef where
+ desc = D.wrap (uncurry DynRef, \(DynRef tid h) -> (tid,h)) desc
+
dynRefToExtRef :: DynType a -> DynRef -> Maybe (ExtRef a)
dynRefToExtRef (DynType tid) (DynRef tid' h)
| tid == tid' = Just $ unsafeMakeExtRef h Nothing
View
@@ -44,7 +44,7 @@ instance Monad (Request i o) where
Return x >>= f = f x
Request cs >>= f = Request (fmap (>>= f) cs)
-fapp x ff = ff <*> pure x
+fapp x = fmap ($ x)
request :: i -> Request i o o
request o = Request (ReqList [(o, Return)])

0 comments on commit 346ced8

Please sign in to comment.