From 7848936cc460da48173bee59ff8b882be3dacd0e Mon Sep 17 00:00:00 2001 From: Marc Sunet Date: Thu, 9 Aug 2012 11:37:59 +0200 Subject: Added bulk updates to Store --- Spear.lkshs | 10 +++--- Spear/Sys/Store.hs | 98 +++++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 84 insertions(+), 24 deletions(-) diff --git a/Spear.lkshs b/Spear.lkshs index 042ccc8..3f28583 100644 --- a/Spear.lkshs +++ b/Spear.lkshs @@ -1,17 +1,17 @@ Version of session file format: 1 Time of storage: - "Wed Aug 8 20:32:17 CEST 2012" -Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 4, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 267) 200)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 702) 954 -Population: [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameObject.hs" 8164)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 670)),[SplitP LeftP]),(Just (InfoSt (InfoState (Just (Real (RealDescr {dscName' = "UpdateGO", dscMbTypeStr' = Just "type UpdateGO =\n Bool -> Input -> Float -> State [GameMessage] GameObject", dscMbModu' = Just (PM {pack = PackageIdentifier {pkgName = PackageName "simple-scene", pkgVersion = Version {versionBranch = [0,1,0,0], versionTags = []}}, modu = ModuleName ["GameObject"]}), dscMbLocation' = Just (Location {locationSLine = 43, locationSCol = 1, locationELine = 43, locationECol = 73}), dscMbComment' = Nothing, dscTypeHint' = TypeDescr, dscExported' = False}))))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Just (ModuleName ["Spear","IDStore"]),Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([[5]],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics.hs" 207)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/Rigid.hs" 2175)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/World.hs" 1269)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 1294)),[SplitP LeftP])] + "Thu Aug 9 11:37:44 CEST 2012" +Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 5, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 279) 208)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 732) 954 +Population: [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameObject.hs" 259)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 670)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Sys/Store/ID.hs" 96)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([[5]],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics.hs" 207)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/Rigid.hs" 2175)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Sys/Store.hs" 2183)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/World.hs" 1269)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 204)),[SplitP LeftP])] Window size: (1841,964) Completion size: (750,400) Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" -Active pane: Just "Modules" +Active pane: Just "Store.hs" Toolbar visible: True -FindbarState: (False,FindState {entryStr = "asd", entryHist = ["Triangle","transforma","gravity","asdad","rotSpeed","azimuth","mandatory","mandao","col","forward","MouseButton"], replaceStr = "CTriangle", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) +FindbarState: (False,FindState {entryStr = "asda", entryHist = ["assigned","Triangle","transforma","gravity","asdad","rotSpeed","azimuth","mandatory","mandao","col","forward","MouseButton"], replaceStr = "objects", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) Recently opened files: ["/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc","/home/jeanne/programming/haskell/Spear/Spear/Math/Spatial.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Triangle.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/Triangle.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c","/home/jeanne/programming/haskell/Spear/Spear/Scene/Loader.hs","/home/jeanne/programming/haskell/Spear/Spear/IDStore.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Spear/IDStore.hs","/home/jeanne/programming/haskell/Spear/Spear/Physics/Types.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collisioner.hs"] Recently opened workspaces: diff --git a/Spear/Sys/Store.hs b/Spear/Sys/Store.hs index 3d5d794..65381ca 100644 --- a/Spear/Sys/Store.hs +++ b/Spear/Sys/Store.hs @@ -4,12 +4,15 @@ module Spear.Sys.Store , Index , emptyStore , store +, storel , storeFree +, storeFreel , element ) where +import Data.List as L (find) import Data.Maybe (isJust, isNothing) import Data.Vector as V import Control.Monad.State -- test @@ -20,8 +23,8 @@ type Index = Int data Store a = Store - { assigned :: Vector (Maybe a) -- ^ An array of objects. - , last :: Index -- ^ The greatest index assigned so far. + { objects :: Vector (Maybe a) -- ^ An array of objects. + , last :: Index -- ^ The greatest index assigned so far. } deriving Show @@ -33,32 +36,76 @@ emptyStore = Store V.empty (-1) -- | Store the given element in the store. store :: a -> Store a -> (Index, Store a) -store elem s@(Store assigned last) = - if last == V.length assigned - 1 - then case findIndex isNothing assigned of +store elem s@(Store objects last) = + if last == V.length objects - 1 + then case findIndex isNothing objects of Just i -> assign i elem s - Nothing -> store elem $ Store (assigned V.++ V.replicate (max 1 last + 1) Nothing) last + Nothing -> store elem $ Store (objects V.++ V.replicate (max 1 last + 1) Nothing) last else assign (last+1) elem s -- Assign a slot the given element in the store. assign :: Index -> a -> Store a -> (Index, Store a) -assign i elem (Store assigned last) = - let assigned' = assigned // [(i,Just elem)] - in (i, Store assigned' (max last i)) - - --- | Free the given element from the store. +assign i elem (Store objects last) = + let objects' = objects // [(i,Just elem)] + in (i, Store objects' (max last i)) + + +-- | Store the given elements in the store. +storel :: [a] -> Store a -> ([Index], Store a) +storel elems s@(Store objects last) = + let n = Prelude.length elems + (count, slots) = freeSlots objects + in + let -- place count elements in free slots. + (is, s'') = storeInSlots slots (Prelude.take count elems) s + + -- append the remaining elements + (is', s') = append (Prelude.drop count elems) s'' + in + (is Prelude.++ is', s') + + +-- Count and return the free slots. +freeSlots :: Vector (Maybe a) -> (Int, Vector Int) +freeSlots v = let is = findIndices isNothing v in (V.length is, is) + + +-- Store the given elements in the given slots. +-- Pre: valid indices. +storeInSlots :: Vector Int -> [a] -> Store a -> ([Index], Store a) +storeInSlots is elems (Store objects last) = + let objects' = V.update_ objects is (V.fromList $ fmap Just elems) + last' = let i = V.length is - 1 + in if i < 0 then last else max last $ is ! i + in + (V.toList is, Store objects' last') + + +-- Append the given elements to the last slot of the store, making space if necessary. +append :: [a] -> Store a -> ([Index], Store a) +append elems (Store objects last) = + let n = Prelude.length elems + indices = [last+1..last+n] + objects'' = if V.length objects <= last+n + then objects V.++ V.replicate n Nothing + else objects + objects' = objects'' // (Prelude.zipWith (,) indices (fmap Just elems)) + in + (indices, Store objects' $ last+n) + + +-- | Free the given slot. storeFree :: Index -> Store a -> Store a -storeFree i (Store assigned last) = - let assigned' = assigned // [(i,Nothing)] +storeFree i (Store objects last) = + let objects' = objects // [(i,Nothing)] in if i == last - then case findLastIndex isJust assigned' of - Just j -> Store assigned' j - Nothing -> Store assigned' 0 + then case findLastIndex isJust objects' of + Just j -> Store objects' j + Nothing -> Store objects' 0 else - Store assigned' last + Store objects' last findLastIndex :: (a -> Bool) -> Vector a -> Maybe Index @@ -70,9 +117,22 @@ findLastIndex p v = findLastIndex' p v Nothing 0 else findLastIndex' p v current (i+1) +-- | Free the given slots. +storeFreel :: [Index] -> Store a -> Store a +storeFreel is (Store objects last) = + let objects' = objects // Prelude.zipWith (,) is (repeat Nothing) + last' = case L.find (==last) is of + Nothing -> last + Just _ -> case findLastIndex isJust objects' of + Just j -> j + Nothing -> (-1) + in + Store objects' last' + + -- | Access the element in the given slot. element :: Index -> Store a -> Maybe a -element index (Store assigned _) = assigned V.! index +element index (Store objects _) = objects V.! index -- test -- cgit v1.2.3