From 3a3bcf15b16a96443085d42583ce5d2a2f41148c Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 13 Sep 2024 19:36:59 +0300 Subject: [PATCH 01/54] Add Node and Port types with related functions and data --- lamagraph-core/src/Core/Node.hs | 93 +++++++++++++++++++++++++++++++++ 1 file changed, 93 insertions(+) create mode 100644 lamagraph-core/src/Core/Node.hs diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs new file mode 100644 index 0000000..366e35f --- /dev/null +++ b/lamagraph-core/src/Core/Node.hs @@ -0,0 +1,93 @@ +module Core.Node where + +import Clash.Prelude +import Data.Maybe (isJust) + +type Address = Unsigned 16 + +-- | Pointer on port of the `Node` with visited flag. +data Port = Port + { _targetAddress :: Address + , _edgeIsVisited :: Bit + } + deriving (NFDataX, Generic) + +-- | Node in the RAM. +data Node numberOfPorts = Node + { _primaryPort :: Port + , _secondaryPorts :: Vec numberOfPorts (Maybe Port) + -- _nodeType :: INNode looks like we need some kind of node label. Info about and reduction rules contained IN + } + deriving (NFDataX, Generic) + +-- | `Node` with info about his`Address`. +data LoadedNode numberOfPorts = LoadedNode + { _node :: Node numberOfPorts + , _originalAddress :: Address + } + deriving (NFDataX, Generic) + +-- | Check if `Port` is not visited yet and there is no collision with `Node` address. +isPortToLoad :: + (KnownNat numberOfPorts) => + LoadedNode numberOfPorts -> + Port -> + Bool +isPortToLoad loadedNode port = + not (bitToBool $ _edgeIsVisited port) + && (_originalAddress loadedNode /= _targetAddress port) + +-- | Mark all `Port` in nodes as visited, if it has pointer at given nodes. +markAllInnerEdges :: + (KnownNat maxNumOfNodesToStore) => + -- | Starting vector of nodes. + Vec maxNumOfNodesToStore (Maybe (LoadedNode numberOfPorts)) -> + -- | Marked vector of nodes. + Vec maxNumOfNodesToStore (Maybe (LoadedNode numberOfPorts)) +markAllInnerEdges nodes = + let addressesOfLoadedNodes = map (fmap _originalAddress) nodes + markPort port = + Port + (_targetAddress port) + ( boolToBit $ + bitToBool (_edgeIsVisited port) + || isJust (elemIndex (Just (_targetAddress port)) addressesOfLoadedNodes) + ) + markPorts loadedNode = + LoadedNode + ( Node + (markPort $ _primaryPort $ _node loadedNode) + (map (fmap markPort) $ _secondaryPorts $ _node loadedNode) + ) + (_originalAddress loadedNode) + in map (fmap markPorts) nodes + +-- | Check if pair of `LoadedNode` are active, i.e. they are connected by primary ports. +isActive :: + LoadedNode numberOfPorts -> + LoadedNode numberOfPorts -> + Bool +isActive leftNode rightNode = + leftNodePrimaryPortAddress == _originalAddress rightNode + && rightNodePrimaryPortAddress == _originalAddress leftNode + where + leftNodePrimaryPortAddress = _targetAddress (_primaryPort $ _node leftNode) + rightNodePrimaryPortAddress = _targetAddress (_primaryPort $ _node rightNode) + +{- | Select an `Address` among those node's ports that can be loaded. +It is always check primary port first. +-} +selectAddressToLoad :: + (KnownNat numberOfPorts) => + LoadedNode numberOfPorts -> + Maybe Address +selectAddressToLoad loadedNode = + if isPortToLoad loadedNode primaryPort + then Just $ _targetAddress primaryPort + else + foldl (\s mbPort -> mbPort >>= addressToLoad s) Nothing $ + _secondaryPorts node + where + node = _node loadedNode + primaryPort = _primaryPort node + addressToLoad s port = if isPortToLoad loadedNode port then Just $ _targetAddress port else s From 5ae3549c7d21919beec7483b427e0643d204a5a8 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 13 Sep 2024 19:37:19 +0300 Subject: [PATCH 02/54] Add Reducer Data types and representation of edges. Also functions to apply reduction and supporting functions. --- .vscode/settings.json | 12 +- lamagraph-core/lamagraph-core.cabal | 2 + lamagraph-core/src/Core/Reducer.hs | 199 ++++++++++++++++++++++++++++ 3 files changed, 204 insertions(+), 9 deletions(-) create mode 100644 lamagraph-core/src/Core/Reducer.hs diff --git a/.vscode/settings.json b/.vscode/settings.json index 24fe307..aab4e1c 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -35,19 +35,13 @@ "**/*.o-boot": true, "**/*.hi-boot": true }, - "cSpell.words": [ - "Lamagraph" - ], + "cSpell.words": ["Lamagraph"], "[alex]": { "editor.tabSize": 2, - "editor.rulers": [ - 120 - ] + "editor.rulers": [120] }, "[happy]": { "editor.tabSize": 2, - "editor.rulers": [ - 120 - ] + "editor.rulers": [120] } } diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index 89002be..1787db3 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -86,6 +86,8 @@ library hs-source-dirs: src exposed-modules: Example.Project + Core.Node + Core.Reducer default-language: Haskell2010 -- Builds the executable 'clash', with lamagraph-core project in scope diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs new file mode 100644 index 0000000..2e1a69f --- /dev/null +++ b/lamagraph-core/src/Core/Reducer.hs @@ -0,0 +1,199 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + +module Core.Reducer where + +import Clash.Prelude +import Core.Node + +type NumOfNodesToStore = Unsigned 3 +type NumOfEdgesToStore = Unsigned 3 +type IdOfPort = Unsigned 3 + +data ReducerStatus + = Work + | Finished + | ErrorHandleSingleNode + | ErrorEmptyLeftNode + deriving (Generic, NFDataX) + +-- | State of the reducer (in terms of mealy automaton). +data ReducerState + = Initial Address + | Empty + | OneNodeToLoad + | Done + | Failed + deriving (Generic, NFDataX) + +-- | Pointer on one of End of `Edge` +data EdgeEnd = EdgeEnd + { _addressOfVertex :: Address + , _idOfPort :: IdOfPort + } + deriving (Generic, NFDataX) + +-- | Pair of the ends. +data Edge = Edge + { _leftEnd :: EdgeEnd + , _rightEnd :: EdgeEnd + } + deriving (Generic, NFDataX) + +data DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts = DataToStore + { _nodes :: Vec maxNumOfNodesToStore (Maybe (LoadedNode numberOfPorts)) + , _edges :: Vec maxNumOfEdgesToStore (Maybe Edge) + } + deriving (Generic, NFDataX) + +-- | Select next `Node` to handle and next `Address` by `Port`. +selectNextLeftNode :: + (KnownNat maxNumOfNodesToStore, KnownNat numberOfPorts, KnownNat maxNumOfEdgesToStore) => + -- | Actual data. + DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts -> + -- | Next `Node`, `Address` and data without selected `Node`. + ( Maybe (LoadedNode numberOfPorts, Address) + , DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts + ) +selectNextLeftNode preDataToStore = + case selectedNode of + Nothing -> (Nothing, preDataToStore) + Just (i, node, addressOfNodeToLoad) -> + ( Just (node, addressOfNodeToLoad) + , DataToStore (replace i Nothing $ _nodes preDataToStore) (_edges preDataToStore) + ) + where + handleNode s i mbNode = + mbNode + >>= ( \node -> case selectAddressToLoad node of + Nothing -> s + Just a -> Just (i, node, a) + ) + selectedNode = ifoldl handleNode Nothing $ _nodes preDataToStore + +-- | Do one step of reduction and get info about next possible step. +handle :: + forall + (maxNumOfNodesToStore :: Nat) + (maxNumOfEdgesToStore :: Nat) + (numberOfPorts :: Nat). + (KnownNat maxNumOfNodesToStore, KnownNat numberOfPorts, KnownNat maxNumOfEdgesToStore) => + -- | Left `Node` to handle. + LoadedNode numberOfPorts -> + -- | Right `Node` to handle. + Maybe (LoadedNode numberOfPorts) -> + -- | Next possible Node and Address to handle and result data. + (Maybe (LoadedNode numberOfPorts, Address), DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts) +handle leftNode rightNode = + selectNextLeftNode $ DataToStore (markAllInnerEdges nodes) emptyEdges + where + emptyNodes = repeat Nothing :: Vec maxNumOfNodesToStore _ + emptyEdges = repeat Nothing :: Vec maxNumOfEdgesToStore _ + nodes = case rightNode of + Nothing -> Just leftNode +>> emptyNodes + Just _ -> + -- if isActive leftNode n + rightNode +>> Just leftNode +>> emptyNodes -- reduction rules applied here + +-- | Type to indicate that all ports that could be handled locally are over. +data NonVisitedOver = No | Yes + +-- | Transition function in mealy automaton. +mealyFunction :: + ( KnownDomain dom + , HiddenClockResetEnable dom + , KnownNat maxNumOfNodesToStore + , KnownNat maxNumOfEdgesToStore + , KnownNat numberOfPorts + ) => + -- | State of reducer and automaton. + ReducerState -> + -- | Input. + ( -- Left and right `Node` to reduce. + (Maybe (LoadedNode numberOfPorts), Maybe (LoadedNode numberOfPorts)) + , ReducerStatus + , Maybe Address + -- Address from memory manager if reducer cannot find next `Address` locally. + ) -> + -- | (state, output). + ( ReducerState + , ( Maybe (DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts) + , ReducerStatus + , Maybe (LoadedNode numberOfPorts) + , -- Next left `Node` + Maybe Address + , -- Next `Address` to load + NonVisitedOver + ) + ) +mealyFunction + state + ( (mbLeftNode, mbLoadedNode) + , status + , addressOfNodeWithUnvisitedEdges + ) = + case state of + Initial addressOfFirstNodeToLoad -> (Empty, (Nothing, Work, Nothing, Just addressOfFirstNodeToLoad, No)) + Empty -> + case mbLoadedNode of + Nothing -> + (Failed, (Nothing, ErrorEmptyLeftNode, Nothing, Nothing, No)) + Just loadedNode -> + case addressToLoad of + Just _ -> + (OneNodeToLoad, (Nothing, Work, Just loadedNode, addressToLoad, No)) + Nothing -> + case mbLeftNode of + Just leftNode' -> + case infoAboutNextNodes of + Just (_, _) -> + (Failed, (Nothing, ErrorHandleSingleNode, Nothing, Nothing, No)) + Nothing -> + (Empty, (Just dataToStore, Work, Nothing, addressOfNodeWithUnvisitedEdges, Yes)) + where + (infoAboutNextNodes, dataToStore) = handle leftNode' Nothing + Nothing -> + (Failed, (Nothing, ErrorEmptyLeftNode, Nothing, Nothing, No)) + where + addressToLoad = selectAddressToLoad loadedNode + OneNodeToLoad -> + case mbLeftNode of + Just leftNode -> + case infoAboutNextNodes of + Just (nextLeftNode, nextAddressToLoad) -> + (OneNodeToLoad, (Just dataToStore, Work, Just nextLeftNode, Just nextAddressToLoad, No)) + Nothing -> + (Empty, (Just dataToStore, Work, Nothing, addressOfNodeWithUnvisitedEdges, Yes)) + where + (infoAboutNextNodes, dataToStore) = handle leftNode mbLoadedNode + Nothing -> (Failed, (Nothing, ErrorEmptyLeftNode, Nothing, Nothing, No)) + Failed -> (Failed, (Nothing, status, Nothing, Nothing, No)) + Done -> (Done, (Nothing, Finished, Nothing, Nothing, No)) + +-- | Reducer function. Steps over Interaction Net and apply reduction rules until is possible. +reducer :: + ( KnownDomain dom + , HiddenClockResetEnable dom + , KnownNat maxNumOfNodesToStore + , KnownNat maxNumOfEdgesToStore + , KnownNat numberOfPorts + ) => + -- | Address of first `Node` to load. + Address -> + -- | Function to load `Node` from RAM. + (Signal dom (Maybe Address) -> Signal dom (Maybe (LoadedNode numberOfPorts))) -> + -- | Function that can give next possible `Address` to reduce. + -- It will come from memory manager which can see all Interaction Net. + (Signal dom NonVisitedOver -> Signal dom (Maybe Address)) -> + Signal dom (Maybe (DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts), ReducerStatus) +reducer addressOfFirstNodeToLoad nodeLoader nonVisitedNodesProvider = + bundle (dataToStore, actualReducerStatus) + where + (dataToStore, actualReducerStatus, nextLeftNode, addressOfNextNodeToLoad, isNonVisitedNodeUsed) = unbundle mealyOutput + mealyOutput = + mealy mealyFunction (Initial addressOfFirstNodeToLoad) mealyInput + mealyInput = + bundle (bundle (leftNode, loadedNode), status, nonVisitedNodesProvider isNonVisitedNodeUsed) + loadedNode = register Nothing (nodeLoader addressOfNextNodeToLoad) + leftNode = register Nothing nextLeftNode + status = register Work actualReducerStatus From 03490a2268094392191be65506d57851b1d3c589 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 13 Sep 2024 20:23:12 +0300 Subject: [PATCH 03/54] pin fourmolu version in CI Fix new version fourmolu warnings --- lamagraph-core/src/Core/Node.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 366e35f..2ee5a1f 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -49,9 +49,9 @@ markAllInnerEdges nodes = markPort port = Port (_targetAddress port) - ( boolToBit $ - bitToBool (_edgeIsVisited port) - || isJust (elemIndex (Just (_targetAddress port)) addressesOfLoadedNodes) + ( boolToBit + $ bitToBool (_edgeIsVisited port) + || isJust (elemIndex (Just (_targetAddress port)) addressesOfLoadedNodes) ) markPorts loadedNode = LoadedNode @@ -68,8 +68,10 @@ isActive :: LoadedNode numberOfPorts -> Bool isActive leftNode rightNode = - leftNodePrimaryPortAddress == _originalAddress rightNode - && rightNodePrimaryPortAddress == _originalAddress leftNode + leftNodePrimaryPortAddress + == _originalAddress rightNode + && rightNodePrimaryPortAddress + == _originalAddress leftNode where leftNodePrimaryPortAddress = _targetAddress (_primaryPort $ _node leftNode) rightNodePrimaryPortAddress = _targetAddress (_primaryPort $ _node rightNode) @@ -85,8 +87,8 @@ selectAddressToLoad loadedNode = if isPortToLoad loadedNode primaryPort then Just $ _targetAddress primaryPort else - foldl (\s mbPort -> mbPort >>= addressToLoad s) Nothing $ - _secondaryPorts node + foldl (\s mbPort -> mbPort >>= addressToLoad s) Nothing + $ _secondaryPorts node where node = _node loadedNode primaryPort = _primaryPort node From f22318b281206d2d5f082fd65b404b827e09626b Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sat, 14 Sep 2024 10:31:20 +0300 Subject: [PATCH 04/54] Delete Example.Project and add simpliest test for Core.Node --- lamagraph-core/lamagraph-core.cabal | 3 +- lamagraph-core/src/Example/Project.hs | 58 ------------------------- lamagraph-core/tests/Tests/Core/Node.hs | 30 +++++++++++++ lamagraph-core/tests/unittests.hs | 5 +-- 4 files changed, 33 insertions(+), 63 deletions(-) delete mode 100644 lamagraph-core/src/Example/Project.hs create mode 100644 lamagraph-core/tests/Tests/Core/Node.hs diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index 1787db3..497e39f 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -85,7 +85,6 @@ library import: common-options hs-source-dirs: src exposed-modules: - Example.Project Core.Node Core.Reducer default-language: Haskell2010 @@ -125,7 +124,7 @@ test-suite test-library ghc-options: -threaded main-is: unittests.hs other-modules: - Tests.Example.Project + Tests.Core.Node build-depends: lamagraph-core, QuickCheck, diff --git a/lamagraph-core/src/Example/Project.hs b/lamagraph-core/src/Example/Project.hs deleted file mode 100644 index 83263fa..0000000 --- a/lamagraph-core/src/Example/Project.hs +++ /dev/null @@ -1,58 +0,0 @@ --- @createDomain@ below generates a warning about orphan instances, but we like --- our code to be warning-free. -{-# OPTIONS_GHC -Wno-orphans #-} - -module Example.Project where - -import Clash.Prelude - --- Create a domain with the frequency of your input clock. For this example we used --- 50 MHz. -createDomain vSystem{vName = "Dom50", vPeriod = hzToPeriod 50e6} - -{- | @topEntity@ is Clash@s equivalent of @main@ in other programming languages. -Clash will look for it when compiling "Example.Project" and translate it to -HDL. While polymorphism can be used freely in Clash projects, a @topEntity@ -must be monomorphic and must use non- recursive types. Or, to put it -hand-wavily, a @topEntity@ must be translatable to a static number of wires. - -Top entities must be monomorphic, meaning we have to specify all type variables. -In this case, we are using the @Dom50@ domain, which we created with @createDomain@ -and we are using 8-bit unsigned numbers. --} -topEntity :: - Clock Dom50 -> - Reset Dom50 -> - Enable Dom50 -> - Signal Dom50 (Unsigned 8) -> - Signal Dom50 (Unsigned 8) -topEntity = exposeClockResetEnable accum --- To specify the names of the ports of our top entity, we create a @Synthesize@ annotation. -{-# ANN - topEntity - ( Synthesize - { t_name = "accum" - , t_inputs = - [ PortName "CLK" - , PortName "RST" - , PortName "EN" - , PortName "DIN" - ] - , t_output = PortName "DOUT" - } - ) - #-} --- Make sure GHC does not apply any optimizations to the boundaries of the design. --- For GHC versions 9.2 or older, use: {-# NOINLINE topEntity #-} -{-# OPAQUE topEntity #-} - -{- | A simple accumulator that works on unsigned numbers of any size. -It has hidden clock, reset, and enable signals. --} -accum :: - (HiddenClockResetEnable dom, KnownNat n) => - Signal dom (Unsigned n) -> - Signal dom (Unsigned n) -accum = mealy accumT 0 - where - accumT s i = (s + i, s) diff --git a/lamagraph-core/tests/Tests/Core/Node.hs b/lamagraph-core/tests/Tests/Core/Node.hs new file mode 100644 index 0000000..03133aa --- /dev/null +++ b/lamagraph-core/tests/Tests/Core/Node.hs @@ -0,0 +1,30 @@ +module Tests.Core.Node where + +import Prelude + +import Clash.Hedgehog.Sized.Unsigned +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.TH + +import qualified Clash.Prelude as C +import qualified Hedgehog as H +import qualified Hedgehog.Range as Range + +import Core.Node + +prop_isPortToLoad :: H.Property +prop_isPortToLoad = H.property $ do + address <- H.forAll $ genUnsigned $ Range.singleton 16 + let + port = Port address 0 + node = Node port C.Nil + loadedNode = LoadedNode node (address + 1) + + isPortToLoad loadedNode port H.=== True + +accumTests :: TestTree +accumTests = $(testGroupGenerator) + +main :: IO () +main = defaultMain accumTests diff --git a/lamagraph-core/tests/unittests.hs b/lamagraph-core/tests/unittests.hs index 8c85172..7a1c905 100644 --- a/lamagraph-core/tests/unittests.hs +++ b/lamagraph-core/tests/unittests.hs @@ -1,13 +1,12 @@ import Prelude import Test.Tasty - -import qualified Tests.Example.Project +import qualified Tests.Core.Node main :: IO () main = defaultMain $ testGroup "." - [ Tests.Example.Project.accumTests + [ Tests.Core.Node.accumTests ] From 142fb679baa37f48b5bd33f954fd31aef05d1bf2 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 15 Sep 2024 11:47:55 +0300 Subject: [PATCH 05/54] Delete usless comments and complement useful ones --- lamagraph-core/src/Core/Node.hs | 7 +++++-- lamagraph-core/src/Core/Reducer.hs | 6 +----- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 2ee5a1f..faddb93 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -5,7 +5,6 @@ import Data.Maybe (isJust) type Address = Unsigned 16 --- | Pointer on port of the `Node` with visited flag. data Port = Port { _targetAddress :: Address , _edgeIsVisited :: Bit @@ -20,7 +19,11 @@ data Node numberOfPorts = Node } deriving (NFDataX, Generic) --- | `Node` with info about his`Address`. +{- | `Node` with info about his`Address`. +Original address can be useful when reducer working. +For example, if this `Node` has reduced then his `Addres s` is become free +and info about this should be passed to the memory manager. +-} data LoadedNode numberOfPorts = LoadedNode { _node :: Node numberOfPorts , _originalAddress :: Address diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index 2e1a69f..fd9b23a 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -26,14 +26,12 @@ data ReducerState | Failed deriving (Generic, NFDataX) --- | Pointer on one of End of `Edge` data EdgeEnd = EdgeEnd { _addressOfVertex :: Address , _idOfPort :: IdOfPort } deriving (Generic, NFDataX) --- | Pair of the ends. data Edge = Edge { _leftEnd :: EdgeEnd , _rightEnd :: EdgeEnd @@ -46,12 +44,10 @@ data DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts = DataT } deriving (Generic, NFDataX) --- | Select next `Node` to handle and next `Address` by `Port`. +-- | Select next left `Node` to handle and next `Address` of right `Node` to be loaded. selectNextLeftNode :: (KnownNat maxNumOfNodesToStore, KnownNat numberOfPorts, KnownNat maxNumOfEdgesToStore) => - -- | Actual data. DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts -> - -- | Next `Node`, `Address` and data without selected `Node`. ( Maybe (LoadedNode numberOfPorts, Address) , DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts ) From 076670fa6c84f07de0eedc53c09cc491579b0ca6 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 15 Sep 2024 22:28:53 +0300 Subject: [PATCH 06/54] Add loader --- lamagraph-core/src/Core/Loader.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 lamagraph-core/src/Core/Loader.hs diff --git a/lamagraph-core/src/Core/Loader.hs b/lamagraph-core/src/Core/Loader.hs new file mode 100644 index 0000000..a5aa210 --- /dev/null +++ b/lamagraph-core/src/Core/Loader.hs @@ -0,0 +1,21 @@ +module Core.Loader where + +import Clash.Prelude +import Core.Node + +-- | Get `Node` by his `Address` from RAM. Actually, preparing to reducer work. +loader :: + ( KnownDomain dom + , HiddenClockResetEnable dom + , KnownNat numberOfPorts + ) => + (Signal dom Address -> Signal dom (Node numberOfPorts)) -> + Signal dom (Maybe Address) -> + Signal dom (Maybe (LoadedNode numberOfPorts)) +loader ram mbAddressToLoad = + mkLoadedNode <$> mbNode <*> mbAddressToLoad + where + mkLoadedNode node address = LoadedNode <$> node <*> address + mbNode = case sequenceA mbAddressToLoad of + Nothing -> pure Nothing + Just n -> sequenceA $ Just (ram n) From e8c6d4e0ce96d83d08b803740cc75f00dcef11a1 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 15 Sep 2024 22:33:32 +0300 Subject: [PATCH 07/54] Fix fourmolu to process $ correctly --- fourmolu.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/fourmolu.yaml b/fourmolu.yaml index bd050a3..357bf50 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -75,3 +75,4 @@ reexports: - "module Relude exports Relude.Print" - "module Relude exports Relude.String" - "module Relude.String exports Relude.String.Reexport" + - "module Clash.Prelude exports Clash.HaskellPrelude" From 396c345ea599478ece78732ec1ca5bbdcceb7658 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 15 Sep 2024 22:34:56 +0300 Subject: [PATCH 08/54] Add lenses and make some style changes --- lamagraph-core/lamagraph-core.cabal | 1 + lamagraph-core/src/Core/Node.hs | 55 +++++++++++++------------ lamagraph-core/src/Core/Reducer.hs | 4 +- lamagraph-core/tests/Tests/Core/Node.hs | 6 +-- 4 files changed, 34 insertions(+), 32 deletions(-) diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index 497e39f..f1ae12f 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -76,6 +76,7 @@ common common-options -- clash-prelude will set suitable version bounds for the plugins clash-prelude >= 1.8.1 && < 1.10, + lens, ghc-typelits-natnormalise, ghc-typelits-extra, ghc-typelits-knownnat diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index faddb93..f5a7b71 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -1,16 +1,21 @@ +{-# LANGUAGE TemplateHaskell #-} + module Core.Node where import Clash.Prelude +import Control.Lens (makeLenses, (^.)) import Data.Maybe (isJust) type Address = Unsigned 16 data Port = Port { _targetAddress :: Address - , _edgeIsVisited :: Bit + , _edgeIsVisited :: Bool } deriving (NFDataX, Generic) +$(makeLenses ''Port) + -- | Node in the RAM. data Node numberOfPorts = Node { _primaryPort :: Port @@ -19,17 +24,21 @@ data Node numberOfPorts = Node } deriving (NFDataX, Generic) +$(makeLenses ''Node) + {- | `Node` with info about his`Address`. Original address can be useful when reducer working. For example, if this `Node` has reduced then his `Addres s` is become free and info about this should be passed to the memory manager. -} data LoadedNode numberOfPorts = LoadedNode - { _node :: Node numberOfPorts + { _containedNode :: Node numberOfPorts , _originalAddress :: Address } deriving (NFDataX, Generic) +$(makeLenses ''LoadedNode) + -- | Check if `Port` is not visited yet and there is no collision with `Node` address. isPortToLoad :: (KnownNat numberOfPorts) => @@ -37,8 +46,8 @@ isPortToLoad :: Port -> Bool isPortToLoad loadedNode port = - not (bitToBool $ _edgeIsVisited port) - && (_originalAddress loadedNode /= _targetAddress port) + not (port ^. edgeIsVisited) + && (loadedNode ^. originalAddress /= port ^. targetAddress) -- | Mark all `Port` in nodes as visited, if it has pointer at given nodes. markAllInnerEdges :: @@ -48,21 +57,18 @@ markAllInnerEdges :: -- | Marked vector of nodes. Vec maxNumOfNodesToStore (Maybe (LoadedNode numberOfPorts)) markAllInnerEdges nodes = - let addressesOfLoadedNodes = map (fmap _originalAddress) nodes + let addressesOfLoadedNodes = map (fmap (^. originalAddress)) nodes markPort port = Port - (_targetAddress port) - ( boolToBit - $ bitToBool (_edgeIsVisited port) - || isJust (elemIndex (Just (_targetAddress port)) addressesOfLoadedNodes) - ) + (port ^. targetAddress) + ((port ^. edgeIsVisited) || isJust (elemIndex (Just (port ^. targetAddress)) addressesOfLoadedNodes)) markPorts loadedNode = LoadedNode ( Node - (markPort $ _primaryPort $ _node loadedNode) - (map (fmap markPort) $ _secondaryPorts $ _node loadedNode) + (markPort $ loadedNode ^. containedNode . primaryPort) + (map (fmap markPort) $ loadedNode ^. containedNode . secondaryPorts) ) - (_originalAddress loadedNode) + (loadedNode ^. originalAddress) in map (fmap markPorts) nodes -- | Check if pair of `LoadedNode` are active, i.e. they are connected by primary ports. @@ -71,13 +77,11 @@ isActive :: LoadedNode numberOfPorts -> Bool isActive leftNode rightNode = - leftNodePrimaryPortAddress - == _originalAddress rightNode - && rightNodePrimaryPortAddress - == _originalAddress leftNode + leftNodePrimaryPortAddress == rightNode ^. originalAddress + && rightNodePrimaryPortAddress == leftNode ^. originalAddress where - leftNodePrimaryPortAddress = _targetAddress (_primaryPort $ _node leftNode) - rightNodePrimaryPortAddress = _targetAddress (_primaryPort $ _node rightNode) + leftNodePrimaryPortAddress = leftNode ^. containedNode . primaryPort . targetAddress + rightNodePrimaryPortAddress = rightNode ^. containedNode . primaryPort . targetAddress {- | Select an `Address` among those node's ports that can be loaded. It is always check primary port first. @@ -87,12 +91,11 @@ selectAddressToLoad :: LoadedNode numberOfPorts -> Maybe Address selectAddressToLoad loadedNode = - if isPortToLoad loadedNode primaryPort - then Just $ _targetAddress primaryPort + if isPortToLoad loadedNode primPort + then Just $ primPort ^. targetAddress else - foldl (\s mbPort -> mbPort >>= addressToLoad s) Nothing - $ _secondaryPorts node + foldl (\s mbPort -> mbPort >>= addressToLoad s) Nothing $ node ^. secondaryPorts where - node = _node loadedNode - primaryPort = _primaryPort node - addressToLoad s port = if isPortToLoad loadedNode port then Just $ _targetAddress port else s + node = loadedNode ^. containedNode + primPort = node ^. primaryPort + addressToLoad s port = if isPortToLoad loadedNode port then Just $ port ^. targetAddress else s diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index fd9b23a..e6f9328 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -96,9 +96,7 @@ data NonVisitedOver = No | Yes -- | Transition function in mealy automaton. mealyFunction :: - ( KnownDomain dom - , HiddenClockResetEnable dom - , KnownNat maxNumOfNodesToStore + ( KnownNat maxNumOfNodesToStore , KnownNat maxNumOfEdgesToStore , KnownNat numberOfPorts ) => diff --git a/lamagraph-core/tests/Tests/Core/Node.hs b/lamagraph-core/tests/Tests/Core/Node.hs index 03133aa..f48e6ca 100644 --- a/lamagraph-core/tests/Tests/Core/Node.hs +++ b/lamagraph-core/tests/Tests/Core/Node.hs @@ -17,9 +17,9 @@ prop_isPortToLoad :: H.Property prop_isPortToLoad = H.property $ do address <- H.forAll $ genUnsigned $ Range.singleton 16 let - port = Port address 0 - node = Node port C.Nil - loadedNode = LoadedNode node (address + 1) + port = Port address False + newNode = Node port C.Nil + loadedNode = LoadedNode newNode (address + 1) isPortToLoad loadedNode port H.=== True From f20525b408767c1265d345b6c2340efcf2bc6ec7 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 16 Sep 2024 12:24:48 +0300 Subject: [PATCH 09/54] Add tests for isActive and isPortToLoad functions Also write helper module with generators of Address, Port and Node. Hope to use that in more complex tests --- lamagraph-core/lamagraph-core.cabal | 1 + lamagraph-core/src/Core/Node.hs | 6 +- lamagraph-core/tests/NodeGenerate.hs | 36 +++++++++++ lamagraph-core/tests/Tests/Core/Node.hs | 60 +++++++++++++++---- lamagraph-core/tests/Tests/Example/Project.hs | 51 ---------------- 5 files changed, 90 insertions(+), 64 deletions(-) create mode 100644 lamagraph-core/tests/NodeGenerate.hs delete mode 100644 lamagraph-core/tests/Tests/Example/Project.hs diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index f1ae12f..c9cad2a 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -126,6 +126,7 @@ test-suite test-library main-is: unittests.hs other-modules: Tests.Core.Node + NodeGenerate build-depends: lamagraph-core, QuickCheck, diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index f5a7b71..29bd381 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -12,7 +12,7 @@ data Port = Port { _targetAddress :: Address , _edgeIsVisited :: Bool } - deriving (NFDataX, Generic) + deriving (NFDataX, Generic, Show) $(makeLenses ''Port) @@ -22,7 +22,7 @@ data Node numberOfPorts = Node , _secondaryPorts :: Vec numberOfPorts (Maybe Port) -- _nodeType :: INNode looks like we need some kind of node label. Info about and reduction rules contained IN } - deriving (NFDataX, Generic) + deriving (NFDataX, Generic, Show) $(makeLenses ''Node) @@ -35,7 +35,7 @@ data LoadedNode numberOfPorts = LoadedNode { _containedNode :: Node numberOfPorts , _originalAddress :: Address } - deriving (NFDataX, Generic) + deriving (NFDataX, Generic, Show) $(makeLenses ''LoadedNode) diff --git a/lamagraph-core/tests/NodeGenerate.hs b/lamagraph-core/tests/NodeGenerate.hs new file mode 100644 index 0000000..95c13d2 --- /dev/null +++ b/lamagraph-core/tests/NodeGenerate.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + +module NodeGenerate where + +import Clash.Hedgehog.Sized.Unsigned +import Clash.Hedgehog.Sized.Vector +import Clash.Prelude +import Core.Node +import qualified Hedgehog.Gen as Gen +import Hedgehog.Internal.Gen (MonadGen) +import qualified Hedgehog.Range as Range + +type UnsignedRange (n :: Nat) = Range.Range (Unsigned n) + +genAddress :: (MonadGen m) => m Address +genAddress = genUnsigned (Range.linearBounded :: UnsignedRange 16) + +genPort :: (MonadGen m) => m Port +genPort = do + address <- genAddress + Port address <$> Gen.bool + +type GenNode (n :: Nat) = forall m. (MonadGen m) => m (Node n) + +genNode :: forall m n. (MonadGen m, KnownNat n) => m (Node n) +genNode = do + port <- genPort + ports <- genVec genMbPort :: m (Vec n _) + return $ Node port ports + where + genMbPort = + Gen.frequency + [ (70, Just <$> genPort) + , (30, return Nothing) + ] diff --git a/lamagraph-core/tests/Tests/Core/Node.hs b/lamagraph-core/tests/Tests/Core/Node.hs index f48e6ca..d271fcd 100644 --- a/lamagraph-core/tests/Tests/Core/Node.hs +++ b/lamagraph-core/tests/Tests/Core/Node.hs @@ -2,26 +2,66 @@ module Tests.Core.Node where import Prelude -import Clash.Hedgehog.Sized.Unsigned import Test.Tasty import Test.Tasty.Hedgehog import Test.Tasty.TH import qualified Clash.Prelude as C +import Core.Node import qualified Hedgehog as H -import qualified Hedgehog.Range as Range +import qualified Hedgehog.Gen as Gen +import NodeGenerate (genAddress) -import Core.Node +prop_isPortToLoad_diffAddr :: H.Property +prop_isPortToLoad_diffAddr = H.property $ do + address <- H.forAll genAddress + isVisited <- H.forAll Gen.bool + let + port = Port address isVisited + node = Node port C.Nil + loadedNode = LoadedNode node (address + 1) + + isPortToLoad loadedNode port H.=== not isVisited -prop_isPortToLoad :: H.Property -prop_isPortToLoad = H.property $ do - address <- H.forAll $ genUnsigned $ Range.singleton 16 +prop_isPortToLoad_sameAddr :: H.Property +prop_isPortToLoad_sameAddr = H.property $ do + address <- H.forAll genAddress + isVisited <- H.forAll Gen.bool let - port = Port address False - newNode = Node port C.Nil - loadedNode = LoadedNode newNode (address + 1) + port = Port address isVisited + node = Node port C.Nil + loadedNode = LoadedNode node address + isPortToLoad loadedNode port H.=== False - isPortToLoad loadedNode port H.=== True +prop_isActive_crossreference :: H.Property +prop_isActive_crossreference = H.property $ do + leftAddress <- H.forAll genAddress + rightAddress <- H.forAll genAddress + let + leftPrimPort = Port rightAddress False + rightPrimPort = Port leftAddress False + leftNode = Node leftPrimPort C.Nil + rightNode = Node rightPrimPort C.Nil + leftLoadedNode = LoadedNode leftNode leftAddress + rightLoadedNode = LoadedNode rightNode rightAddress + H.assert $ isActive leftLoadedNode rightLoadedNode + +prop_isActive_random :: H.Property +prop_isActive_random = H.property $ do + leftAddress <- H.forAll genAddress + rightAddress <- H.forAll genAddress + leftPortAddr <- H.forAll genAddress + rightPortAddr <- H.forAll genAddress + leftIsVisited <- H.forAll Gen.bool + rightIsVisited <- H.forAll Gen.bool + let + leftPrimPort = Port leftPortAddr leftIsVisited + leftNode = Node leftPrimPort C.Nil + leftLoadedNode = LoadedNode leftNode leftAddress + rightPrimPort = Port rightPortAddr rightIsVisited + rightNode = Node rightPrimPort C.Nil + rightLoadedNode = LoadedNode rightNode rightAddress + isActive leftLoadedNode rightLoadedNode H.=== (leftAddress == rightPortAddr && rightAddress == leftPortAddr) accumTests :: TestTree accumTests = $(testGroupGenerator) diff --git a/lamagraph-core/tests/Tests/Example/Project.hs b/lamagraph-core/tests/Tests/Example/Project.hs deleted file mode 100644 index 0f9797d..0000000 --- a/lamagraph-core/tests/Tests/Example/Project.hs +++ /dev/null @@ -1,51 +0,0 @@ -module Tests.Example.Project where - -import Prelude - -import Clash.Hedgehog.Sized.Unsigned -import Test.Tasty -import Test.Tasty.Hedgehog -import Test.Tasty.TH - -import qualified Clash.Prelude as C -import qualified Hedgehog as H -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range - --- Import the module containing the @accum@ function -import Example.Project (accum) - --- Define a Hedgehog property to test the @accum@ function -prop_accum :: H.Property -prop_accum = H.property $ do - -- Simulate for a random duration between 1 and 100 cycles - simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) - - -- Generate a list of random unsigned numbers. - inp <- - H.forAll - ( Gen.list - (Range.singleton simDuration) - (genUnsigned Range.linearBounded) - ) - let - -- Simulate the @accum@ function for the pre-existing @System@ domain - -- and 8 bit unsigned numbers. - -- - -- The (hidden) reset input of @accum@ will be asserted in the first cycle; - -- during this cycle it will emit its initial value and the input is - -- ignored. So we need to present a dummy input value. - simOut = C.sampleN (simDuration + 1) (accum @C.System @8 (C.fromList (0 : inp))) - -- Calculate the expected output. The first cycle is the initial value, and - -- the result of the final input value does not appear because the - -- accumulator has 1 cycle latency. - expected = 0 : init (scanl (+) 0 inp) - - -- Check that the simulated output matches the expected output - simOut H.=== expected - -accumTests :: TestTree -accumTests = $(testGroupGenerator) - -main :: IO () -main = defaultMain accumTests From 47cdb69bd022d0d62049e80ae6a7ef27d2f9496f Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Tue, 17 Sep 2024 09:31:49 +0300 Subject: [PATCH 10/54] Replace elemIndex to elem in markAllInnerEdges --- lamagraph-core/src/Core/Node.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 29bd381..76e8fb9 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -4,7 +4,6 @@ module Core.Node where import Clash.Prelude import Control.Lens (makeLenses, (^.)) -import Data.Maybe (isJust) type Address = Unsigned 16 @@ -61,7 +60,7 @@ markAllInnerEdges nodes = markPort port = Port (port ^. targetAddress) - ((port ^. edgeIsVisited) || isJust (elemIndex (Just (port ^. targetAddress)) addressesOfLoadedNodes)) + ((port ^. edgeIsVisited) || elem (Just (port ^. targetAddress)) addressesOfLoadedNodes) markPorts loadedNode = LoadedNode ( Node From c42efc49666c4c22dd010f8a4136e519f245a818 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Tue, 17 Sep 2024 09:45:06 +0300 Subject: [PATCH 11/54] Add tests for selectAddresToLoad function --- lamagraph-core/tests/NodeGenerate.hs | 14 +++++++--- lamagraph-core/tests/Tests/Core/Node.hs | 34 +++++++++++++++++++++---- 2 files changed, 40 insertions(+), 8 deletions(-) diff --git a/lamagraph-core/tests/NodeGenerate.hs b/lamagraph-core/tests/NodeGenerate.hs index 95c13d2..e8ca0ba 100644 --- a/lamagraph-core/tests/NodeGenerate.hs +++ b/lamagraph-core/tests/NodeGenerate.hs @@ -21,16 +21,24 @@ genPort = do address <- genAddress Port address <$> Gen.bool +genPortVisitedFlag :: (MonadGen m) => Bool -> m Port +genPortVisitedFlag visited = do + address <- genAddress + return $ Port address visited + type GenNode (n :: Nat) = forall m. (MonadGen m) => m (Node n) genNode :: forall m n. (MonadGen m, KnownNat n) => m (Node n) genNode = do port <- genPort - ports <- genVec genMbPort :: m (Vec n _) + ports <- genMbObjectsVec genPort :: _ (Vec n _) return $ Node port ports + +genMbObjectsVec :: forall m n a. (MonadGen m, KnownNat n) => m a -> m (Vec n (Maybe a)) +genMbObjectsVec genObjectFunc = genVec genFunc where - genMbPort = + genFunc = Gen.frequency - [ (70, Just <$> genPort) + [ (70, Just <$> genObjectFunc) , (30, return Nothing) ] diff --git a/lamagraph-core/tests/Tests/Core/Node.hs b/lamagraph-core/tests/Tests/Core/Node.hs index d271fcd..b3610fc 100644 --- a/lamagraph-core/tests/Tests/Core/Node.hs +++ b/lamagraph-core/tests/Tests/Core/Node.hs @@ -1,16 +1,18 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + module Tests.Core.Node where import Prelude -import Test.Tasty -import Test.Tasty.Hedgehog -import Test.Tasty.TH - import qualified Clash.Prelude as C import Core.Node import qualified Hedgehog as H import qualified Hedgehog.Gen as Gen -import NodeGenerate (genAddress) +import NodeGenerate (genAddress, genMbObjectsVec, genPortVisitedFlag) +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.TH prop_isPortToLoad_diffAddr :: H.Property prop_isPortToLoad_diffAddr = H.property $ do @@ -63,6 +65,28 @@ prop_isActive_random = H.property $ do rightLoadedNode = LoadedNode rightNode rightAddress isActive leftLoadedNode rightLoadedNode H.=== (leftAddress == rightPortAddr && rightAddress == leftPortAddr) +prop_selectAddressToLoad_primary_unvisited :: H.Property +prop_selectAddressToLoad_primary_unvisited = H.property $ do + nodeAddress <- H.forAll genAddress + portTargetAddress <- H.forAll genAddress + let + port = Port portTargetAddress False + node = Node port C.Nil + loadedNode = LoadedNode node nodeAddress + case selectAddressToLoad loadedNode of + Nothing -> nodeAddress H.=== portTargetAddress + Just address -> address H.=== portTargetAddress + +prop_selectAddressToLoad_all_visited :: H.Property +prop_selectAddressToLoad_all_visited = H.property $ do + primPort <- H.forAll $ genPortVisitedFlag True + secondaryPortsVec <- H.forAll $ genMbObjectsVec (genPortVisitedFlag True) :: _ (C.Vec 10 _) -- 10 is random number, it can be changed + address <- H.forAll genAddress + let + node = Node primPort secondaryPortsVec + loadedNode = LoadedNode node address + selectAddressToLoad loadedNode H.=== Nothing + accumTests :: TestTree accumTests = $(testGroupGenerator) From 957dd8bec23d02f48b20b2929cf10941a499d177 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Tue, 17 Sep 2024 09:46:04 +0300 Subject: [PATCH 12/54] Replace repeat to def in handle function --- lamagraph-core/src/Core/Reducer.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index e6f9328..0130daf 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -83,8 +83,8 @@ handle :: handle leftNode rightNode = selectNextLeftNode $ DataToStore (markAllInnerEdges nodes) emptyEdges where - emptyNodes = repeat Nothing :: Vec maxNumOfNodesToStore _ - emptyEdges = repeat Nothing :: Vec maxNumOfEdgesToStore _ + emptyNodes = def :: Vec maxNumOfNodesToStore _ + emptyEdges = def :: Vec maxNumOfEdgesToStore _ nodes = case rightNode of Nothing -> Just leftNode +>> emptyNodes Just _ -> From 69b34393fb548784f2e577a99b67fce27b8cde2f Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Tue, 17 Sep 2024 14:43:00 +0300 Subject: [PATCH 13/54] Add tests for markAllInnerEdges function --- lamagraph-core/src/Core/Node.hs | 6 ++-- lamagraph-core/tests/NodeGenerate.hs | 18 +++++++++++ lamagraph-core/tests/Tests/Core/Node.hs | 40 +++++++++++++++++++++++-- 3 files changed, 58 insertions(+), 6 deletions(-) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 76e8fb9..f8c485a 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -11,7 +11,7 @@ data Port = Port { _targetAddress :: Address , _edgeIsVisited :: Bool } - deriving (NFDataX, Generic, Show) + deriving (NFDataX, Generic, Show, Eq) $(makeLenses ''Port) @@ -21,7 +21,7 @@ data Node numberOfPorts = Node , _secondaryPorts :: Vec numberOfPorts (Maybe Port) -- _nodeType :: INNode looks like we need some kind of node label. Info about and reduction rules contained IN } - deriving (NFDataX, Generic, Show) + deriving (NFDataX, Generic, Show, Eq) $(makeLenses ''Node) @@ -34,7 +34,7 @@ data LoadedNode numberOfPorts = LoadedNode { _containedNode :: Node numberOfPorts , _originalAddress :: Address } - deriving (NFDataX, Generic, Show) + deriving (NFDataX, Generic, Show, Eq) $(makeLenses ''LoadedNode) diff --git a/lamagraph-core/tests/NodeGenerate.hs b/lamagraph-core/tests/NodeGenerate.hs index e8ca0ba..18e2027 100644 --- a/lamagraph-core/tests/NodeGenerate.hs +++ b/lamagraph-core/tests/NodeGenerate.hs @@ -6,16 +6,27 @@ module NodeGenerate where import Clash.Hedgehog.Sized.Unsigned import Clash.Hedgehog.Sized.Vector import Clash.Prelude +import qualified Clash.Sized.Vector as Vec import Core.Node import qualified Hedgehog.Gen as Gen import Hedgehog.Internal.Gen (MonadGen) import qualified Hedgehog.Range as Range +import qualified Prelude type UnsignedRange (n :: Nat) = Range.Range (Unsigned n) genAddress :: (MonadGen m) => m Address genAddress = genUnsigned (Range.linearBounded :: UnsignedRange 16) +-- | Honest generating uniq addresses. May be very slow. +genUniqAddresses :: (MonadGen m, KnownNat n) => m (Vec n Address) +genUniqAddresses = Gen.filterT addressesAreUniq (genVec genAddress) + where + addressesAreUniq vec = allDifferent $ toList vec + allDifferent list = case list of + [] -> True + x : xs -> x `notElem` xs && allDifferent xs + genPort :: (MonadGen m) => m Port genPort = do address <- genAddress @@ -34,6 +45,13 @@ genNode = do ports <- genMbObjectsVec genPort :: _ (Vec n _) return $ Node port ports +genLoadedNodeByGivenAddresses :: (MonadGen m) => Address -> Address -> [Address] -> m (LoadedNode 5) +genLoadedNodeByGivenAddresses nodeAddr prPortAddr secPortsAddr = + return $ LoadedNode (Node (Port prPortAddr False) secPorts) nodeAddr + where + secPorts = Vec.unsafeFromList (mkPorts secPortsAddr) :: Vec 5 (Maybe Port) + mkPorts = Prelude.map (\a -> Just (Port a False)) + genMbObjectsVec :: forall m n a. (MonadGen m, KnownNat n) => m a -> m (Vec n (Maybe a)) genMbObjectsVec genObjectFunc = genVec genFunc where diff --git a/lamagraph-core/tests/Tests/Core/Node.hs b/lamagraph-core/tests/Tests/Core/Node.hs index b3610fc..64cd239 100644 --- a/lamagraph-core/tests/Tests/Core/Node.hs +++ b/lamagraph-core/tests/Tests/Core/Node.hs @@ -3,16 +3,16 @@ module Tests.Core.Node where -import Prelude - import qualified Clash.Prelude as C +import qualified Clash.Sized.Vector as Vec import Core.Node import qualified Hedgehog as H import qualified Hedgehog.Gen as Gen -import NodeGenerate (genAddress, genMbObjectsVec, genPortVisitedFlag) +import NodeGenerate (genAddress, genLoadedNodeByGivenAddresses, genMbObjectsVec, genPortVisitedFlag) import Test.Tasty import Test.Tasty.Hedgehog import Test.Tasty.TH +import Prelude prop_isPortToLoad_diffAddr :: H.Property prop_isPortToLoad_diffAddr = H.property $ do @@ -87,6 +87,40 @@ prop_selectAddressToLoad_all_visited = H.property $ do loadedNode = LoadedNode node address selectAddressToLoad loadedNode H.=== Nothing +prop_markAllInnerEdges_empty_vec_of_nodes :: H.Property +prop_markAllInnerEdges_empty_vec_of_nodes = H.property $ do + let nodes = C.def :: C.Vec 10 (Maybe (LoadedNode 10)) + nodes H.=== markAllInnerEdges nodes + +prop_markAllInnerEdges_uniq_addresses :: H.Property +prop_markAllInnerEdges_uniq_addresses = H.property $ do + let + uniqAddresses = C.iterateI (+ 1) 1 :: C.Vec 21 Address -- it can be obtained by using function genUniqAddresses, but it is very slow + preDataToGenLoadedNodes = window 7 $ Vec.toList uniqAddresses + listOfLoadedNodesGen = map genLoadedNode preDataToGenLoadedNodes + genVecOfUniqLoadedNodes = sequence $ Vec.unsafeFromList listOfLoadedNodesGen :: H.Gen (C.Vec 3 (LoadedNode 5)) + vecOfUniqLoadedNodes <- H.forAll genVecOfUniqLoadedNodes + let vecOfMbUniqLoadedNodes = Just <$> vecOfUniqLoadedNodes + markAllInnerEdges vecOfMbUniqLoadedNodes H.=== vecOfMbUniqLoadedNodes + where + window size list = case splitAt size list of + ([], []) -> [] + (xs, remainder) -> xs : window size remainder + genLoadedNode list = genLoadedNodeByGivenAddresses (head list) (list !! 1) (drop 2 list) + +prop_markAllInnerEdges_crossreference :: H.Property +prop_markAllInnerEdges_crossreference = H.property $ do + addressOfNode1 <- H.forAll genAddress + addressOfNode2 <- H.forAll genAddress + port1 <- H.forAll $ genPortVisitedFlag True + let + loadedNode1 = Just $ LoadedNode (Node port1 C.Nil) addressOfNode1 + loadedNode2 = Just $ LoadedNode (Node (Port addressOfNode1 False) C.Nil) addressOfNode2 + expectedResult = loadedNode1 C.:> Just (LoadedNode (Node (Port addressOfNode1 True) C.Nil) addressOfNode2) C.:> C.Nil + actualResult = markAllInnerEdges (loadedNode1 C.:> loadedNode2 C.:> C.Nil) + + actualResult H.=== expectedResult + accumTests :: TestTree accumTests = $(testGroupGenerator) From 77a1365901fa7e9c870feaf13c64d00b65f9aebf Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Wed, 18 Sep 2024 22:35:25 +0300 Subject: [PATCH 14/54] [WIP]Add layout of memory manager --- lamagraph-core/lamagraph-core.cabal | 1 + lamagraph-core/src/Core/MemoryManager.hs | 41 ++++++++++++++++++++++++ lamagraph-core/src/Core/Node.hs | 11 ++++++- lamagraph-core/src/Core/Reducer.hs | 10 +++--- 4 files changed, 57 insertions(+), 6 deletions(-) create mode 100644 lamagraph-core/src/Core/MemoryManager.hs diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index c9cad2a..acfa10b 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -88,6 +88,7 @@ library exposed-modules: Core.Node Core.Reducer + Core.MemoryManager default-language: Haskell2010 -- Builds the executable 'clash', with lamagraph-core project in scope diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs new file mode 100644 index 0000000..d5d142e --- /dev/null +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -0,0 +1,41 @@ +-- Just to pass CI, updateMM is not implement yet +{-# OPTIONS_GHC -Wno-unused-matches #-} + +module Core.MemoryManager where + +import Clash.Prelude +import Control.Lens (makeLenses, (^.)) +import Core.Node +import Core.Reducer + +data MemoryManager (cellsNumber :: Nat) = MemoryManager + { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" + , _visitedBitMap :: Vec cellsNumber Bool -- map of Address : Bool. tell smth like "Node by this address has primary port visited" + , _nextAddressToHandle :: Maybe Address -- next Node which has no primary port visited + } + deriving (Show, Eq, Generic, NFDataX) + +$(makeLenses ''MemoryManager) + +data Delta (cellsNumber :: Nat) (portsNumber :: Nat) = Delta + { _appearedNodes :: Vec cellsNumber (Maybe (Node portsNumber)) + , _deletedNodes :: Vec cellsNumber (Maybe (LoadedNode portsNumber)) + , _handledEdge :: Edge -- edge by that happened reduction + } + deriving (Show, Eq, Generic, NFDataX) + +-- This is strange. +getUnUsedAddress :: + (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16) => MemoryManager cellsNumber -> Maybe Address +getUnUsedAddress memoryManager = address + where + indexOfUnused = elemIndex False (memoryManager ^. busyBitMap) + address = bitCoerce <$> indexOfUnused :: Maybe Address + +updateMM :: + (KnownNat cellsNumber, KnownNat portsNumber) => + MemoryManager cellsNumber -> + Delta cellsNumber portsNumber -> + MemoryManager cellsNumber +updateMM memoryManager delta = + undefined diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index f8c485a..5169589 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -7,6 +7,15 @@ import Control.Lens (makeLenses, (^.)) type Address = Unsigned 16 +{- +Maybe we need ro rewrite Port by +data Port + = PrimaryPort + { _targetAddress :: Address + , _edgeIsVisited :: Bool + } + | SecondaryPort {_targetAddress :: Address} +-} data Port = Port { _targetAddress :: Address , _edgeIsVisited :: Bool @@ -27,7 +36,7 @@ $(makeLenses ''Node) {- | `Node` with info about his`Address`. Original address can be useful when reducer working. -For example, if this `Node` has reduced then his `Addres s` is become free +For example, if this `Node` has reduced then his `Address` is become free and info about this should be passed to the memory manager. -} data LoadedNode numberOfPorts = LoadedNode diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index 0130daf..6886db5 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -15,7 +15,7 @@ data ReducerStatus | Finished | ErrorHandleSingleNode | ErrorEmptyLeftNode - deriving (Generic, NFDataX) + deriving (Generic, NFDataX, Show, Eq) -- | State of the reducer (in terms of mealy automaton). data ReducerState @@ -24,25 +24,25 @@ data ReducerState | OneNodeToLoad | Done | Failed - deriving (Generic, NFDataX) + deriving (Generic, NFDataX, Show, Eq) data EdgeEnd = EdgeEnd { _addressOfVertex :: Address , _idOfPort :: IdOfPort } - deriving (Generic, NFDataX) + deriving (Generic, NFDataX, Show, Eq) data Edge = Edge { _leftEnd :: EdgeEnd , _rightEnd :: EdgeEnd } - deriving (Generic, NFDataX) + deriving (Generic, NFDataX, Show, Eq) data DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts = DataToStore { _nodes :: Vec maxNumOfNodesToStore (Maybe (LoadedNode numberOfPorts)) , _edges :: Vec maxNumOfEdgesToStore (Maybe Edge) } - deriving (Generic, NFDataX) + deriving (Generic, NFDataX, Show, Eq) -- | Select next left `Node` to handle and next `Address` of right `Node` to be loaded. selectNextLeftNode :: From beb03b73232cf6fbe89c8b6223ac78aab68aaf58 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Tue, 1 Oct 2024 09:24:04 +0300 Subject: [PATCH 15/54] Redesign Address and add LocalNode --- lamagraph-core/src/Core/Node.hs | 85 +++++++-------------------------- 1 file changed, 17 insertions(+), 68 deletions(-) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 5169589..2066a9c 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -5,24 +5,13 @@ module Core.Node where import Clash.Prelude import Control.Lens (makeLenses, (^.)) -type Address = Unsigned 16 +type AddressNumber = Unsigned 16 -{- -Maybe we need ro rewrite Port by -data Port - = PrimaryPort - { _targetAddress :: Address - , _edgeIsVisited :: Bool - } - | SecondaryPort {_targetAddress :: Address} --} -data Port = Port - { _targetAddress :: Address - , _edgeIsVisited :: Bool - } +data Address = ActualAddress AddressNumber | LocalAddress AddressNumber deriving (NFDataX, Generic, Show, Eq) -$(makeLenses ''Port) +newtype Port = Port (Maybe Address) + deriving (NFDataX, Generic, Show, Eq) -- | Node in the RAM. data Node numberOfPorts = Node @@ -39,45 +28,22 @@ Original address can be useful when reducer working. For example, if this `Node` has reduced then his `Address` is become free and info about this should be passed to the memory manager. -} -data LoadedNode numberOfPorts = LoadedNode - { _containedNode :: Node numberOfPorts +data LoadedNode (portsNumber :: Nat) = LoadedNode + { _containedNode :: Node portsNumber , _originalAddress :: Address } deriving (NFDataX, Generic, Show, Eq) $(makeLenses ''LoadedNode) --- | Check if `Port` is not visited yet and there is no collision with `Node` address. -isPortToLoad :: - (KnownNat numberOfPorts) => - LoadedNode numberOfPorts -> - Port -> - Bool -isPortToLoad loadedNode port = - not (port ^. edgeIsVisited) - && (loadedNode ^. originalAddress /= port ^. targetAddress) +-- | Analog of `LoadedNode` with local address. Redundant, just for simplification of signatures. +data LocalNode (portsNumber :: Nat) = LocalNode + { _localAddress :: Address + , _numberedNode :: Node portsNumber + } + deriving (NFDataX, Generic, Show, Eq) --- | Mark all `Port` in nodes as visited, if it has pointer at given nodes. -markAllInnerEdges :: - (KnownNat maxNumOfNodesToStore) => - -- | Starting vector of nodes. - Vec maxNumOfNodesToStore (Maybe (LoadedNode numberOfPorts)) -> - -- | Marked vector of nodes. - Vec maxNumOfNodesToStore (Maybe (LoadedNode numberOfPorts)) -markAllInnerEdges nodes = - let addressesOfLoadedNodes = map (fmap (^. originalAddress)) nodes - markPort port = - Port - (port ^. targetAddress) - ((port ^. edgeIsVisited) || elem (Just (port ^. targetAddress)) addressesOfLoadedNodes) - markPorts loadedNode = - LoadedNode - ( Node - (markPort $ loadedNode ^. containedNode . primaryPort) - (map (fmap markPort) $ loadedNode ^. containedNode . secondaryPorts) - ) - (loadedNode ^. originalAddress) - in map (fmap markPorts) nodes +$(makeLenses ''LocalNode) -- | Check if pair of `LoadedNode` are active, i.e. they are connected by primary ports. isActive :: @@ -85,25 +51,8 @@ isActive :: LoadedNode numberOfPorts -> Bool isActive leftNode rightNode = - leftNodePrimaryPortAddress == rightNode ^. originalAddress - && rightNodePrimaryPortAddress == leftNode ^. originalAddress - where - leftNodePrimaryPortAddress = leftNode ^. containedNode . primaryPort . targetAddress - rightNodePrimaryPortAddress = rightNode ^. containedNode . primaryPort . targetAddress - -{- | Select an `Address` among those node's ports that can be loaded. -It is always check primary port first. --} -selectAddressToLoad :: - (KnownNat numberOfPorts) => - LoadedNode numberOfPorts -> - Maybe Address -selectAddressToLoad loadedNode = - if isPortToLoad loadedNode primPort - then Just $ primPort ^. targetAddress - else - foldl (\s mbPort -> mbPort >>= addressToLoad s) Nothing $ node ^. secondaryPorts + leftNodePrimaryPortAddress == Just (rightNode ^. originalAddress) + && rightNodePrimaryPortAddress == Just (leftNode ^. originalAddress) where - node = loadedNode ^. containedNode - primPort = node ^. primaryPort - addressToLoad s port = if isPortToLoad loadedNode port then Just $ port ^. targetAddress else s + Port leftNodePrimaryPortAddress = leftNode ^. containedNode . primaryPort + Port rightNodePrimaryPortAddress = rightNode ^. containedNode . primaryPort From cb4f812aac34f89da69e3721a60cee996b888898 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Tue, 1 Oct 2024 09:48:49 +0300 Subject: [PATCH 16/54] Add updateRam function --- lamagraph-core/src/Core/Loader.hs | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/lamagraph-core/src/Core/Loader.hs b/lamagraph-core/src/Core/Loader.hs index a5aa210..95d9383 100644 --- a/lamagraph-core/src/Core/Loader.hs +++ b/lamagraph-core/src/Core/Loader.hs @@ -3,19 +3,36 @@ module Core.Loader where import Clash.Prelude import Core.Node --- | Get `Node` by his `Address` from RAM. Actually, preparing to reducer work. +-- | Get `Node` by his `AddressNumber` from RAM. Actually, preparing to reducer work. loader :: ( KnownDomain dom , HiddenClockResetEnable dom , KnownNat numberOfPorts ) => - (Signal dom Address -> Signal dom (Node numberOfPorts)) -> - Signal dom (Maybe Address) -> + (Signal dom AddressNumber -> Signal dom (Node numberOfPorts)) -> + Signal dom (Maybe AddressNumber) -> Signal dom (Maybe (LoadedNode numberOfPorts)) -loader ram mbAddressToLoad = - mkLoadedNode <$> mbNode <*> mbAddressToLoad +loader ram mbAddressNumberToLoad = + mkLoadedNode <$> mbNode <*> mbAddressNumberToLoad where - mkLoadedNode node address = LoadedNode <$> node <*> address - mbNode = case sequenceA mbAddressToLoad of + mkLoadedNode node address = LoadedNode <$> node <*> (ActualAddress <$> address) + mbNode = case sequenceA mbAddressNumberToLoad of Nothing -> pure Nothing Just n -> sequenceA $ Just (ram n) + +{- | Update RAM function. In fact only way to update data in registers. +Change `Node` by given `AddressNumber` at given `Node` +-} +updateRam :: + ( KnownDomain dom + , HiddenClockResetEnable dom + , KnownNat numberOfPorts + ) => + (Signal dom AddressNumber -> Signal dom (Node numberOfPorts)) -> + Signal dom AddressNumber -> + Signal dom (Node numberOfPorts) -> + (Signal dom AddressNumber -> Signal dom (Node numberOfPorts)) +updateRam oldRam newAddressNumber newNode address = mux addressesIsEq newNode oldNode + where + addressesIsEq = newAddressNumber .==. address + oldNode = oldRam address From 9204022d6490c3cd9878f858a18ab3e12f898d44 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 21 Oct 2024 10:27:55 +0300 Subject: [PATCH 17/54] Add IdOfPort --- lamagraph-core/src/Core/Node.hs | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 2066a9c..35a079e 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -7,16 +7,28 @@ import Control.Lens (makeLenses, (^.)) type AddressNumber = Unsigned 16 +data IdOfPort (portsNumber :: Nat) = Id (Index portsNumber) | Primary + deriving (Generic, Show, Eq, NFDataX) -- Index numberOfPorts + data Address = ActualAddress AddressNumber | LocalAddress AddressNumber deriving (NFDataX, Generic, Show, Eq) -newtype Port = Port (Maybe Address) +instance Default Address where + def :: Address + def = ActualAddress (def :: AddressNumber) + +data Port (portsNumber :: Nat) = Port + { _nodeAddress :: Maybe Address + , _portConnectedToId :: IdOfPort portsNumber + } deriving (NFDataX, Generic, Show, Eq) +$(makeLenses ''Port) + -- | Node in the RAM. -data Node numberOfPorts = Node - { _primaryPort :: Port - , _secondaryPorts :: Vec numberOfPorts (Maybe Port) +data Node portsNumber = Node + { _primaryPort :: Port portsNumber + , _secondaryPorts :: Vec portsNumber (Maybe (Port portsNumber)) -- _nodeType :: INNode looks like we need some kind of node label. Info about and reduction rules contained IN } deriving (NFDataX, Generic, Show, Eq) @@ -54,5 +66,5 @@ isActive leftNode rightNode = leftNodePrimaryPortAddress == Just (rightNode ^. originalAddress) && rightNodePrimaryPortAddress == Just (leftNode ^. originalAddress) where - Port leftNodePrimaryPortAddress = leftNode ^. containedNode . primaryPort - Port rightNodePrimaryPortAddress = rightNode ^. containedNode . primaryPort + Port leftNodePrimaryPortAddress _ = leftNode ^. containedNode . primaryPort + Port rightNodePrimaryPortAddress _ = rightNode ^. containedNode . primaryPort From 28948dcf6d0800cda4eaf4dc76228b18ad71ae56 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 28 Oct 2024 14:59:17 +0300 Subject: [PATCH 18/54] Add more types and getter port function --- lamagraph-core/src/Core/Node.hs | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 35a079e..af16d00 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -5,18 +5,19 @@ module Core.Node where import Clash.Prelude import Control.Lens (makeLenses, (^.)) +type NodeTag = String + type AddressNumber = Unsigned 16 +type LocalAddressNumber = AddressNumber +type ActualAddressNumber = AddressNumber + data IdOfPort (portsNumber :: Nat) = Id (Index portsNumber) | Primary deriving (Generic, Show, Eq, NFDataX) -- Index numberOfPorts -data Address = ActualAddress AddressNumber | LocalAddress AddressNumber +data Address = ActualAddress ActualAddressNumber | LocalAddress LocalAddressNumber deriving (NFDataX, Generic, Show, Eq) -instance Default Address where - def :: Address - def = ActualAddress (def :: AddressNumber) - data Port (portsNumber :: Nat) = Port { _nodeAddress :: Maybe Address , _portConnectedToId :: IdOfPort portsNumber @@ -29,7 +30,7 @@ $(makeLenses ''Port) data Node portsNumber = Node { _primaryPort :: Port portsNumber , _secondaryPorts :: Vec portsNumber (Maybe (Port portsNumber)) - -- _nodeType :: INNode looks like we need some kind of node label. Info about and reduction rules contained IN + , _nodeType :: NodeTag -- looks like we need some kind of node label. Info about and reduction rules contained IN } deriving (NFDataX, Generic, Show, Eq) @@ -42,7 +43,7 @@ and info about this should be passed to the memory manager. -} data LoadedNode (portsNumber :: Nat) = LoadedNode { _containedNode :: Node portsNumber - , _originalAddress :: Address + , _originalAddress :: ActualAddressNumber } deriving (NFDataX, Generic, Show, Eq) @@ -50,7 +51,7 @@ $(makeLenses ''LoadedNode) -- | Analog of `LoadedNode` with local address. Redundant, just for simplification of signatures. data LocalNode (portsNumber :: Nat) = LocalNode - { _localAddress :: Address + { _localAddress :: LocalAddressNumber , _numberedNode :: Node portsNumber } deriving (NFDataX, Generic, Show, Eq) @@ -63,8 +64,18 @@ isActive :: LoadedNode numberOfPorts -> Bool isActive leftNode rightNode = - leftNodePrimaryPortAddress == Just (rightNode ^. originalAddress) - && rightNodePrimaryPortAddress == Just (leftNode ^. originalAddress) + leftNodePrimaryPortAddress == Just (ActualAddress (rightNode ^. originalAddress)) + && rightNodePrimaryPortAddress == Just (ActualAddress (leftNode ^. originalAddress)) where Port leftNodePrimaryPortAddress _ = leftNode ^. containedNode . primaryPort Port rightNodePrimaryPortAddress _ = rightNode ^. containedNode . primaryPort + +getPortById :: + (KnownNat portsNumber) => + Node portsNumber -> + IdOfPort portsNumber -> + Maybe (Port portsNumber) +getPortById node idOfPort = + case idOfPort of + Primary -> Just $ node ^. primaryPort + Id index -> (node ^. secondaryPorts) !! index From fcc12c1c9ad7515de29141cf63f2dadb4a91cd93 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 28 Oct 2024 15:00:33 +0300 Subject: [PATCH 19/54] Add memory manager --- lamagraph-core/src/Core/MemoryManager.hs | 312 +++++++++++++++++++++-- 1 file changed, 287 insertions(+), 25 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs index d5d142e..48bc71d 100644 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -1,41 +1,303 @@ --- Just to pass CI, updateMM is not implement yet -{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# HLINT ignore "Eta reduce" #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} module Core.MemoryManager where import Clash.Prelude -import Control.Lens (makeLenses, (^.)) +import Control.Lens hiding (ifoldl) import Core.Node -import Core.Reducer -data MemoryManager (cellsNumber :: Nat) = MemoryManager - { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" - , _visitedBitMap :: Vec cellsNumber Bool -- map of Address : Bool. tell smth like "Node by this address has primary port visited" - , _nextAddressToHandle :: Maybe Address -- next Node which has no primary port visited +data EdgeEnd (portsNumber :: Nat) = EdgeEnd + { _addressOfVertex :: AddressNumber + , _idOfPort :: IdOfPort portsNumber } - deriving (Show, Eq, Generic, NFDataX) + deriving (Generic, NFDataX, Show, Eq) + +$(makeLenses ''EdgeEnd) + +data Edge (portsNumber :: Nat) = Edge + { _leftEnd :: EdgeEnd portsNumber + , _rightEnd :: EdgeEnd portsNumber + } + deriving (Generic, NFDataX, Show, Eq) + +$(makeLenses ''Edge) +data ActivePair (portsNumber :: Nat) = ActivePair + { _leftNode :: LoadedNode portsNumber + , _rightNode :: LoadedNode portsNumber + } + deriving (Show, Eq, Generic, NFDataX, Bundle) +$(makeLenses ''ActivePair) +data MemoryManager (cellsNumber :: Nat) (portsNumber :: Nat) = MemoryManager + { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" + , _activePairs :: Vec cellsNumber (Maybe (ActivePair portsNumber)) + , _ram :: ActualAddressNumber -> Node portsNumber + } + deriving (Generic, NFDataX, Bundle) $(makeLenses ''MemoryManager) -data Delta (cellsNumber :: Nat) (portsNumber :: Nat) = Delta - { _appearedNodes :: Vec cellsNumber (Maybe (Node portsNumber)) - , _deletedNodes :: Vec cellsNumber (Maybe (LoadedNode portsNumber)) - , _handledEdge :: Edge -- edge by that happened reduction +data Delta (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = Delta + { _newNodes :: Vec nodesNumber (Maybe (LocalNode portsNumber)) + , _newEdges :: Vec edgesNumber (Maybe (Edge portsNumber)) + , _activePair :: ActivePair portsNumber } deriving (Show, Eq, Generic, NFDataX) +$(makeLenses ''Delta) --- This is strange. -getUnUsedAddress :: - (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16) => MemoryManager cellsNumber -> Maybe Address -getUnUsedAddress memoryManager = address +-- | Get address from memory manager that is not busy. Return `Nothing` if all addresses are busy +getUnusedAddress :: + (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16) => + Vec cellsNumber Bool -> + Maybe ActualAddressNumber +getUnusedAddress busyMap = address where - indexOfUnused = elemIndex False (memoryManager ^. busyBitMap) - address = bitCoerce <$> indexOfUnused :: Maybe Address + indexOfUnused = elemIndex False busyMap + address = bitCoerce <$> indexOfUnused -updateMM :: +-- | Mark given `AddressNumber` as busy or not according to passed flag (`True` means busy) +markAddress :: + (KnownNat cellsNumber) => + Vec cellsNumber Bool -> + Bool -> + ActualAddressNumber -> + Vec cellsNumber Bool +markAddress busyMap marker address = + replace address marker busyMap + +-- | Replace processed active pair at `Nothing` in `Vec` of active pairs +deleteActivePair :: + (KnownNat cellsNumber, KnownNat portsNumber) => + Vec cellsNumber (Maybe (ActivePair portsNumber)) -> + ActivePair portsNumber -> + Vec cellsNumber (Maybe (ActivePair portsNumber)) +deleteActivePair nowActivePairs activePairToDelete = apReplaced + where + apReplaced = case elemIndex (Just activePairToDelete) nowActivePairs of + Nothing -> error "" + Just i -> replace i Nothing nowActivePairs + +-- | Mark `ActivePair`'s place as free +freeUpActivePair :: (KnownNat cellsNumber, KnownNat portsNumber) => - MemoryManager cellsNumber -> - Delta cellsNumber portsNumber -> - MemoryManager cellsNumber -updateMM memoryManager delta = - undefined + Vec cellsNumber Bool -> + ActivePair portsNumber -> + Vec cellsNumber Bool +freeUpActivePair busyMap activePairToFree = markAddress (markAddress busyMap False leftNodeAddress) False rightNodeAddress + where + chooseAddress choice = activePairToFree ^. choice . originalAddress + leftNodeAddress = chooseAddress leftNode + rightNodeAddress = chooseAddress rightNode + +-- | Give unused `AddressNumber` to `LocalNode` +registerAddressNumToNewNode :: + (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16) => + Vec cellsNumber Bool -> + ActualAddressNumber +registerAddressNumToNewNode busyMap = addressNum + where + addressNum = case getUnusedAddress busyMap of + Nothing -> error "Memory space is over" + Just address -> address + +{- | Assign actual `AddressNumber` to `LocalNode` and mark busy bit map according to this. +It is the composition of `registerAddressNumToNewNode` and `markAddress` just for usability +-} +updateFromLocalToLoaded :: + (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16, KnownNat portsNumber) => + Vec cellsNumber Bool -> + LocalNode portsNumber -> + (Vec cellsNumber Bool, (ActualAddressNumber, Node portsNumber)) +updateFromLocalToLoaded busyMap localNode = (newBusyMap, (newAddress, node)) + where + newAddress = registerAddressNumToNewNode busyMap + newBusyMap = markAddress busyMap True newAddress + node = localNode ^. numberedNode + +-- | Update ram function by `Node`. So at given `AddressNumber` it return given `Node`, otherwise there are no changes +updateLoaderByNode :: + (KnownNat portsNumber) => + (ActualAddressNumber -> Node portsNumber) -> + AddressNumber -> + Node portsNumber -> + (ActualAddressNumber -> Node portsNumber) +updateLoaderByNode oldRam newAddress node = newRam + where + newRam address = if address == newAddress then node else oldRam address + +-- | The same as `updateLoaderByNode` but with `LoadedNode` instead of (`AddressNumber` and `Node`) +updateLoaderByLoadedNode :: + (KnownNat portsNumber) => + (ActualAddressNumber -> Node portsNumber) -> + LoadedNode portsNumber -> + (ActualAddressNumber -> Node portsNumber) +updateLoaderByLoadedNode oldRam loadedNode = updateLoaderByNode oldRam (loadedNode ^. originalAddress) (loadedNode ^. containedNode) + +-- | Add `ActivePair` if it appeared after reduction by given `AddressNumber` +updateActivesByGivenAddress :: + (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16, KnownNat portsNumber) => + Vec cellsNumber (Maybe (ActivePair portsNumber)) -> + (AddressNumber -> Node portsNumber) -> + AddressNumber -> + Vec cellsNumber (Maybe (ActivePair portsNumber)) +updateActivesByGivenAddress pairs ramMM addressNumberOfInternalNode = + case internalNode ^. primaryPort . nodeAddress of + Nothing -> error "Port must be connected" -- for now, we need to rewrite it in the future + Just a -> case a of + LocalAddress _ -> error "You can not to update active pairs before load all local nodes" + ActualAddress addrNum -> if isActive lln rln then Just (ActivePair lln rln) +>> pairs else pairs + where + lln = LoadedNode (ramMM addrNum) addrNum + rln = LoadedNode internalNode addressNumberOfInternalNode + where + internalNode = ramMM addressNumberOfInternalNode + +-- | Set concrete `Port` in concrete `Node` according to its type (primary or secondary) +updateOnePort :: + (KnownNat portsNumber) => + Node portsNumber -> + Port portsNumber -> + Node portsNumber +updateOnePort node port = case port ^. portConnectedToId of + Primary -> set primaryPort port node + Id portId -> set secondaryPorts (replace portId (Just port) (node ^. secondaryPorts)) node + +{- | Update `Port` in `Node` that connected by given `Port`. +It may seems strange, that we update not given port, but connected to this. +But it allowed to unify the update of external and internal nodes +-} +updateConnectedToPort :: + (KnownNat portsNumber) => + (LocalAddressNumber -> ActualAddressNumber) -> + (ActualAddressNumber -> Node portsNumber) -> + ActualAddressNumber -> + Port portsNumber -> + LoadedNode portsNumber +updateConnectedToPort localToActual loader nodeAddr port = LoadedNode newConnectedNode addr + where + (oldConnectedNode, addr) = case port ^. nodeAddress of + Nothing -> error "Port must to be connected" + Just a -> case a of + ActualAddress a' -> (loader a', a') + LocalAddress a' -> (loader $ localToActual a', a') + newPort = set nodeAddress (Just $ ActualAddress nodeAddr) port + newConnectedNode = updateOnePort oldConnectedNode newPort + +-- | Update external `LoadedNode`s by `Edge`, i.e. actually connect the nodes on the ports that were connected to the disappeared nodes +updateExternalPortByEdge :: + (KnownNat portsNumber) => + (ActualAddressNumber -> Node portsNumber) -> + Edge portsNumber -> + (LoadedNode portsNumber, LoadedNode portsNumber) +updateExternalPortByEdge oldRam edge = (LoadedNode leftNewNode leftExtNodeAddress, LoadedNode rightNewNode rightExtNodeAddress) + where + leftExtNodeAddress = edge ^. leftEnd . addressOfVertex + rightExtNodeAddress = edge ^. rightEnd . addressOfVertex + leftNewPort = Port (Just $ ActualAddress rightExtNodeAddress) (edge ^. rightEnd . idOfPort) + rightNewPort = Port (Just $ ActualAddress leftExtNodeAddress) (edge ^. leftEnd . idOfPort) + leftNewNode = updateOnePort (oldRam leftExtNodeAddress) leftNewPort + rightNewNode = updateOnePort (oldRam rightExtNodeAddress) rightNewPort + +updateMM :: + forall (cellsNumber :: Nat) (portsNumber :: Nat) (edgeNumber :: Nat) (dom :: Domain). + ( KnownNat cellsNumber + , KnownNat portsNumber + , KnownNat edgeNumber + , 1 <= cellsNumber + , CLog 2 cellsNumber ~ 16 + , 1 <= edgeNumber + , CLog 2 edgeNumber ~ 16 + ) => + Signal dom (MemoryManager cellsNumber portsNumber) -> + Signal dom (Delta cellsNumber edgeNumber portsNumber) -> + Signal dom (MemoryManager cellsNumber portsNumber) +updateMM memoryManager delta = MemoryManager <$> markedBusyBitMap <*> newActives <*> updatedByEdges + where + localNodesSignal = unbundle $ (^. newNodes) <$> delta :: _ (Signal _ _) + activePairSignal = (^. activePair) <$> delta + ramSignal = (^. ram) <$> memoryManager + -- map of local and actual `AddressNumber` + localActualMapDef = undefined + -- removed the processed active pair + pairsAfterDelete = (deleteActivePair . (^. activePairs) <$> memoryManager) <*> activePairSignal + -- freed up space from an active pair + freedFromActivePair = (freeUpActivePair . (^. busyBitMap) <$> memoryManager) <*> activePairSignal + -- gave the local nodes free addresses, marking the occupied ones. Received a marked map address:busy, a list of new nodes with their actual addresses and a map (local address):(actual address) + (markedBusyBitMap, loaded, localActualMap) = + foldl + ( \(busyMap, loadedNodes, localToActual) signalMaybeLocalNode -> + let (newBusyMap, newLoadedNode) = signalMaybeApply signalMaybeLocalNode busyMap + actualAddr = case sequenceA newLoadedNode of + Nothing -> pure Nothing + Just pair -> sequenceA $ Just $ fst <$> pair + newLocalToActual = case sequenceA actualAddr of + Nothing -> localToActual + Just addr -> case sequenceA signalMaybeLocalNode of + Nothing -> localToActual + Just signalLocal -> updateLocalActual <$> localToActual <*> ((^. localAddress) <$> signalLocal) <*> addr + in (newBusyMap, (+>>) <$> newLoadedNode <*> loadedNodes, newLocalToActual) + ) + (freedFromActivePair, newLoadedNodesStart, localActualMapDef) + localNodesSignal + where + newLoadedNodesStart = pure def :: Signal _ (Vec cellsNumber (Maybe _)) + signalMaybeApply signalMaybeLocalNode busyMap = case sequenceA signalMaybeLocalNode of + Nothing -> (busyMap, pure Nothing) + Just signalLocalNode -> + let (signalBusyMap, loadedSignal) = unbundle (updateFromLocalToLoaded <$> busyMap <*> signalLocalNode) + in (signalBusyMap, Just <$> loadedSignal) + -- updated the ram according to internal changes, There are still ports that refer to the local address + updatedByLocalsRam = + foldl + ( \loader signalMaybeLoaded -> + case sequenceA signalMaybeLoaded of + Nothing -> loader + Just signalLoaded -> + let (addrS, nodeS) = unbundle signalLoaded + in updateLoaderByNode <$> loader <*> addrS <*> nodeS + ) + ramSignal + (unbundle loaded) + -- updated the ram so that the ports refer to the actual (non-local) address. The connections of the external nodes have also been updated + updatedByNodesConnection = + foldl + ( \loader addrNode -> case sequenceA addrNode of + Nothing -> loader + Just x -> + let (addr, node) = unbundle x + in foldl + ( \loader' mbPort -> case sequenceA mbPort of + Nothing -> loader' + Just port -> updateLoaderByLoadedNode <$> loader' <*> (updateConnectedToPort <$> localActualMap <*> loader' <*> addr <*> port) + ) + loader + (unbundle ((^. secondaryPorts) <$> node)) + ) + updatedByLocalsRam + (unbundle loaded) + -- updated the ram so that the external nodes, which became actually connected to each other through an edge after reduction, referred to each other by ports + updatedByEdges = + foldl + ( \loader signalMaybeEdge -> case sequenceA signalMaybeEdge of + Nothing -> loader + Just signalEdge -> + let (leftLN, rightLN) = unbundle $ updateExternalPortByEdge <$> loader <*> signalEdge + in updateLoaderByLoadedNode <$> (updateLoaderByLoadedNode <$> loader <*> leftLN) <*> rightLN + ) + updatedByNodesConnection + (unbundle ((^. newEdges) <$> delta)) + -- updated the active pairs + newActives = + foldl + ( \actives signalMaybeLoaded -> + case sequenceA signalMaybeLoaded of + Nothing -> actives + Just signalLoaded -> + let (addrS, _) = unbundle signalLoaded + in updateActivesByGivenAddress <$> actives <*> updatedByEdges <*> addrS + ) + pairsAfterDelete + (unbundle loaded) + updateLocalActual oldMap localAddr actualAddr x = if x == localAddr then actualAddr else oldMap localAddr From ee84822742b341e77a7aa24215b463dacb5fee10 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 28 Oct 2024 15:01:04 +0300 Subject: [PATCH 20/54] Fully redesign reducer --- lamagraph-core/src/Core/Reducer.hs | 254 +++++++++-------------------- 1 file changed, 78 insertions(+), 176 deletions(-) diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index 6886db5..5a38dce 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -1,193 +1,95 @@ -{-# LANGUAGE PartialTypeSignatures #-} -{-# OPTIONS_GHC -Wno-partial-type-signatures #-} - module Core.Reducer where import Clash.Prelude +import Control.Lens (makeLenses, set, (^.)) +import Core.MemoryManager import Core.Node type NumOfNodesToStore = Unsigned 3 type NumOfEdgesToStore = Unsigned 3 -type IdOfPort = Unsigned 3 - -data ReducerStatus - = Work - | Finished - | ErrorHandleSingleNode - | ErrorEmptyLeftNode - deriving (Generic, NFDataX, Show, Eq) - --- | State of the reducer (in terms of mealy automaton). -data ReducerState - = Initial Address - | Empty - | OneNodeToLoad - | Done - | Failed - deriving (Generic, NFDataX, Show, Eq) - -data EdgeEnd = EdgeEnd - { _addressOfVertex :: Address - , _idOfPort :: IdOfPort - } - deriving (Generic, NFDataX, Show, Eq) -data Edge = Edge - { _leftEnd :: EdgeEnd - , _rightEnd :: EdgeEnd - } - deriving (Generic, NFDataX, Show, Eq) +{- | Regulates which external (interface) `Ports` belonged to which `Node` (and in which place) before the reduction. + This is necessary in order to be able to coordinate the interface in the reducer +-} +data OldId portsNumber = LeftLoadedNode (IdOfPort portsNumber) | RightLoadedNode (IdOfPort portsNumber) -data DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts = DataToStore - { _nodes :: Vec maxNumOfNodesToStore (Maybe (LoadedNode numberOfPorts)) - , _edges :: Vec maxNumOfEdgesToStore (Maybe Edge) +-- | Result of abstract reduction rule +data ReduceRuleResult (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = ReduceRuleResult + { _edges :: Vec edgesNumber (Maybe (OldId portsNumber, OldId portsNumber)) + , _nodes :: + Vec nodesNumber (Maybe (LocalNode portsNumber, Vec portsNumber (Maybe (OldId portsNumber, IdOfPort portsNumber)))) } - deriving (Generic, NFDataX, Show, Eq) --- | Select next left `Node` to handle and next `Address` of right `Node` to be loaded. -selectNextLeftNode :: - (KnownNat maxNumOfNodesToStore, KnownNat numberOfPorts, KnownNat maxNumOfEdgesToStore) => - DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts -> - ( Maybe (LoadedNode numberOfPorts, Address) - , DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts - ) -selectNextLeftNode preDataToStore = - case selectedNode of - Nothing -> (Nothing, preDataToStore) - Just (i, node, addressOfNodeToLoad) -> - ( Just (node, addressOfNodeToLoad) - , DataToStore (replace i Nothing $ _nodes preDataToStore) (_edges preDataToStore) - ) - where - handleNode s i mbNode = - mbNode - >>= ( \node -> case selectAddressToLoad node of - Nothing -> s - Just a -> Just (i, node, a) - ) - selectedNode = ifoldl handleNode Nothing $ _nodes preDataToStore +$(makeLenses ''ReduceRuleResult) --- | Do one step of reduction and get info about next possible step. -handle :: - forall - (maxNumOfNodesToStore :: Nat) - (maxNumOfEdgesToStore :: Nat) - (numberOfPorts :: Nat). - (KnownNat maxNumOfNodesToStore, KnownNat numberOfPorts, KnownNat maxNumOfEdgesToStore) => - -- | Left `Node` to handle. - LoadedNode numberOfPorts -> - -- | Right `Node` to handle. - Maybe (LoadedNode numberOfPorts) -> - -- | Next possible Node and Address to handle and result data. - (Maybe (LoadedNode numberOfPorts, Address), DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts) -handle leftNode rightNode = - selectNextLeftNode $ DataToStore (markAllInnerEdges nodes) emptyEdges +{- | Coordinates interface `Port` in `LocalNode`. +I.e. it connects the "hanging" ports from the reduction rule with the `LoadedNode` from the real net +-} +putInterfacesNodeToGlobalNet :: + forall portsNumber. + (KnownNat portsNumber) => + LoadedNode portsNumber -> + LoadedNode portsNumber -> + (LocalNode portsNumber, Vec portsNumber (Maybe (OldId portsNumber, IdOfPort portsNumber))) -> + LocalNode portsNumber +putInterfacesNodeToGlobalNet leftLNode rightLNode (localNode, interfacePortsInfo) = foldl replaceOnePort localNode interfacePortsInfo where - emptyNodes = def :: Vec maxNumOfNodesToStore _ - emptyEdges = def :: Vec maxNumOfEdgesToStore _ - nodes = case rightNode of - Nothing -> Just leftNode +>> emptyNodes - Just _ -> - -- if isActive leftNode n - rightNode +>> Just leftNode +>> emptyNodes -- reduction rules applied here - --- | Type to indicate that all ports that could be handled locally are over. -data NonVisitedOver = No | Yes + replaceOnePort :: LocalNode portsNumber -> Maybe (OldId portsNumber, IdOfPort portsNumber) -> LocalNode portsNumber + replaceOnePort ln maybePortInfo = + case maybePortInfo of + Nothing -> ln + Just (oldPortId, portId) -> + let setPort loadedN idOfLoadedNode = case getPortById (loadedN ^. containedNode) idOfLoadedNode of + Nothing -> error "Port must be connected" + Just portOfLoadedNode -> case portId of + Primary -> set numberedNode (set primaryPort portOfLoadedNode (ln ^. numberedNode)) ln + Id index -> + set + numberedNode + (set secondaryPorts (replace index (Just portOfLoadedNode) (ln ^. numberedNode . secondaryPorts)) (ln ^. numberedNode)) + ln + in case oldPortId of + LeftLoadedNode i -> setPort leftLNode i + RightLoadedNode i -> setPort rightLNode i --- | Transition function in mealy automaton. -mealyFunction :: - ( KnownNat maxNumOfNodesToStore - , KnownNat maxNumOfEdgesToStore - , KnownNat numberOfPorts - ) => - -- | State of reducer and automaton. - ReducerState -> - -- | Input. - ( -- Left and right `Node` to reduce. - (Maybe (LoadedNode numberOfPorts), Maybe (LoadedNode numberOfPorts)) - , ReducerStatus - , Maybe Address - -- Address from memory manager if reducer cannot find next `Address` locally. - ) -> - -- | (state, output). - ( ReducerState - , ( Maybe (DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts) - , ReducerStatus - , Maybe (LoadedNode numberOfPorts) - , -- Next left `Node` - Maybe Address - , -- Next `Address` to load - NonVisitedOver - ) - ) -mealyFunction - state - ( (mbLeftNode, mbLoadedNode) - , status - , addressOfNodeWithUnvisitedEdges - ) = - case state of - Initial addressOfFirstNodeToLoad -> (Empty, (Nothing, Work, Nothing, Just addressOfFirstNodeToLoad, No)) - Empty -> - case mbLoadedNode of - Nothing -> - (Failed, (Nothing, ErrorEmptyLeftNode, Nothing, Nothing, No)) - Just loadedNode -> - case addressToLoad of - Just _ -> - (OneNodeToLoad, (Nothing, Work, Just loadedNode, addressToLoad, No)) - Nothing -> - case mbLeftNode of - Just leftNode' -> - case infoAboutNextNodes of - Just (_, _) -> - (Failed, (Nothing, ErrorHandleSingleNode, Nothing, Nothing, No)) - Nothing -> - (Empty, (Just dataToStore, Work, Nothing, addressOfNodeWithUnvisitedEdges, Yes)) - where - (infoAboutNextNodes, dataToStore) = handle leftNode' Nothing - Nothing -> - (Failed, (Nothing, ErrorEmptyLeftNode, Nothing, Nothing, No)) - where - addressToLoad = selectAddressToLoad loadedNode - OneNodeToLoad -> - case mbLeftNode of - Just leftNode -> - case infoAboutNextNodes of - Just (nextLeftNode, nextAddressToLoad) -> - (OneNodeToLoad, (Just dataToStore, Work, Just nextLeftNode, Just nextAddressToLoad, No)) - Nothing -> - (Empty, (Just dataToStore, Work, Nothing, addressOfNodeWithUnvisitedEdges, Yes)) - where - (infoAboutNextNodes, dataToStore) = handle leftNode mbLoadedNode - Nothing -> (Failed, (Nothing, ErrorEmptyLeftNode, Nothing, Nothing, No)) - Failed -> (Failed, (Nothing, status, Nothing, Nothing, No)) - Done -> (Done, (Nothing, Finished, Nothing, Nothing, No)) +{- | Coordinates interface `Port` in disappeared `Node`. +I.e. it connects relevant external `LoadedNode` together (making `Edge`) +-} +putInterfacesEdgeToGlobalNet :: + forall portsNumber. + (KnownNat portsNumber) => + LoadedNode portsNumber -> + LoadedNode portsNumber -> + Maybe (OldId portsNumber, OldId portsNumber) -> + Maybe (Edge portsNumber) +putInterfacesEdgeToGlobalNet leftLNode rightLNode info = case info of + Nothing -> Nothing + Just (leftEndPortInfo, rightEndPortInfo) -> Just $ Edge lEnd rEnd + where + constructEnd portInfo = case portInfo of + LeftLoadedNode portId -> EdgeEnd (leftLNode ^. originalAddress) portId + RightLoadedNode portId -> EdgeEnd (rightLNode ^. originalAddress) portId + lEnd = constructEnd leftEndPortInfo + rEnd = constructEnd rightEndPortInfo --- | Reducer function. Steps over Interaction Net and apply reduction rules until is possible. reducer :: - ( KnownDomain dom - , HiddenClockResetEnable dom - , KnownNat maxNumOfNodesToStore - , KnownNat maxNumOfEdgesToStore - , KnownNat numberOfPorts - ) => - -- | Address of first `Node` to load. - Address -> - -- | Function to load `Node` from RAM. - (Signal dom (Maybe Address) -> Signal dom (Maybe (LoadedNode numberOfPorts))) -> - -- | Function that can give next possible `Address` to reduce. - -- It will come from memory manager which can see all Interaction Net. - (Signal dom NonVisitedOver -> Signal dom (Maybe Address)) -> - Signal dom (Maybe (DataToStore maxNumOfNodesToStore maxNumOfEdgesToStore numberOfPorts), ReducerStatus) -reducer addressOfFirstNodeToLoad nodeLoader nonVisitedNodesProvider = - bundle (dataToStore, actualReducerStatus) + forall dom portsNumber nodesNumber edgesNumber. + (KnownDomain dom, KnownNat portsNumber, KnownNat nodesNumber, KnownNat edgesNumber) => + ((NodeTag, NodeTag) -> ReduceRuleResult nodesNumber edgesNumber portsNumber) -> + Signal dom (ActivePair portsNumber) -> + Signal dom (Delta nodesNumber edgesNumber portsNumber) +reducer transFunction activeP = Delta <$> nodesForDelta <*> edgesForDelta <*> activeP where - (dataToStore, actualReducerStatus, nextLeftNode, addressOfNextNodeToLoad, isNonVisitedNodeUsed) = unbundle mealyOutput - mealyOutput = - mealy mealyFunction (Initial addressOfFirstNodeToLoad) mealyInput - mealyInput = - bundle (bundle (leftNode, loadedNode), status, nonVisitedNodesProvider isNonVisitedNodeUsed) - loadedNode = register Nothing (nodeLoader addressOfNextNodeToLoad) - leftNode = register Nothing nextLeftNode - status = register Work actualReducerStatus + leftLNode = (^. leftNode) <$> activeP + rightLNode = (^. rightNode) <$> activeP + reduceRuleRes = transFunction <$> bundle ((^. containedNode . nodeType) <$> leftLNode, (^. containedNode . nodeType) <$> rightLNode) + nodesForDelta = + bundle $ + map + ( \signalMaybeNodesInterfaceInfo -> case sequenceA signalMaybeNodesInterfaceInfo of + Nothing -> pure Nothing + Just signalNodesInterfaceInfo -> sequenceA (Just (putInterfacesNodeToGlobalNet <$> leftLNode <*> rightLNode <*> signalNodesInterfaceInfo)) + ) + (unbundle $ (^. nodes) <$> reduceRuleRes) + edgesForDelta = + bundle $ map (putInterfacesEdgeToGlobalNet <$> leftLNode <*> rightLNode <*>) (unbundle $ (^. edges) <$> reduceRuleRes) From dfd092130dc06edcb79a0eea5473261966cdb6a3 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 28 Oct 2024 15:11:42 +0300 Subject: [PATCH 21/54] Comment irrelevant (all) tests --- lamagraph-core/tests/NodeGenerate.hs | 114 +++++++------- lamagraph-core/tests/Tests/Core/Node.hs | 194 ++++++++++++------------ 2 files changed, 154 insertions(+), 154 deletions(-) diff --git a/lamagraph-core/tests/NodeGenerate.hs b/lamagraph-core/tests/NodeGenerate.hs index 18e2027..dc93d26 100644 --- a/lamagraph-core/tests/NodeGenerate.hs +++ b/lamagraph-core/tests/NodeGenerate.hs @@ -3,60 +3,60 @@ module NodeGenerate where -import Clash.Hedgehog.Sized.Unsigned -import Clash.Hedgehog.Sized.Vector -import Clash.Prelude -import qualified Clash.Sized.Vector as Vec -import Core.Node -import qualified Hedgehog.Gen as Gen -import Hedgehog.Internal.Gen (MonadGen) -import qualified Hedgehog.Range as Range -import qualified Prelude - -type UnsignedRange (n :: Nat) = Range.Range (Unsigned n) - -genAddress :: (MonadGen m) => m Address -genAddress = genUnsigned (Range.linearBounded :: UnsignedRange 16) - --- | Honest generating uniq addresses. May be very slow. -genUniqAddresses :: (MonadGen m, KnownNat n) => m (Vec n Address) -genUniqAddresses = Gen.filterT addressesAreUniq (genVec genAddress) - where - addressesAreUniq vec = allDifferent $ toList vec - allDifferent list = case list of - [] -> True - x : xs -> x `notElem` xs && allDifferent xs - -genPort :: (MonadGen m) => m Port -genPort = do - address <- genAddress - Port address <$> Gen.bool - -genPortVisitedFlag :: (MonadGen m) => Bool -> m Port -genPortVisitedFlag visited = do - address <- genAddress - return $ Port address visited - -type GenNode (n :: Nat) = forall m. (MonadGen m) => m (Node n) - -genNode :: forall m n. (MonadGen m, KnownNat n) => m (Node n) -genNode = do - port <- genPort - ports <- genMbObjectsVec genPort :: _ (Vec n _) - return $ Node port ports - -genLoadedNodeByGivenAddresses :: (MonadGen m) => Address -> Address -> [Address] -> m (LoadedNode 5) -genLoadedNodeByGivenAddresses nodeAddr prPortAddr secPortsAddr = - return $ LoadedNode (Node (Port prPortAddr False) secPorts) nodeAddr - where - secPorts = Vec.unsafeFromList (mkPorts secPortsAddr) :: Vec 5 (Maybe Port) - mkPorts = Prelude.map (\a -> Just (Port a False)) - -genMbObjectsVec :: forall m n a. (MonadGen m, KnownNat n) => m a -> m (Vec n (Maybe a)) -genMbObjectsVec genObjectFunc = genVec genFunc - where - genFunc = - Gen.frequency - [ (70, Just <$> genObjectFunc) - , (30, return Nothing) - ] +-- import Clash.Hedgehog.Sized.Unsigned +-- import Clash.Hedgehog.Sized.Vector +-- import Clash.Prelude +-- import qualified Clash.Sized.Vector as Vec +-- import Core.Node +-- import qualified Hedgehog.Gen as Gen +-- import Hedgehog.Internal.Gen (MonadGen) +-- import qualified Hedgehog.Range as Range +-- import qualified Prelude + +-- type UnsignedRange (n :: Nat) = Range.Range (Unsigned n) + +-- genAddress :: (MonadGen m) => m Address +-- genAddress = genUnsigned (Range.linearBounded :: UnsignedRange 16) + +-- -- | Honest generating uniq addresses. May be very slow. +-- genUniqAddresses :: (MonadGen m, KnownNat n) => m (Vec n Address) +-- genUniqAddresses = Gen.filterT addressesAreUniq (genVec genAddress) +-- where +-- addressesAreUniq vec = allDifferent $ toList vec +-- allDifferent list = case list of +-- [] -> True +-- x : xs -> x `notElem` xs && allDifferent xs + +-- genPort :: (MonadGen m) => m Port +-- genPort = do +-- address <- genAddress +-- Port address <$> Gen.bool + +-- genPortVisitedFlag :: (MonadGen m) => Bool -> m Port +-- genPortVisitedFlag visited = do +-- address <- genAddress +-- return $ Port address visited + +-- type GenNode (n :: Nat) = forall m. (MonadGen m) => m (Node n) + +-- genNode :: forall m n. (MonadGen m, KnownNat n) => m (Node n) +-- genNode = do +-- port <- genPort +-- ports <- genMbObjectsVec genPort :: _ (Vec n _) +-- return $ Node port ports + +-- genLoadedNodeByGivenAddresses :: (MonadGen m) => Address -> Address -> [Address] -> m (LoadedNode 5) +-- genLoadedNodeByGivenAddresses nodeAddr prPortAddr secPortsAddr = +-- return $ LoadedNode (Node (Port prPortAddr False) secPorts) nodeAddr +-- where +-- secPorts = Vec.unsafeFromList (mkPorts secPortsAddr) :: Vec 5 (Maybe Port) +-- mkPorts = Prelude.map (\a -> Just (Port a False)) + +-- genMbObjectsVec :: forall m n a. (MonadGen m, KnownNat n) => m a -> m (Vec n (Maybe a)) +-- genMbObjectsVec genObjectFunc = genVec genFunc +-- where +-- genFunc = +-- Gen.frequency +-- [ (70, Just <$> genObjectFunc) +-- , (30, return Nothing) +-- ] diff --git a/lamagraph-core/tests/Tests/Core/Node.hs b/lamagraph-core/tests/Tests/Core/Node.hs index 64cd239..1d5baad 100644 --- a/lamagraph-core/tests/Tests/Core/Node.hs +++ b/lamagraph-core/tests/Tests/Core/Node.hs @@ -1,5 +1,6 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Tests.Core.Node where @@ -8,118 +9,117 @@ import qualified Clash.Sized.Vector as Vec import Core.Node import qualified Hedgehog as H import qualified Hedgehog.Gen as Gen -import NodeGenerate (genAddress, genLoadedNodeByGivenAddresses, genMbObjectsVec, genPortVisitedFlag) import Test.Tasty import Test.Tasty.Hedgehog import Test.Tasty.TH import Prelude -prop_isPortToLoad_diffAddr :: H.Property -prop_isPortToLoad_diffAddr = H.property $ do - address <- H.forAll genAddress - isVisited <- H.forAll Gen.bool - let - port = Port address isVisited - node = Node port C.Nil - loadedNode = LoadedNode node (address + 1) +-- prop_isPortToLoad_diffAddr :: H.Property +-- prop_isPortToLoad_diffAddr = H.property $ do +-- address <- H.forAll genAddress +-- isVisited <- H.forAll Gen.bool +-- let +-- port = Port address isVisited +-- node = Node port C.Nil +-- loadedNode = LoadedNode node (address + 1) - isPortToLoad loadedNode port H.=== not isVisited +-- isPortToLoad loadedNode port H.=== not isVisited -prop_isPortToLoad_sameAddr :: H.Property -prop_isPortToLoad_sameAddr = H.property $ do - address <- H.forAll genAddress - isVisited <- H.forAll Gen.bool - let - port = Port address isVisited - node = Node port C.Nil - loadedNode = LoadedNode node address - isPortToLoad loadedNode port H.=== False +-- prop_isPortToLoad_sameAddr :: H.Property +-- prop_isPortToLoad_sameAddr = H.property $ do +-- address <- H.forAll genAddress +-- isVisited <- H.forAll Gen.bool +-- let +-- port = Port address isVisited +-- node = Node port C.Nil +-- loadedNode = LoadedNode node address +-- isPortToLoad loadedNode port H.=== False -prop_isActive_crossreference :: H.Property -prop_isActive_crossreference = H.property $ do - leftAddress <- H.forAll genAddress - rightAddress <- H.forAll genAddress - let - leftPrimPort = Port rightAddress False - rightPrimPort = Port leftAddress False - leftNode = Node leftPrimPort C.Nil - rightNode = Node rightPrimPort C.Nil - leftLoadedNode = LoadedNode leftNode leftAddress - rightLoadedNode = LoadedNode rightNode rightAddress - H.assert $ isActive leftLoadedNode rightLoadedNode +-- prop_isActive_crossreference :: H.Property +-- prop_isActive_crossreference = H.property $ do +-- leftAddress <- H.forAll genAddress +-- rightAddress <- H.forAll genAddress +-- let +-- leftPrimPort = Port rightAddress False +-- rightPrimPort = Port leftAddress False +-- leftNode = Node leftPrimPort C.Nil +-- rightNode = Node rightPrimPort C.Nil +-- leftLoadedNode = LoadedNode leftNode leftAddress +-- rightLoadedNode = LoadedNode rightNode rightAddress +-- H.assert $ isActive leftLoadedNode rightLoadedNode -prop_isActive_random :: H.Property -prop_isActive_random = H.property $ do - leftAddress <- H.forAll genAddress - rightAddress <- H.forAll genAddress - leftPortAddr <- H.forAll genAddress - rightPortAddr <- H.forAll genAddress - leftIsVisited <- H.forAll Gen.bool - rightIsVisited <- H.forAll Gen.bool - let - leftPrimPort = Port leftPortAddr leftIsVisited - leftNode = Node leftPrimPort C.Nil - leftLoadedNode = LoadedNode leftNode leftAddress - rightPrimPort = Port rightPortAddr rightIsVisited - rightNode = Node rightPrimPort C.Nil - rightLoadedNode = LoadedNode rightNode rightAddress - isActive leftLoadedNode rightLoadedNode H.=== (leftAddress == rightPortAddr && rightAddress == leftPortAddr) +-- prop_isActive_random :: H.Property +-- prop_isActive_random = H.property $ do +-- leftAddress <- H.forAll genAddress +-- rightAddress <- H.forAll genAddress +-- leftPortAddr <- H.forAll genAddress +-- rightPortAddr <- H.forAll genAddress +-- leftIsVisited <- H.forAll Gen.bool +-- rightIsVisited <- H.forAll Gen.bool +-- let +-- leftPrimPort = Port leftPortAddr leftIsVisited +-- leftNode = Node leftPrimPort C.Nil +-- leftLoadedNode = LoadedNode leftNode leftAddress +-- rightPrimPort = Port rightPortAddr rightIsVisited +-- rightNode = Node rightPrimPort C.Nil +-- rightLoadedNode = LoadedNode rightNode rightAddress +-- isActive leftLoadedNode rightLoadedNode H.=== (leftAddress == rightPortAddr && rightAddress == leftPortAddr) -prop_selectAddressToLoad_primary_unvisited :: H.Property -prop_selectAddressToLoad_primary_unvisited = H.property $ do - nodeAddress <- H.forAll genAddress - portTargetAddress <- H.forAll genAddress - let - port = Port portTargetAddress False - node = Node port C.Nil - loadedNode = LoadedNode node nodeAddress - case selectAddressToLoad loadedNode of - Nothing -> nodeAddress H.=== portTargetAddress - Just address -> address H.=== portTargetAddress +-- prop_selectAddressToLoad_primary_unvisited :: H.Property +-- prop_selectAddressToLoad_primary_unvisited = H.property $ do +-- nodeAddress <- H.forAll genAddress +-- portTargetAddress <- H.forAll genAddress +-- let +-- port = Port portTargetAddress False +-- node = Node port C.Nil +-- loadedNode = LoadedNode node nodeAddress +-- case selectAddressToLoad loadedNode of +-- Nothing -> nodeAddress H.=== portTargetAddress +-- Just address -> address H.=== portTargetAddress -prop_selectAddressToLoad_all_visited :: H.Property -prop_selectAddressToLoad_all_visited = H.property $ do - primPort <- H.forAll $ genPortVisitedFlag True - secondaryPortsVec <- H.forAll $ genMbObjectsVec (genPortVisitedFlag True) :: _ (C.Vec 10 _) -- 10 is random number, it can be changed - address <- H.forAll genAddress - let - node = Node primPort secondaryPortsVec - loadedNode = LoadedNode node address - selectAddressToLoad loadedNode H.=== Nothing +-- prop_selectAddressToLoad_all_visited :: H.Property +-- prop_selectAddressToLoad_all_visited = H.property $ do +-- primPort <- H.forAll $ genPortVisitedFlag True +-- secondaryPortsVec <- H.forAll $ genMbObjectsVec (genPortVisitedFlag True) :: _ (C.Vec 10 _) -- 10 is random number, it can be changed +-- address <- H.forAll genAddress +-- let +-- node = Node primPort secondaryPortsVec +-- loadedNode = LoadedNode node address +-- selectAddressToLoad loadedNode H.=== Nothing -prop_markAllInnerEdges_empty_vec_of_nodes :: H.Property -prop_markAllInnerEdges_empty_vec_of_nodes = H.property $ do - let nodes = C.def :: C.Vec 10 (Maybe (LoadedNode 10)) - nodes H.=== markAllInnerEdges nodes +-- prop_markAllInnerEdges_empty_vec_of_nodes :: H.Property +-- prop_markAllInnerEdges_empty_vec_of_nodes = H.property $ do +-- let nodes = C.def :: C.Vec 10 (Maybe (LoadedNode 10)) +-- nodes H.=== markAllInnerEdges nodes -prop_markAllInnerEdges_uniq_addresses :: H.Property -prop_markAllInnerEdges_uniq_addresses = H.property $ do - let - uniqAddresses = C.iterateI (+ 1) 1 :: C.Vec 21 Address -- it can be obtained by using function genUniqAddresses, but it is very slow - preDataToGenLoadedNodes = window 7 $ Vec.toList uniqAddresses - listOfLoadedNodesGen = map genLoadedNode preDataToGenLoadedNodes - genVecOfUniqLoadedNodes = sequence $ Vec.unsafeFromList listOfLoadedNodesGen :: H.Gen (C.Vec 3 (LoadedNode 5)) - vecOfUniqLoadedNodes <- H.forAll genVecOfUniqLoadedNodes - let vecOfMbUniqLoadedNodes = Just <$> vecOfUniqLoadedNodes - markAllInnerEdges vecOfMbUniqLoadedNodes H.=== vecOfMbUniqLoadedNodes - where - window size list = case splitAt size list of - ([], []) -> [] - (xs, remainder) -> xs : window size remainder - genLoadedNode list = genLoadedNodeByGivenAddresses (head list) (list !! 1) (drop 2 list) +-- prop_markAllInnerEdges_uniq_addresses :: H.Property +-- prop_markAllInnerEdges_uniq_addresses = H.property $ do +-- let +-- uniqAddresses = C.iterateI (+ 1) 1 :: C.Vec 21 Address -- it can be obtained by using function genUniqAddresses, but it is very slow +-- preDataToGenLoadedNodes = window 7 $ Vec.toList uniqAddresses +-- listOfLoadedNodesGen = map genLoadedNode preDataToGenLoadedNodes +-- genVecOfUniqLoadedNodes = sequence $ Vec.unsafeFromList listOfLoadedNodesGen :: H.Gen (C.Vec 3 (LoadedNode 5)) +-- vecOfUniqLoadedNodes <- H.forAll genVecOfUniqLoadedNodes +-- let vecOfMbUniqLoadedNodes = Just <$> vecOfUniqLoadedNodes +-- markAllInnerEdges vecOfMbUniqLoadedNodes H.=== vecOfMbUniqLoadedNodes +-- where +-- window size list = case splitAt size list of +-- ([], []) -> [] +-- (xs, remainder) -> xs : window size remainder +-- genLoadedNode list = genLoadedNodeByGivenAddresses (head list) (list !! 1) (drop 2 list) -prop_markAllInnerEdges_crossreference :: H.Property -prop_markAllInnerEdges_crossreference = H.property $ do - addressOfNode1 <- H.forAll genAddress - addressOfNode2 <- H.forAll genAddress - port1 <- H.forAll $ genPortVisitedFlag True - let - loadedNode1 = Just $ LoadedNode (Node port1 C.Nil) addressOfNode1 - loadedNode2 = Just $ LoadedNode (Node (Port addressOfNode1 False) C.Nil) addressOfNode2 - expectedResult = loadedNode1 C.:> Just (LoadedNode (Node (Port addressOfNode1 True) C.Nil) addressOfNode2) C.:> C.Nil - actualResult = markAllInnerEdges (loadedNode1 C.:> loadedNode2 C.:> C.Nil) +-- prop_markAllInnerEdges_crossreference :: H.Property +-- prop_markAllInnerEdges_crossreference = H.property $ do +-- addressOfNode1 <- H.forAll genAddress +-- addressOfNode2 <- H.forAll genAddress +-- port1 <- H.forAll $ genPortVisitedFlag True +-- let +-- loadedNode1 = Just $ LoadedNode (Node port1 C.Nil) addressOfNode1 +-- loadedNode2 = Just $ LoadedNode (Node (Port addressOfNode1 False) C.Nil) addressOfNode2 +-- expectedResult = loadedNode1 C.:> Just (LoadedNode (Node (Port addressOfNode1 True) C.Nil) addressOfNode2) C.:> C.Nil +-- actualResult = markAllInnerEdges (loadedNode1 C.:> loadedNode2 C.:> C.Nil) - actualResult H.=== expectedResult +-- actualResult H.=== expectedResult accumTests :: TestTree accumTests = $(testGroupGenerator) From 503c9a1fb0362e94861a248c29da58d324aba823 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 28 Oct 2024 16:36:21 +0300 Subject: [PATCH 22/54] Change default json formatter --- .vscode/settings.json | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index aab4e1c..f5792f9 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -35,13 +35,22 @@ "**/*.o-boot": true, "**/*.hi-boot": true }, - "cSpell.words": ["Lamagraph"], + "cSpell.words": [ + "Lamagraph" + ], "[alex]": { "editor.tabSize": 2, - "editor.rulers": [120] + "editor.rulers": [ + 120 + ] }, "[happy]": { "editor.tabSize": 2, - "editor.rulers": [120] + "editor.rulers": [ + 120 + ] + }, + "[jsonc]": { + "editor.defaultFormatter": "vscode.json-language-features" } } From 6c44b6a36216b5fa5b9b14e2a375ee5ad6103fbc Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Thu, 7 Nov 2024 18:08:02 +0300 Subject: [PATCH 23/54] Add simple vector-based key-value storage --- lamagraph-core/lamagraph-core.cabal | 1 + lamagraph-core/src/Core/Map.hs | 56 +++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+) create mode 100644 lamagraph-core/src/Core/Map.hs diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index acfa10b..4d4fa04 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -89,6 +89,7 @@ library Core.Node Core.Reducer Core.MemoryManager + Core.Map default-language: Haskell2010 -- Builds the executable 'clash', with lamagraph-core project in scope diff --git a/lamagraph-core/src/Core/Map.hs b/lamagraph-core/src/Core/Map.hs new file mode 100644 index 0000000..2f4303c --- /dev/null +++ b/lamagraph-core/src/Core/Map.hs @@ -0,0 +1,56 @@ +module Core.Map (Map, findByKey, changeValueByKey) where + +import Clash.Prelude +import Core.Node + +{- | key-value store based on `Vec`. Key is `AddressNumber`, it has linear time to find or change element. +But iterate (such as map or fold) by value and key is easy. +It assumed that `size` is small +-} +type Map (size :: Nat) v = (Vec size (Maybe (AddressNumber, Maybe v))) + +findByKey :: + (KnownNat size) => + Map size v -> + AddressNumber -> + Maybe v +findByKey dict key = case dict of + Nil -> Nothing + (Just (k, v) `Cons` t) -> if k == key then v else findByKey t key + (Nothing `Cons` t) -> findByKey t key + +-- | Update or insert (by applying function to `Nothing`) value by the key +changeValueByKey :: + (KnownNat size, Eq v) => + Map size v -> + (Maybe v -> Maybe v) -> + AddressNumber -> + Map size v +changeValueByKey dict func key = if dict /= updated then updated else inserted + where + updated = tryToUpdate key func dict + inserted = insertInFree key (func Nothing) dict + +-- | Try to update (by applying the function) value by key. It do nothing if there is no value be the key in the `Map` +tryToUpdate :: + AddressNumber -> + (Maybe v -> Maybe v) -> + Map size v -> + Map size v +tryToUpdate key func dict = case dict of + h `Cons` t -> case h of + Nothing -> h `Cons` tryToUpdate key func t + Just (k, v) -> if k == key then Just (k, func v) `Cons` t else h `Cons` tryToUpdate key func t + Nil -> Nil + +-- | Insert key-value pair in the free space +insertInFree :: + AddressNumber -> + Maybe v -> + Map size v -> + Map size v +insertInFree key value dict = case dict of + h `Cons` t -> case h of + Nothing -> Just (key, value) `Cons` t + Just _ -> h `Cons` insertInFree key value t + Nil -> error "All addresses are written" From 8c684c29260a7e30ffad1e926ecbb5086332fc98 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Thu, 7 Nov 2024 18:10:35 +0300 Subject: [PATCH 24/54] Replace Address to AddressNum in Loader and unify LoadedNode with LocalNode --- lamagraph-core/src/Core/Loader.hs | 2 +- lamagraph-core/src/Core/Node.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lamagraph-core/src/Core/Loader.hs b/lamagraph-core/src/Core/Loader.hs index 95d9383..68b2911 100644 --- a/lamagraph-core/src/Core/Loader.hs +++ b/lamagraph-core/src/Core/Loader.hs @@ -15,7 +15,7 @@ loader :: loader ram mbAddressNumberToLoad = mkLoadedNode <$> mbNode <*> mbAddressNumberToLoad where - mkLoadedNode node address = LoadedNode <$> node <*> (ActualAddress <$> address) + mkLoadedNode node address = LoadedNode <$> node <*> address mbNode = case sequenceA mbAddressNumberToLoad of Nothing -> pure Nothing Just n -> sequenceA $ Just (ram n) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index af16d00..1bc8000 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -51,8 +51,8 @@ $(makeLenses ''LoadedNode) -- | Analog of `LoadedNode` with local address. Redundant, just for simplification of signatures. data LocalNode (portsNumber :: Nat) = LocalNode - { _localAddress :: LocalAddressNumber - , _numberedNode :: Node portsNumber + { _numberedNode :: Node portsNumber + , _localAddress :: LocalAddressNumber } deriving (NFDataX, Generic, Show, Eq) From f1d32acd8f7e49d7498876fc6132563ac101eae7 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Thu, 7 Nov 2024 18:12:52 +0300 Subject: [PATCH 25/54] Rework memory manager update to minimize usage of RAM --- lamagraph-core/src/Core/MemoryManager.hs | 347 ++++++++++++++--------- 1 file changed, 214 insertions(+), 133 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs index 48bc71d..45d803c 100644 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -1,12 +1,16 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE LambdaCase #-} {-# HLINT ignore "Eta reduce" #-} {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} module Core.MemoryManager where import Clash.Prelude import Control.Lens hiding (ifoldl) +import Core.Map import Core.Node data EdgeEnd (portsNumber :: Nat) = EdgeEnd @@ -31,10 +35,10 @@ data ActivePair (portsNumber :: Nat) = ActivePair deriving (Show, Eq, Generic, NFDataX, Bundle) $(makeLenses ''ActivePair) -data MemoryManager (cellsNumber :: Nat) (portsNumber :: Nat) = MemoryManager +data MemoryManager (cellsNumber :: Nat) -- (portsNumber :: Nat) + = MemoryManager { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" - , _activePairs :: Vec cellsNumber (Maybe (ActivePair portsNumber)) - , _ram :: ActualAddressNumber -> Node portsNumber + , _activePairs :: Vec cellsNumber Bool } deriving (Generic, NFDataX, Bundle) $(makeLenses ''MemoryManager) @@ -70,14 +74,22 @@ markAddress busyMap marker address = -- | Replace processed active pair at `Nothing` in `Vec` of active pairs deleteActivePair :: (KnownNat cellsNumber, KnownNat portsNumber) => - Vec cellsNumber (Maybe (ActivePair portsNumber)) -> + Vec cellsNumber Bool -> ActivePair portsNumber -> - Vec cellsNumber (Maybe (ActivePair portsNumber)) -deleteActivePair nowActivePairs activePairToDelete = apReplaced + Vec cellsNumber Bool +deleteActivePair oldActivePairs activePairToDelete = + if leftInVec `xor` rightInVec + then newActivePairs + else error "In active pairs map should be exact one address" where - apReplaced = case elemIndex (Just activePairToDelete) nowActivePairs of - Nothing -> error "" - Just i -> replace i Nothing nowActivePairs + leftInVec = oldActivePairs !! (activePairToDelete ^. leftNode . originalAddress) + rightInVec = oldActivePairs !! (activePairToDelete ^. rightNode . originalAddress) + newActivePairs = + if leftInVec + then + replace (activePairToDelete ^. leftNode . originalAddress) False oldActivePairs + else + replace (activePairToDelete ^. rightNode . originalAddress) False oldActivePairs -- | Mark `ActivePair`'s place as free freeUpActivePair :: @@ -109,99 +121,120 @@ updateFromLocalToLoaded :: (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16, KnownNat portsNumber) => Vec cellsNumber Bool -> LocalNode portsNumber -> - (Vec cellsNumber Bool, (ActualAddressNumber, Node portsNumber)) -updateFromLocalToLoaded busyMap localNode = (newBusyMap, (newAddress, node)) + (Vec cellsNumber Bool, LoadedNode portsNumber) +updateFromLocalToLoaded busyMap localNode = (newBusyMap, LoadedNode node newAddress) where newAddress = registerAddressNumToNewNode busyMap newBusyMap = markAddress busyMap True newAddress node = localNode ^. numberedNode --- | Update ram function by `Node`. So at given `AddressNumber` it return given `Node`, otherwise there are no changes -updateLoaderByNode :: - (KnownNat portsNumber) => - (ActualAddressNumber -> Node portsNumber) -> - AddressNumber -> - Node portsNumber -> - (ActualAddressNumber -> Node portsNumber) -updateLoaderByNode oldRam newAddress node = newRam - where - newRam address = if address == newAddress then node else oldRam address - --- | The same as `updateLoaderByNode` but with `LoadedNode` instead of (`AddressNumber` and `Node`) -updateLoaderByLoadedNode :: - (KnownNat portsNumber) => - (ActualAddressNumber -> Node portsNumber) -> - LoadedNode portsNumber -> - (ActualAddressNumber -> Node portsNumber) -updateLoaderByLoadedNode oldRam loadedNode = updateLoaderByNode oldRam (loadedNode ^. originalAddress) (loadedNode ^. containedNode) +-- | Data to accumulate all `Port` changes of the `Node` +data NodePortsInfo (portsNumber :: Nat) + = NodePortInfo + { _secP :: Vec portsNumber (Maybe (Port portsNumber)) + , _primeP :: Maybe (Port portsNumber) + } + deriving (Show, Eq, Generic, NFDataX, Default) --- | Add `ActivePair` if it appeared after reduction by given `AddressNumber` -updateActivesByGivenAddress :: - (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16, KnownNat portsNumber) => - Vec cellsNumber (Maybe (ActivePair portsNumber)) -> - (AddressNumber -> Node portsNumber) -> - AddressNumber -> - Vec cellsNumber (Maybe (ActivePair portsNumber)) -updateActivesByGivenAddress pairs ramMM addressNumberOfInternalNode = - case internalNode ^. primaryPort . nodeAddress of - Nothing -> error "Port must be connected" -- for now, we need to rewrite it in the future - Just a -> case a of - LocalAddress _ -> error "You can not to update active pairs before load all local nodes" - ActualAddress addrNum -> if isActive lln rln then Just (ActivePair lln rln) +>> pairs else pairs - where - lln = LoadedNode (ramMM addrNum) addrNum - rln = LoadedNode internalNode addressNumberOfInternalNode - where - internalNode = ramMM addressNumberOfInternalNode +$(makeLenses ''NodePortsInfo) --- | Set concrete `Port` in concrete `Node` according to its type (primary or secondary) -updateOnePort :: +-- | Update `Port`s of `Node` by `NodePortsInfo` +updateNode :: (KnownNat portsNumber) => Node portsNumber -> - Port portsNumber -> + NodePortsInfo portsNumber -> Node portsNumber -updateOnePort node port = case port ^. portConnectedToId of - Primary -> set primaryPort port node - Id portId -> set secondaryPorts (replace portId (Just port) (node ^. secondaryPorts)) node +updateNode oldNode (NodePortInfo maybeSecPortsAddr maybePrimaryPort) = + set primaryPort newPrimPort (set secondaryPorts newSecPorts oldNode) + where + newSecPorts = + zipWith + (<|>) + maybeSecPortsAddr + (oldNode ^. secondaryPorts) + newPrimPort = case maybePrimaryPort of + Nothing -> oldNode ^. primaryPort + Just primPort -> primPort + +-- | The flag to distinguish between nodes that need to be loaded from ram and local ones +data LocalFlag (portsNumber :: Nat) + = Local + | External + deriving (Eq) -{- | Update `Port` in `Node` that connected by given `Port`. -It may seems strange, that we update not given port, but connected to this. -But it allowed to unify the update of external and internal nodes +{- | Update ports info in attached `Node`. +It accumulates in key-value map, where key is `ActualAddressNum` and value is a pair of `NodePortsInfo` and `LocalFlag` to distinguish local and external nodes. +The first one we can upload from locals and another one we have to upload from ram -} -updateConnectedToPort :: - (KnownNat portsNumber) => - (LocalAddressNumber -> ActualAddressNumber) -> - (ActualAddressNumber -> Node portsNumber) -> - ActualAddressNumber -> +updatePortsInfoByPort :: + forall portsNumber maxNumOfChangedNodes. + (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => + Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber) -> + LoadedNode portsNumber -> Port portsNumber -> - LoadedNode portsNumber -updateConnectedToPort localToActual loader nodeAddr port = LoadedNode newConnectedNode addr - where - (oldConnectedNode, addr) = case port ^. nodeAddress of - Nothing -> error "Port must to be connected" - Just a -> case a of - ActualAddress a' -> (loader a', a') - LocalAddress a' -> (loader $ localToActual a', a') - newPort = set nodeAddress (Just $ ActualAddress nodeAddr) port - newConnectedNode = updateOnePort oldConnectedNode newPort + IdOfPort portsNumber -> + Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber) +updatePortsInfoByPort infoVec localNodeWithAddress (Port maybeAddr connectedToPortId) portId = + case maybeAddr of + Nothing -> infoVec -- or @error "Port must be connected"@ + Just addr -> case addr of + LocalAddress localAddressNum -> update Local localAddressNum + ActualAddress addressNum -> update External addressNum + where + update localFlag addressNum = + changeValueByKey + infoVec + ( \case + Nothing -> Just (constructNewInfo def, localFlag) + Just (info, _) -> Just (constructNewInfo info, localFlag) + ) + addressNum + where + newPort = Port (Just $ ActualAddress (localNodeWithAddress ^. originalAddress)) portId + constructNewInfo info@(NodePortInfo secPortsInfo _) = case connectedToPortId of + Primary -> set primeP (Just newPort) info + Id i -> set secP (replace i (Just newPort) secPortsInfo) info --- | Update external `LoadedNode`s by `Edge`, i.e. actually connect the nodes on the ports that were connected to the disappeared nodes -updateExternalPortByEdge :: - (KnownNat portsNumber) => - (ActualAddressNumber -> Node portsNumber) -> +updatePortsInfoByEdge :: + forall portsNumber maxNumOfChangedNodes. + (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => + Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber) -> Edge portsNumber -> - (LoadedNode portsNumber, LoadedNode portsNumber) -updateExternalPortByEdge oldRam edge = (LoadedNode leftNewNode leftExtNodeAddress, LoadedNode rightNewNode rightExtNodeAddress) + Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber) +updatePortsInfoByEdge oldInfoVec (Edge leftE rightE) = + update + rightAddrNum + leftAddrNum + (rightE ^. idOfPort) + (leftE ^. idOfPort) + $ update leftAddrNum rightAddrNum (leftE ^. idOfPort) (rightE ^. idOfPort) oldInfoVec where - leftExtNodeAddress = edge ^. leftEnd . addressOfVertex - rightExtNodeAddress = edge ^. rightEnd . addressOfVertex - leftNewPort = Port (Just $ ActualAddress rightExtNodeAddress) (edge ^. rightEnd . idOfPort) - rightNewPort = Port (Just $ ActualAddress leftExtNodeAddress) (edge ^. leftEnd . idOfPort) - leftNewNode = updateOnePort (oldRam leftExtNodeAddress) leftNewPort - rightNewNode = updateOnePort (oldRam rightExtNodeAddress) rightNewPort + leftAddrNum = leftE ^. addressOfVertex + rightAddrNum = rightE ^. addressOfVertex + update addrToUpdate addrToWhichUpdate connectedToPortId portId infoVec = + changeValueByKey + infoVec + ( \case + Nothing -> Just (constructNewInfo (NodePortInfo def Nothing), External) + Just (info, _) -> Just (constructNewInfo info, External) + ) + addrToUpdate + where + newPort = Port (Just $ ActualAddress addrToWhichUpdate) portId + constructNewInfo info@(NodePortInfo secPortsInfo _) = case connectedToPortId of + Primary -> set primeP (Just newPort) info + Id i -> set secP (replace i (Just newPort) secPortsInfo) info + +-- Check if `Node` is active +newNodeIsActive :: + (KnownNat portsNumber) => Node portsNumber -> Bool +newNodeIsActive node = + case node ^. primaryPort . portConnectedToId of + Primary -> True + _ -> False updateMM :: - forall (cellsNumber :: Nat) (portsNumber :: Nat) (edgeNumber :: Nat) (dom :: Domain). + forall (cellsNumber :: Nat) (portsNumber :: Nat) (edgeNumber :: Nat) (dom :: Domain) (maxNumOfChangedNodes :: Nat). ( KnownNat cellsNumber , KnownNat portsNumber , KnownNat edgeNumber @@ -209,15 +242,24 @@ updateMM :: , CLog 2 cellsNumber ~ 16 , 1 <= edgeNumber , CLog 2 edgeNumber ~ 16 + , KnownNat maxNumOfChangedNodes ) => - Signal dom (MemoryManager cellsNumber portsNumber) -> + ( Signal dom ActualAddressNumber -> + Signal dom (Maybe (ActualAddressNumber, Maybe (Node portsNumber))) -> + Signal dom (Maybe (Node portsNumber)) + ) -> + Signal dom (MemoryManager cellsNumber) -> Signal dom (Delta cellsNumber edgeNumber portsNumber) -> - Signal dom (MemoryManager cellsNumber portsNumber) -updateMM memoryManager delta = MemoryManager <$> markedBusyBitMap <*> newActives <*> updatedByEdges + ( Signal dom (MemoryManager cellsNumber) + , Signal dom ActualAddressNumber -> + Signal dom (Maybe (ActualAddressNumber, Maybe (Node portsNumber))) -> + Signal dom (Maybe (Node portsNumber)) + ) +-- it is possible to merge all foldl into one +updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newActives, ram) where localNodesSignal = unbundle $ (^. newNodes) <$> delta :: _ (Signal _ _) activePairSignal = (^. activePair) <$> delta - ramSignal = (^. ram) <$> memoryManager -- map of local and actual `AddressNumber` localActualMapDef = undefined -- removed the processed active pair @@ -231,73 +273,112 @@ updateMM memoryManager delta = MemoryManager <$> markedBusyBitMap <*> newActives let (newBusyMap, newLoadedNode) = signalMaybeApply signalMaybeLocalNode busyMap actualAddr = case sequenceA newLoadedNode of Nothing -> pure Nothing - Just pair -> sequenceA $ Just $ fst <$> pair + Just pair -> sequenceA $ Just $ (^. originalAddress) <$> pair newLocalToActual = case sequenceA actualAddr of Nothing -> localToActual Just addr -> case sequenceA signalMaybeLocalNode of Nothing -> localToActual - Just signalLocal -> updateLocalActual <$> localToActual <*> ((^. localAddress) <$> signalLocal) <*> addr + Just signalLocal -> updateLocalActual <$> localToActual <*> signalLocal <*> addr in (newBusyMap, (+>>) <$> newLoadedNode <*> loadedNodes, newLocalToActual) ) (freedFromActivePair, newLoadedNodesStart, localActualMapDef) localNodesSignal where - newLoadedNodesStart = pure def :: Signal _ (Vec cellsNumber (Maybe _)) + newLoadedNodesStart = pure def :: Signal dom (Vec cellsNumber (Maybe _)) signalMaybeApply signalMaybeLocalNode busyMap = case sequenceA signalMaybeLocalNode of Nothing -> (busyMap, pure Nothing) Just signalLocalNode -> let (signalBusyMap, loadedSignal) = unbundle (updateFromLocalToLoaded <$> busyMap <*> signalLocalNode) in (signalBusyMap, Just <$> loadedSignal) - -- updated the ram according to internal changes, There are still ports that refer to the local address - updatedByLocalsRam = - foldl - ( \loader signalMaybeLoaded -> - case sequenceA signalMaybeLoaded of - Nothing -> loader - Just signalLoaded -> - let (addrS, nodeS) = unbundle signalLoaded - in updateLoaderByNode <$> loader <*> addrS <*> nodeS - ) - ramSignal - (unbundle loaded) - -- updated the ram so that the ports refer to the actual (non-local) address. The connections of the external nodes have also been updated - updatedByNodesConnection = + updateLocalActual oldMap localNode actualAddr x = + if x == (localNode ^. localAddress) + then LoadedNode (localNode ^. numberedNode) actualAddr + else oldMap (localNode ^. localAddress) + -- accumulate all port changes from local nodes + infoAboutUpdatesByNodes = foldl - ( \loader addrNode -> case sequenceA addrNode of - Nothing -> loader - Just x -> - let (addr, node) = unbundle x - in foldl - ( \loader' mbPort -> case sequenceA mbPort of - Nothing -> loader' - Just port -> updateLoaderByLoadedNode <$> loader' <*> (updateConnectedToPort <$> localActualMap <*> loader' <*> addr <*> port) + ( \infoVec signalMaybeLoadedNode -> case sequenceA signalMaybeLoadedNode of + Nothing -> infoVec + Just signalLoadedNode -> + let infoVecByPrimary = + updatePortsInfoByPort + <$> infoVec + <*> signalLoadedNode + <*> ((^. containedNode . primaryPort) <$> signalLoadedNode) + <*> pure Primary + in ifoldl + ( \oldInfoVec i signalMaybePort -> + case sequenceA signalMaybePort of + Nothing -> oldInfoVec + Just signalPort -> + updatePortsInfoByPort + <$> oldInfoVec + <*> signalLoadedNode + <*> signalPort + <*> pure (Id i) ) - loader - (unbundle ((^. secondaryPorts) <$> node)) + infoVecByPrimary + (unbundle ((^. containedNode . secondaryPorts) <$> signalLoadedNode)) ) - updatedByLocalsRam + (def :: Signal dom (Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber))) (unbundle loaded) - -- updated the ram so that the external nodes, which became actually connected to each other through an edge after reduction, referred to each other by ports - updatedByEdges = + -- accumulate all ports changes from edges. i.e. connect some external nodes with each other + infoAboutAllUpdates = foldl - ( \loader signalMaybeEdge -> case sequenceA signalMaybeEdge of - Nothing -> loader - Just signalEdge -> - let (leftLN, rightLN) = unbundle $ updateExternalPortByEdge <$> loader <*> signalEdge - in updateLoaderByLoadedNode <$> (updateLoaderByLoadedNode <$> loader <*> leftLN) <*> rightLN + ( \infoVec signalMaybeEdge -> case sequenceA signalMaybeEdge of + Nothing -> infoVec + Just signalEdge -> updatePortsInfoByEdge <$> infoVec <*> signalEdge ) - updatedByNodesConnection - (unbundle ((^. newEdges) <$> delta)) - -- updated the active pairs + infoAboutUpdatesByNodes + (unbundle $ (^. newEdges) <$> delta) + -- read all necessary external nodes from ram and update them with the local ones + nodesToWrite = + map + ( \signalMaybePair -> + case sequenceA signalMaybePair of + Nothing -> pure Nothing :: Signal dom _ + Just signalPair -> + let addr = fst <$> signalPair + signalMaybeInfo = snd <$> signalPair + in case sequenceA signalMaybeInfo of + Nothing -> def -- same as @pure Nothing@ + Just signalInfo -> + let lf = snd <$> signalInfo + info = fst <$> signalInfo + node = readByAddressAndFlag addr lf + in mux + (lf .==. pure External) + (sequenceA $ Just $ LoadedNode <$> (updateNode <$> node <*> info) <*> addr) + ( sequenceA $ + Just $ + LoadedNode <$> (updateNode <$> node <*> info) <*> ((^. originalAddress) <$> (localActualMap <*> addr)) + ) + ) + (unbundle infoAboutAllUpdates) + -- write all changes into the ram + _ = + map + (maybe def writeByLoadedNode . sequenceA) + nodesToWrite + -- update active pairs (maybe it should to replace into the first foldl) newActives = foldl - ( \actives signalMaybeLoaded -> - case sequenceA signalMaybeLoaded of - Nothing -> actives - Just signalLoaded -> - let (addrS, _) = unbundle signalLoaded - in updateActivesByGivenAddress <$> actives <*> updatedByEdges <*> addrS + ( \actives signalMaybeLocalNode -> case sequenceA signalMaybeLocalNode of + Nothing -> actives + Just signalLocalNode -> + let addressIsActive = (newNodeIsActive . (^. containedNode) <$> signalLocalNode) + in mux addressIsActive ((replace . (^. originalAddress) <$> signalLocalNode) <*> addressIsActive <*> actives) actives ) pairsAfterDelete (unbundle loaded) - updateLocalActual oldMap localAddr actualAddr x = if x == localAddr then actualAddr else oldMap localAddr + + readByAddressAndFlag addressNumber localFlag = mux (localFlag .==. pure External) externalCase localCase + where + externalCase = case sequenceA $ ram addressNumber (pure Nothing) of + Nothing -> error "There is no Node by this address" + Just node -> node + localCase = (^. containedNode) <$> (localActualMap <*> addressNumber) + writeByLoadedNode loadedNode = + ram + ((^. originalAddress) <$> loadedNode) + (sequenceA $ Just $ bundle ((^. originalAddress) <$> loadedNode, sequenceA $ Just $ (^. containedNode) <$> loadedNode)) From 833d1478e18d4f8a07f7f2f0b955825533177f19 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 8 Nov 2024 10:11:38 +0300 Subject: [PATCH 26/54] Rename Map functions --- lamagraph-core/src/Core/Map.hs | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/lamagraph-core/src/Core/Map.hs b/lamagraph-core/src/Core/Map.hs index 2f4303c..bd7f2ff 100644 --- a/lamagraph-core/src/Core/Map.hs +++ b/lamagraph-core/src/Core/Map.hs @@ -1,4 +1,4 @@ -module Core.Map (Map, findByKey, changeValueByKey) where +module Core.Map (Map, find, insertWith) where import Clash.Prelude import Core.Node @@ -9,48 +9,48 @@ It assumed that `size` is small -} type Map (size :: Nat) v = (Vec size (Maybe (AddressNumber, Maybe v))) -findByKey :: +find :: (KnownNat size) => Map size v -> AddressNumber -> Maybe v -findByKey dict key = case dict of +find dict key = case dict of Nil -> Nothing - (Just (k, v) `Cons` t) -> if k == key then v else findByKey t key - (Nothing `Cons` t) -> findByKey t key + (Just (k, v) `Cons` t) -> if k == key then v else find t key + (Nothing `Cons` t) -> find t key -- | Update or insert (by applying function to `Nothing`) value by the key -changeValueByKey :: +insertWith :: (KnownNat size, Eq v) => Map size v -> (Maybe v -> Maybe v) -> AddressNumber -> Map size v -changeValueByKey dict func key = if dict /= updated then updated else inserted +insertWith dict func key = if dict /= updated then updated else inserted where - updated = tryToUpdate key func dict - inserted = insertInFree key (func Nothing) dict + updated = update key func dict + inserted = insert key (func Nothing) dict --- | Try to update (by applying the function) value by key. It do nothing if there is no value be the key in the `Map` -tryToUpdate :: +-- | Try to update (by applying the function) value by key. It does nothing if there is no value by the key in the `Map` +update :: AddressNumber -> (Maybe v -> Maybe v) -> Map size v -> Map size v -tryToUpdate key func dict = case dict of +update key func dict = case dict of h `Cons` t -> case h of - Nothing -> h `Cons` tryToUpdate key func t - Just (k, v) -> if k == key then Just (k, func v) `Cons` t else h `Cons` tryToUpdate key func t + Nothing -> h `Cons` update key func t + Just (k, v) -> if k == key then Just (k, func v) `Cons` t else h `Cons` update key func t Nil -> Nil -- | Insert key-value pair in the free space -insertInFree :: +insert :: AddressNumber -> Maybe v -> Map size v -> Map size v -insertInFree key value dict = case dict of +insert key value dict = case dict of h `Cons` t -> case h of Nothing -> Just (key, value) `Cons` t - Just _ -> h `Cons` insertInFree key value t + Just _ -> h `Cons` insert key value t Nil -> error "All addresses are written" From 9e0c858fbef4576c79f368bebde362edd2a49997 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 8 Nov 2024 11:01:13 +0300 Subject: [PATCH 27/54] Merge foldls Merge three foldls: giving free addresses to LocalNode and marking busy bit map, accumulating ports changes by LocalNode, updating actives. Also make some renames, add more comments and replace all helping functions to separeate block --- lamagraph-core/src/Core/MemoryManager.hs | 153 +++++++++++------------ 1 file changed, 76 insertions(+), 77 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs index 45d803c..5405d67 100644 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -157,7 +157,7 @@ updateNode oldNode (NodePortInfo maybeSecPortsAddr maybePrimaryPort) = Just primPort -> primPort -- | The flag to distinguish between nodes that need to be loaded from ram and local ones -data LocalFlag (portsNumber :: Nat) +data LocalFlag = Local | External deriving (Eq) @@ -169,11 +169,11 @@ The first one we can upload from locals and another one we have to upload from r updatePortsInfoByPort :: forall portsNumber maxNumOfChangedNodes. (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => - Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber) -> + Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag) -> LoadedNode portsNumber -> Port portsNumber -> IdOfPort portsNumber -> - Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber) + Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag) updatePortsInfoByPort infoVec localNodeWithAddress (Port maybeAddr connectedToPortId) portId = case maybeAddr of Nothing -> infoVec -- or @error "Port must be connected"@ @@ -182,7 +182,7 @@ updatePortsInfoByPort infoVec localNodeWithAddress (Port maybeAddr connectedToPo ActualAddress addressNum -> update External addressNum where update localFlag addressNum = - changeValueByKey + insertWith infoVec ( \case Nothing -> Just (constructNewInfo def, localFlag) @@ -198,9 +198,9 @@ updatePortsInfoByPort infoVec localNodeWithAddress (Port maybeAddr connectedToPo updatePortsInfoByEdge :: forall portsNumber maxNumOfChangedNodes. (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => - Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber) -> + Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag) -> Edge portsNumber -> - Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber) + Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag) updatePortsInfoByEdge oldInfoVec (Edge leftE rightE) = update rightAddrNum @@ -212,7 +212,7 @@ updatePortsInfoByEdge oldInfoVec (Edge leftE rightE) = leftAddrNum = leftE ^. addressOfVertex rightAddrNum = rightE ^. addressOfVertex update addrToUpdate addrToWhichUpdate connectedToPortId portId infoVec = - changeValueByKey + insertWith infoVec ( \case Nothing -> Just (constructNewInfo (NodePortInfo def Nothing), External) @@ -261,67 +261,40 @@ updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newAc localNodesSignal = unbundle $ (^. newNodes) <$> delta :: _ (Signal _ _) activePairSignal = (^. activePair) <$> delta -- map of local and actual `AddressNumber` - localActualMapDef = undefined + localActualMapDef = error "Nothing is written at this local address" + updatesInfo = def :: Signal dom (Map maxNumOfChangedNodes (NodePortsInfo _, LocalFlag)) -- removed the processed active pair pairsAfterDelete = (deleteActivePair . (^. activePairs) <$> memoryManager) <*> activePairSignal -- freed up space from an active pair freedFromActivePair = (freeUpActivePair . (^. busyBitMap) <$> memoryManager) <*> activePairSignal - -- gave the local nodes free addresses, marking the occupied ones. Received a marked map address:busy, a list of new nodes with their actual addresses and a map (local address):(actual address) - (markedBusyBitMap, loaded, localActualMap) = + {- gave the local nodes free addresses, marking the occupied ones. + Received a marked map address:busy, a list of new nodes with their actual addresses and a map (local address):(loaded node). + It also accumulate all changes in ports in the `Map` and updates actives-} + (markedBusyBitMap, localAddressToLoadedMap, newActives, infoAboutUpdatesByNodes) = foldl - ( \(busyMap, loadedNodes, localToActual) signalMaybeLocalNode -> - let (newBusyMap, newLoadedNode) = signalMaybeApply signalMaybeLocalNode busyMap - actualAddr = case sequenceA newLoadedNode of - Nothing -> pure Nothing - Just pair -> sequenceA $ Just $ (^. originalAddress) <$> pair + ( \(busyMap, localToActual, oldActives, accumulatedInfoMap) signalMaybeLocalNode -> + let (newBusyMap, newLoadedNode) = assignNewAddressToLocalNode signalMaybeLocalNode busyMap + (actualAddr, actives, infoVec) = case sequenceA newLoadedNode of + Nothing -> (def, oldActives, accumulatedInfoMap) + Just localLoadedNode -> + let addressIsActive = (newNodeIsActive . (^. containedNode) <$> localLoadedNode) + in ( sequenceA $ Just $ (^. originalAddress) <$> localLoadedNode + , mux addressIsActive ((replace . (^. originalAddress) <$> localLoadedNode) <*> addressIsActive <*> actives) actives + , accumulatePortsChangesByLoadedNode accumulatedInfoMap localLoadedNode + ) newLocalToActual = case sequenceA actualAddr of Nothing -> localToActual Just addr -> case sequenceA signalMaybeLocalNode of Nothing -> localToActual - Just signalLocal -> updateLocalActual <$> localToActual <*> signalLocal <*> addr - in (newBusyMap, (+>>) <$> newLoadedNode <*> loadedNodes, newLocalToActual) + Just signalLocal -> updateLocalAddressToLoaded localToActual signalLocal addr + in (newBusyMap, newLocalToActual, actives, infoVec) ) - (freedFromActivePair, newLoadedNodesStart, localActualMapDef) - localNodesSignal - where - newLoadedNodesStart = pure def :: Signal dom (Vec cellsNumber (Maybe _)) - signalMaybeApply signalMaybeLocalNode busyMap = case sequenceA signalMaybeLocalNode of - Nothing -> (busyMap, pure Nothing) - Just signalLocalNode -> - let (signalBusyMap, loadedSignal) = unbundle (updateFromLocalToLoaded <$> busyMap <*> signalLocalNode) - in (signalBusyMap, Just <$> loadedSignal) - updateLocalActual oldMap localNode actualAddr x = - if x == (localNode ^. localAddress) - then LoadedNode (localNode ^. numberedNode) actualAddr - else oldMap (localNode ^. localAddress) - -- accumulate all port changes from local nodes - infoAboutUpdatesByNodes = - foldl - ( \infoVec signalMaybeLoadedNode -> case sequenceA signalMaybeLoadedNode of - Nothing -> infoVec - Just signalLoadedNode -> - let infoVecByPrimary = - updatePortsInfoByPort - <$> infoVec - <*> signalLoadedNode - <*> ((^. containedNode . primaryPort) <$> signalLoadedNode) - <*> pure Primary - in ifoldl - ( \oldInfoVec i signalMaybePort -> - case sequenceA signalMaybePort of - Nothing -> oldInfoVec - Just signalPort -> - updatePortsInfoByPort - <$> oldInfoVec - <*> signalLoadedNode - <*> signalPort - <*> pure (Id i) - ) - infoVecByPrimary - (unbundle ((^. containedNode . secondaryPorts) <$> signalLoadedNode)) + ( freedFromActivePair + , localActualMapDef + , pairsAfterDelete + , updatesInfo ) - (def :: Signal dom (Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag portsNumber))) - (unbundle loaded) + localNodesSignal -- accumulate all ports changes from edges. i.e. connect some external nodes with each other infoAboutAllUpdates = foldl @@ -336,22 +309,22 @@ updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newAc map ( \signalMaybePair -> case sequenceA signalMaybePair of - Nothing -> pure Nothing :: Signal dom _ + Nothing -> def -- same as @pure Nothing@ Just signalPair -> - let addr = fst <$> signalPair + let addr = fst <$> signalPair :: Signal dom AddressNumber signalMaybeInfo = snd <$> signalPair in case sequenceA signalMaybeInfo of - Nothing -> def -- same as @pure Nothing@ + Nothing -> def Just signalInfo -> - let lf = snd <$> signalInfo + let localFlag = snd <$> signalInfo info = fst <$> signalInfo - node = readByAddressAndFlag addr lf + node = readByAddressAndFlag addr localFlag in mux - (lf .==. pure External) + (localFlag .==. pure External) (sequenceA $ Just $ LoadedNode <$> (updateNode <$> node <*> info) <*> addr) ( sequenceA $ Just $ - LoadedNode <$> (updateNode <$> node <*> info) <*> ((^. originalAddress) <$> (localActualMap <*> addr)) + LoadedNode <$> (updateNode <$> node <*> info) <*> ((^. originalAddress) <$> localAddressToLoadedMap addr) ) ) (unbundle infoAboutAllUpdates) @@ -360,25 +333,51 @@ updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newAc map (maybe def writeByLoadedNode . sequenceA) nodesToWrite - -- update active pairs (maybe it should to replace into the first foldl) - newActives = - foldl - ( \actives signalMaybeLocalNode -> case sequenceA signalMaybeLocalNode of - Nothing -> actives - Just signalLocalNode -> - let addressIsActive = (newNodeIsActive . (^. containedNode) <$> signalLocalNode) - in mux addressIsActive ((replace . (^. originalAddress) <$> signalLocalNode) <*> addressIsActive <*> actives) actives - ) - pairsAfterDelete - (unbundle loaded) - + {----------------- + Helping functions + -----------------} + -- assign new `ActualAddressNumber` to `LocalNode` and mark busy bit map + assignNewAddressToLocalNode signalMaybeLocalNode busyMap = case sequenceA signalMaybeLocalNode of + Nothing -> (busyMap, def) + Just signalLocalNode -> + let (signalBusyMap, loadedSignal) = unbundle (updateFromLocalToLoaded <$> busyMap <*> signalLocalNode) + in (signalBusyMap, Just <$> loadedSignal) + -- read `Node` by `AddressNumber`. From the locals or from the RAM according to the flag readByAddressAndFlag addressNumber localFlag = mux (localFlag .==. pure External) externalCase localCase where externalCase = case sequenceA $ ram addressNumber (pure Nothing) of Nothing -> error "There is no Node by this address" Just node -> node - localCase = (^. containedNode) <$> (localActualMap <*> addressNumber) + localCase = (^. containedNode) <$> localAddressToLoadedMap addressNumber + -- write `Node` by the `ActualAddressNumber` in the RAM writeByLoadedNode loadedNode = ram ((^. originalAddress) <$> loadedNode) (sequenceA $ Just $ bundle ((^. originalAddress) <$> loadedNode, sequenceA $ Just $ (^. containedNode) <$> loadedNode)) + -- update local-to-loaded map + updateLocalAddressToLoaded oldMap localNode actualAddr x = + mux + (x .==. ((^. localAddress) <$> localNode)) + ((LoadedNode . (^. numberedNode) <$> localNode) <*> actualAddr) + (oldMap ((^. localAddress) <$> localNode)) + -- accumulate all changes by ports of the given `Node` and write in the `Map` + accumulatePortsChangesByLoadedNode infoVec signalLoadedNode = + let infoVecByPrimary = + updatePortsInfoByPort + <$> infoVec + <*> signalLoadedNode + <*> ((^. containedNode . primaryPort) <$> signalLoadedNode) + <*> pure Primary + in ifoldl + ( \oldInfoVec i signalMaybePort -> + case sequenceA signalMaybePort of + Nothing -> oldInfoVec + Just signalPort -> + updatePortsInfoByPort + <$> oldInfoVec + <*> signalLoadedNode + <*> signalPort + <*> pure (Id i) + ) + infoVecByPrimary + (unbundle ((^. containedNode . secondaryPorts) <$> signalLoadedNode)) From 98f2046804a8394898c9317d3c9a12584698c918 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 15 Nov 2024 15:52:49 +0300 Subject: [PATCH 28/54] Delete updateRam --- lamagraph-core/src/Core/Loader.hs | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/lamagraph-core/src/Core/Loader.hs b/lamagraph-core/src/Core/Loader.hs index 68b2911..3567a7d 100644 --- a/lamagraph-core/src/Core/Loader.hs +++ b/lamagraph-core/src/Core/Loader.hs @@ -19,20 +19,3 @@ loader ram mbAddressNumberToLoad = mbNode = case sequenceA mbAddressNumberToLoad of Nothing -> pure Nothing Just n -> sequenceA $ Just (ram n) - -{- | Update RAM function. In fact only way to update data in registers. -Change `Node` by given `AddressNumber` at given `Node` --} -updateRam :: - ( KnownDomain dom - , HiddenClockResetEnable dom - , KnownNat numberOfPorts - ) => - (Signal dom AddressNumber -> Signal dom (Node numberOfPorts)) -> - Signal dom AddressNumber -> - Signal dom (Node numberOfPorts) -> - (Signal dom AddressNumber -> Signal dom (Node numberOfPorts)) -updateRam oldRam newAddressNumber newNode address = mux addressesIsEq newNode oldNode - where - addressesIsEq = newAddressNumber .==. address - oldNode = oldRam address From d4f2574f6a2db31f7b3df1eaf2776551220ef3cb Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 15 Nov 2024 15:55:49 +0300 Subject: [PATCH 29/54] Refactor and some doc changes Simplified update function Add simpliest doctest --- lamagraph-core/src/Core/Map.hs | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/lamagraph-core/src/Core/Map.hs b/lamagraph-core/src/Core/Map.hs index bd7f2ff..a3c09ec 100644 --- a/lamagraph-core/src/Core/Map.hs +++ b/lamagraph-core/src/Core/Map.hs @@ -1,8 +1,17 @@ -module Core.Map (Map, find, insertWith) where +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Eta reduce" #-} + +module Core.Map (Map, find, insertWith, insert) where import Clash.Prelude import Core.Node +{- $setup +>>> import Clash.Prelude +>>> import Core.Node +-} + {- | key-value store based on `Vec`. Key is `AddressNumber`, it has linear time to find or change element. But iterate (such as map or fold) by value and key is easy. It assumed that `size` is small @@ -19,7 +28,10 @@ find dict key = case dict of (Just (k, v) `Cons` t) -> if k == key then v else find t key (Nothing `Cons` t) -> find t key --- | Update or insert (by applying function to `Nothing`) value by the key +{- | Update or insert (by applying function to `Nothing`) value by the key. + +TODO: fix @id@ case. If @func@ is isomorphic to @id@ then @insertWith@ works incorrect +-} insertWith :: (KnownNat size, Eq v) => Map size v -> @@ -37,13 +49,15 @@ update :: (Maybe v -> Maybe v) -> Map size v -> Map size v -update key func dict = case dict of - h `Cons` t -> case h of - Nothing -> h `Cons` update key func t - Just (k, v) -> if k == key then Just (k, func v) `Cons` t else h `Cons` update key func t - Nil -> Nil +update key func dict = map (fmap updateIfKeysEquals) dict + where + updateIfKeysEquals (k, v) = if k == key then (k, func v) else (k, v) --- | Insert key-value pair in the free space +{- | Insert key-value pair in the free space + +>>> insert 1 (Just 1) (def :: Map 2 AddressNumber) +Just (1,Just 1) :> Nothing :> Nil +-} insert :: AddressNumber -> Maybe v -> From 6db019e31033f462f72a2908c43fd4f8701d82ea Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 15 Nov 2024 16:02:08 +0300 Subject: [PATCH 30/54] Minor refactoring Add type alias for Ram Move most of helping function to top-level Replace ^. to view --- lamagraph-core/src/Core/MemoryManager.hs | 152 ++++++++++++++--------- 1 file changed, 92 insertions(+), 60 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs index 5405d67..c35b922 100644 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -28,11 +28,13 @@ data Edge (portsNumber :: Nat) = Edge deriving (Generic, NFDataX, Show, Eq) $(makeLenses ''Edge) + data ActivePair (portsNumber :: Nat) = ActivePair { _leftNode :: LoadedNode portsNumber , _rightNode :: LoadedNode portsNumber } deriving (Show, Eq, Generic, NFDataX, Bundle) + $(makeLenses ''ActivePair) data MemoryManager (cellsNumber :: Nat) -- (portsNumber :: Nat) @@ -41,6 +43,7 @@ data MemoryManager (cellsNumber :: Nat) -- (portsNumber :: Nat) , _activePairs :: Vec cellsNumber Bool } deriving (Generic, NFDataX, Bundle) + $(makeLenses ''MemoryManager) data Delta (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = Delta @@ -49,6 +52,7 @@ data Delta (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = Delt , _activePair :: ActivePair portsNumber } deriving (Show, Eq, Generic, NFDataX) + $(makeLenses ''Delta) -- | Get address from memory manager that is not busy. Return `Nothing` if all addresses are busy @@ -117,12 +121,12 @@ registerAddressNumToNewNode busyMap = addressNum {- | Assign actual `AddressNumber` to `LocalNode` and mark busy bit map according to this. It is the composition of `registerAddressNumToNewNode` and `markAddress` just for usability -} -updateFromLocalToLoaded :: +getLoadedFromLocal :: (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16, KnownNat portsNumber) => Vec cellsNumber Bool -> LocalNode portsNumber -> (Vec cellsNumber Bool, LoadedNode portsNumber) -updateFromLocalToLoaded busyMap localNode = (newBusyMap, LoadedNode node newAddress) +getLoadedFromLocal busyMap localNode = (newBusyMap, LoadedNode node newAddress) where newAddress = registerAddressNumToNewNode busyMap newBusyMap = markAddress busyMap True newAddress @@ -139,12 +143,12 @@ data NodePortsInfo (portsNumber :: Nat) $(makeLenses ''NodePortsInfo) -- | Update `Port`s of `Node` by `NodePortsInfo` -updateNode :: +updateNodeByPortsInfo :: (KnownNat portsNumber) => Node portsNumber -> NodePortsInfo portsNumber -> Node portsNumber -updateNode oldNode (NodePortInfo maybeSecPortsAddr maybePrimaryPort) = +updateNodeByPortsInfo oldNode (NodePortInfo maybeSecPortsAddr maybePrimaryPort) = set primaryPort newPrimPort (set secondaryPorts newSecPorts oldNode) where newSecPorts = @@ -164,7 +168,7 @@ data LocalFlag {- | Update ports info in attached `Node`. It accumulates in key-value map, where key is `ActualAddressNum` and value is a pair of `NodePortsInfo` and `LocalFlag` to distinguish local and external nodes. -The first one we can upload from locals and another one we have to upload from ram +The first one we can load from locals and another one we have to load from ram -} updatePortsInfoByPort :: forall portsNumber maxNumOfChangedNodes. @@ -195,6 +199,9 @@ updatePortsInfoByPort infoVec localNodeWithAddress (Port maybeAddr connectedToPo Primary -> set primeP (Just newPort) info Id i -> set secP (replace i (Just newPort) secPortsInfo) info +{- | The same as `updatePortsInfoByPort`, but updating happens by `Edge`. +In fact it accumulate info about which external `LoadedNode` have become connected with each other +-} updatePortsInfoByEdge :: forall portsNumber maxNumOfChangedNodes. (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => @@ -233,6 +240,66 @@ newNodeIsActive node = Primary -> True _ -> False +-- | Assign new `ActualAddressNumber` to `LocalNode` and mark busy bit map +assignNewAddressToLocalNode :: + (CLog 2 cellsNumber ~ 16, KnownNat cellsNumber, KnownNat portsNumber, 1 <= cellsNumber) => + Signal dom (Maybe (LocalNode portsNumber)) -> + Signal dom (Vec cellsNumber Bool) -> + (Signal dom (Vec cellsNumber Bool), Signal dom (Maybe (LoadedNode portsNumber))) +assignNewAddressToLocalNode signalMaybeLocalNode busyMap = case sequenceA signalMaybeLocalNode of + Nothing -> (busyMap, def) + Just signalLocalNode -> + let (signalBusyMap, loadedSignal) = unbundle (getLoadedFromLocal <$> busyMap <*> signalLocalNode) + in (signalBusyMap, Just <$> loadedSignal) + +-- | Update local-to-loaded map +updateLocalAddressToLoaded :: + (KnownDomain dom, KnownNat portsNumber) => + (Signal dom LocalAddressNumber -> Signal dom (LoadedNode portsNumber)) -> + Signal dom (LocalNode portsNumber) -> + Signal dom ActualAddressNumber -> + Signal dom LocalAddressNumber -> + Signal dom (LoadedNode portsNumber) +updateLocalAddressToLoaded oldMap localNode actualAddr x = + mux + (x .==. (view localAddress <$> localNode)) + ((LoadedNode . view numberedNode <$> localNode) <*> actualAddr) + (oldMap (view localAddress <$> localNode)) + +-- | Accumulate all changes by ports of the given `Node` and write it in the `Map` +accumulatePortsChangesByLoadedNode :: + (KnownNat portsNumber1, KnownNat maxNumOfChangedNodes) => + Signal dom (Map maxNumOfChangedNodes (NodePortsInfo portsNumber1, LocalFlag)) -> + Signal dom (LoadedNode portsNumber1) -> + Signal dom (Map maxNumOfChangedNodes (NodePortsInfo portsNumber1, LocalFlag)) +accumulatePortsChangesByLoadedNode infoVec signalLoadedNode = + let infoVecByPrimary = + updatePortsInfoByPort + <$> infoVec + <*> signalLoadedNode + <*> (view (containedNode . primaryPort) <$> signalLoadedNode) + <*> pure Primary + in ifoldl + ( \oldInfoVec i signalMaybePort -> + case sequenceA signalMaybePort of + Nothing -> oldInfoVec + Just signalPort -> + updatePortsInfoByPort + <$> oldInfoVec + <*> signalLoadedNode + <*> signalPort + <*> pure (Id i) + ) + infoVecByPrimary + (unbundle (view (containedNode . secondaryPorts) <$> signalLoadedNode)) + +-- | Type alias for partial applied `blockRam` +type Ram dom portsNumber = + ( Signal dom ActualAddressNumber -> + Signal dom (Maybe (ActualAddressNumber, Maybe (Node portsNumber))) -> + Signal dom (Maybe (Node portsNumber)) + ) + updateMM :: forall (cellsNumber :: Nat) (portsNumber :: Nat) (edgeNumber :: Nat) (dom :: Domain) (maxNumOfChangedNodes :: Nat). ( KnownNat cellsNumber @@ -243,30 +310,26 @@ updateMM :: , 1 <= edgeNumber , CLog 2 edgeNumber ~ 16 , KnownNat maxNumOfChangedNodes + , KnownDomain dom ) => - ( Signal dom ActualAddressNumber -> - Signal dom (Maybe (ActualAddressNumber, Maybe (Node portsNumber))) -> - Signal dom (Maybe (Node portsNumber)) - ) -> + Ram dom portsNumber -> Signal dom (MemoryManager cellsNumber) -> Signal dom (Delta cellsNumber edgeNumber portsNumber) -> ( Signal dom (MemoryManager cellsNumber) - , Signal dom ActualAddressNumber -> - Signal dom (Maybe (ActualAddressNumber, Maybe (Node portsNumber))) -> - Signal dom (Maybe (Node portsNumber)) + , Ram dom portsNumber ) -- it is possible to merge all foldl into one updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newActives, ram) where - localNodesSignal = unbundle $ (^. newNodes) <$> delta :: _ (Signal _ _) - activePairSignal = (^. activePair) <$> delta + localNodesSignal = unbundle $ view newNodes <$> delta :: _ (Signal _ _) + activePairSignal = view activePair <$> delta -- map of local and actual `AddressNumber` localActualMapDef = error "Nothing is written at this local address" updatesInfo = def :: Signal dom (Map maxNumOfChangedNodes (NodePortsInfo _, LocalFlag)) -- removed the processed active pair - pairsAfterDelete = (deleteActivePair . (^. activePairs) <$> memoryManager) <*> activePairSignal + pairsAfterDelete = (deleteActivePair . view activePairs <$> memoryManager) <*> activePairSignal -- freed up space from an active pair - freedFromActivePair = (freeUpActivePair . (^. busyBitMap) <$> memoryManager) <*> activePairSignal + freedFromActivePair = (freeUpActivePair . view busyBitMap <$> memoryManager) <*> activePairSignal {- gave the local nodes free addresses, marking the occupied ones. Received a marked map address:busy, a list of new nodes with their actual addresses and a map (local address):(loaded node). It also accumulate all changes in ports in the `Map` and updates actives-} @@ -277,9 +340,9 @@ updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newAc (actualAddr, actives, infoVec) = case sequenceA newLoadedNode of Nothing -> (def, oldActives, accumulatedInfoMap) Just localLoadedNode -> - let addressIsActive = (newNodeIsActive . (^. containedNode) <$> localLoadedNode) - in ( sequenceA $ Just $ (^. originalAddress) <$> localLoadedNode - , mux addressIsActive ((replace . (^. originalAddress) <$> localLoadedNode) <*> addressIsActive <*> actives) actives + let addressIsActive = (newNodeIsActive . view containedNode <$> localLoadedNode) + in ( sequenceA $ Just $ view originalAddress <$> localLoadedNode + , mux addressIsActive ((replace . view originalAddress <$> localLoadedNode) <*> addressIsActive <*> actives) actives , accumulatePortsChangesByLoadedNode accumulatedInfoMap localLoadedNode ) newLocalToActual = case sequenceA actualAddr of @@ -303,7 +366,7 @@ updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newAc Just signalEdge -> updatePortsInfoByEdge <$> infoVec <*> signalEdge ) infoAboutUpdatesByNodes - (unbundle $ (^. newEdges) <$> delta) + (unbundle $ view newEdges <$> delta) -- read all necessary external nodes from ram and update them with the local ones nodesToWrite = map @@ -321,10 +384,10 @@ updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newAc node = readByAddressAndFlag addr localFlag in mux (localFlag .==. pure External) - (sequenceA $ Just $ LoadedNode <$> (updateNode <$> node <*> info) <*> addr) + (sequenceA $ Just $ LoadedNode <$> (updateNodeByPortsInfo <$> node <*> info) <*> addr) ( sequenceA $ Just $ - LoadedNode <$> (updateNode <$> node <*> info) <*> ((^. originalAddress) <$> localAddressToLoadedMap addr) + LoadedNode <$> (updateNodeByPortsInfo <$> node <*> info) <*> (view originalAddress <$> localAddressToLoadedMap addr) ) ) (unbundle infoAboutAllUpdates) @@ -333,51 +396,20 @@ updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newAc map (maybe def writeByLoadedNode . sequenceA) nodesToWrite - {----------------- + {---------------- Helping functions - -----------------} - -- assign new `ActualAddressNumber` to `LocalNode` and mark busy bit map - assignNewAddressToLocalNode signalMaybeLocalNode busyMap = case sequenceA signalMaybeLocalNode of - Nothing -> (busyMap, def) - Just signalLocalNode -> - let (signalBusyMap, loadedSignal) = unbundle (updateFromLocalToLoaded <$> busyMap <*> signalLocalNode) - in (signalBusyMap, Just <$> loadedSignal) + ----------------} + -- read `Node` by `AddressNumber`. From the locals or from the RAM according to the flag readByAddressAndFlag addressNumber localFlag = mux (localFlag .==. pure External) externalCase localCase where externalCase = case sequenceA $ ram addressNumber (pure Nothing) of Nothing -> error "There is no Node by this address" Just node -> node - localCase = (^. containedNode) <$> localAddressToLoadedMap addressNumber + localCase = view containedNode <$> localAddressToLoadedMap addressNumber + -- write `Node` by the `ActualAddressNumber` in the RAM writeByLoadedNode loadedNode = ram - ((^. originalAddress) <$> loadedNode) - (sequenceA $ Just $ bundle ((^. originalAddress) <$> loadedNode, sequenceA $ Just $ (^. containedNode) <$> loadedNode)) - -- update local-to-loaded map - updateLocalAddressToLoaded oldMap localNode actualAddr x = - mux - (x .==. ((^. localAddress) <$> localNode)) - ((LoadedNode . (^. numberedNode) <$> localNode) <*> actualAddr) - (oldMap ((^. localAddress) <$> localNode)) - -- accumulate all changes by ports of the given `Node` and write in the `Map` - accumulatePortsChangesByLoadedNode infoVec signalLoadedNode = - let infoVecByPrimary = - updatePortsInfoByPort - <$> infoVec - <*> signalLoadedNode - <*> ((^. containedNode . primaryPort) <$> signalLoadedNode) - <*> pure Primary - in ifoldl - ( \oldInfoVec i signalMaybePort -> - case sequenceA signalMaybePort of - Nothing -> oldInfoVec - Just signalPort -> - updatePortsInfoByPort - <$> oldInfoVec - <*> signalLoadedNode - <*> signalPort - <*> pure (Id i) - ) - infoVecByPrimary - (unbundle ((^. containedNode . secondaryPorts) <$> signalLoadedNode)) + (view originalAddress <$> loadedNode) + (sequenceA $ Just $ bundle (view originalAddress <$> loadedNode, sequenceA $ Just $ view containedNode <$> loadedNode)) From 27f82a317e801b9bd30f4241243f18a0e81c0dac Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 15 Nov 2024 16:06:40 +0300 Subject: [PATCH 31/54] Simplified reducer --- lamagraph-core/src/Core/Reducer.hs | 87 ++++++------------------------ 1 file changed, 16 insertions(+), 71 deletions(-) diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index 5a38dce..a411a49 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -1,95 +1,40 @@ +{-# HLINT ignore "Functor law" #-} +-- {-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + module Core.Reducer where import Clash.Prelude -import Control.Lens (makeLenses, set, (^.)) +import Control.Lens (makeLenses, view, (^.)) import Core.MemoryManager import Core.Node type NumOfNodesToStore = Unsigned 3 type NumOfEdgesToStore = Unsigned 3 -{- | Regulates which external (interface) `Ports` belonged to which `Node` (and in which place) before the reduction. - This is necessary in order to be able to coordinate the interface in the reducer --} -data OldId portsNumber = LeftLoadedNode (IdOfPort portsNumber) | RightLoadedNode (IdOfPort portsNumber) - -- | Result of abstract reduction rule data ReduceRuleResult (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = ReduceRuleResult - { _edges :: Vec edgesNumber (Maybe (OldId portsNumber, OldId portsNumber)) - , _nodes :: - Vec nodesNumber (Maybe (LocalNode portsNumber, Vec portsNumber (Maybe (OldId portsNumber, IdOfPort portsNumber)))) + { _edges :: Vec edgesNumber (Maybe (Edge portsNumber)) + , _nodes :: Vec nodesNumber (Maybe (LocalNode portsNumber)) } $(makeLenses ''ReduceRuleResult) -{- | Coordinates interface `Port` in `LocalNode`. -I.e. it connects the "hanging" ports from the reduction rule with the `LoadedNode` from the real net --} -putInterfacesNodeToGlobalNet :: - forall portsNumber. - (KnownNat portsNumber) => - LoadedNode portsNumber -> - LoadedNode portsNumber -> - (LocalNode portsNumber, Vec portsNumber (Maybe (OldId portsNumber, IdOfPort portsNumber))) -> - LocalNode portsNumber -putInterfacesNodeToGlobalNet leftLNode rightLNode (localNode, interfacePortsInfo) = foldl replaceOnePort localNode interfacePortsInfo - where - replaceOnePort :: LocalNode portsNumber -> Maybe (OldId portsNumber, IdOfPort portsNumber) -> LocalNode portsNumber - replaceOnePort ln maybePortInfo = - case maybePortInfo of - Nothing -> ln - Just (oldPortId, portId) -> - let setPort loadedN idOfLoadedNode = case getPortById (loadedN ^. containedNode) idOfLoadedNode of - Nothing -> error "Port must be connected" - Just portOfLoadedNode -> case portId of - Primary -> set numberedNode (set primaryPort portOfLoadedNode (ln ^. numberedNode)) ln - Id index -> - set - numberedNode - (set secondaryPorts (replace index (Just portOfLoadedNode) (ln ^. numberedNode . secondaryPorts)) (ln ^. numberedNode)) - ln - in case oldPortId of - LeftLoadedNode i -> setPort leftLNode i - RightLoadedNode i -> setPort rightLNode i - -{- | Coordinates interface `Port` in disappeared `Node`. -I.e. it connects relevant external `LoadedNode` together (making `Edge`) --} -putInterfacesEdgeToGlobalNet :: - forall portsNumber. - (KnownNat portsNumber) => - LoadedNode portsNumber -> - LoadedNode portsNumber -> - Maybe (OldId portsNumber, OldId portsNumber) -> - Maybe (Edge portsNumber) -putInterfacesEdgeToGlobalNet leftLNode rightLNode info = case info of - Nothing -> Nothing - Just (leftEndPortInfo, rightEndPortInfo) -> Just $ Edge lEnd rEnd - where - constructEnd portInfo = case portInfo of - LeftLoadedNode portId -> EdgeEnd (leftLNode ^. originalAddress) portId - RightLoadedNode portId -> EdgeEnd (rightLNode ^. originalAddress) portId - lEnd = constructEnd leftEndPortInfo - rEnd = constructEnd rightEndPortInfo +toDelta :: + (KnownNat portsNumber, KnownNat edgesNumber, KnownNat nodesNumber) => + ActivePair portsNumber -> + ReduceRuleResult nodesNumber edgesNumber portsNumber -> + Delta nodesNumber edgesNumber portsNumber +toDelta acPair reduceResult = Delta (reduceResult ^. nodes) (reduceResult ^. edges) acPair reducer :: forall dom portsNumber nodesNumber edgesNumber. (KnownDomain dom, KnownNat portsNumber, KnownNat nodesNumber, KnownNat edgesNumber) => - ((NodeTag, NodeTag) -> ReduceRuleResult nodesNumber edgesNumber portsNumber) -> + (Node portsNumber -> Node portsNumber -> ReduceRuleResult nodesNumber edgesNumber portsNumber) -> Signal dom (ActivePair portsNumber) -> Signal dom (Delta nodesNumber edgesNumber portsNumber) -reducer transFunction activeP = Delta <$> nodesForDelta <*> edgesForDelta <*> activeP +reducer transFunction activeP = toDelta <$> activeP <*> reduceRuleRes where leftLNode = (^. leftNode) <$> activeP rightLNode = (^. rightNode) <$> activeP - reduceRuleRes = transFunction <$> bundle ((^. containedNode . nodeType) <$> leftLNode, (^. containedNode . nodeType) <$> rightLNode) - nodesForDelta = - bundle $ - map - ( \signalMaybeNodesInterfaceInfo -> case sequenceA signalMaybeNodesInterfaceInfo of - Nothing -> pure Nothing - Just signalNodesInterfaceInfo -> sequenceA (Just (putInterfacesNodeToGlobalNet <$> leftLNode <*> rightLNode <*> signalNodesInterfaceInfo)) - ) - (unbundle $ (^. nodes) <$> reduceRuleRes) - edgesForDelta = - bundle $ map (putInterfacesEdgeToGlobalNet <$> leftLNode <*> rightLNode <*>) (unbundle $ (^. edges) <$> reduceRuleRes) + reduceRuleRes = transFunction <$> (view containedNode <$> leftLNode) <*> (view containedNode <$> rightLNode) From 52030f63184bc540d7425861b3864a957461c83e Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 15 Nov 2024 16:08:04 +0300 Subject: [PATCH 32/54] Add handmade agents --- lamagraph-core/lamagraph-core.cabal | 2 ++ lamagraph-core/src/Core/Node.hs | 5 ++--- lamagraph-core/src/INet/Net.hs | 17 +++++++++++++++++ 3 files changed, 21 insertions(+), 3 deletions(-) create mode 100644 lamagraph-core/src/INet/Net.hs diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index 4d4fa04..3447835 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -90,6 +90,8 @@ library Core.Reducer Core.MemoryManager Core.Map + Core.Concrete.ReduceRulesLambda + INet.Net default-language: Haskell2010 -- Builds the executable 'clash', with lamagraph-core project in scope diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 1bc8000..6758acc 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -4,8 +4,7 @@ module Core.Node where import Clash.Prelude import Control.Lens (makeLenses, (^.)) - -type NodeTag = String +import INet.Net type AddressNumber = Unsigned 16 @@ -30,7 +29,7 @@ $(makeLenses ''Port) data Node portsNumber = Node { _primaryPort :: Port portsNumber , _secondaryPorts :: Vec portsNumber (Maybe (Port portsNumber)) - , _nodeType :: NodeTag -- looks like we need some kind of node label. Info about and reduction rules contained IN + , _nodeType :: Agent -- looks like we need some kind of node label. Info about and reduction rules contained IN } deriving (NFDataX, Generic, Show, Eq) diff --git a/lamagraph-core/src/INet/Net.hs b/lamagraph-core/src/INet/Net.hs new file mode 100644 index 0000000..88893cf --- /dev/null +++ b/lamagraph-core/src/INet/Net.hs @@ -0,0 +1,17 @@ +module INet.Net where + +import Clash.Prelude + +data AgentSimpleLambda + = Apply + | Abs + deriving (NFDataX, Generic, Show, Eq) + +data AgentCombinator + = Delta + | Gamma + | Eps + deriving (NFDataX, Generic, Show, Eq) + +-- It is kind of hack. We need do it smarter later +type Agent = AgentSimpleLambda From 19187771f7144fd66b566c22b14979615ee38337 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Fri, 15 Nov 2024 16:09:43 +0300 Subject: [PATCH 33/54] Write concrete handmade reduction rule --- .../src/Core/Concrete/ReduceRulesLambda.hs | 40 +++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs diff --git a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs new file mode 100644 index 0000000..8bdb381 --- /dev/null +++ b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs @@ -0,0 +1,40 @@ +{- | All modules from Concrete are +1a. Compiled from some dsl in separate file +1b. Compiled from embedded dsl in INet module +2. Written by hands for tests +-} +module Core.Concrete.ReduceRulesLambda where + +import Clash.Prelude +import Control.Lens +import Core.MemoryManager +import Core.Node +import Core.Reducer +import INet.Net + +(|><|) :: + -- forall portsNumber nodesNumber edgesNumber. + -- (KnownNat portsNumber, KnownNat nodesNumber, KnownNat edgesNumber, edgesNumber ~ portsNumber) => + -- Node portsNumber -> + -- Node portsNumber -> + -- ReduceRuleResult nodesNumber edgesNumber portsNumber + Node 2 -> + Node 2 -> + ReduceRuleResult 0 2 2 +lNode |><| rNode = case (lNode ^. nodeType, rNode ^. nodeType) of + (Apply, Abs) -> applyToLambdaRule lNode rNode + (Abs, Apply) -> applyToLambdaRule lNode rNode + _ -> error "There is no rule for this active pair in the reduction rules" + where + applyToLambdaRule n1 n2 = + let arisingNodes = def + portToEdgeEnd p = case p ^. nodeAddress of + Nothing -> error "Port must to be connected" + Just addr -> case addr of + ActualAddress addrNum -> EdgeEnd addrNum (p ^. portConnectedToId) + LocalAddress addrNum -> EdgeEnd addrNum (p ^. portConnectedToId) -- Maybe this is should be more complicated + portsToEdgeEnds node = map (maybe (error "All Ports must to be presented") portToEdgeEnd) (node ^. secondaryPorts) + lE = portsToEdgeEnds n1 + rE = portsToEdgeEnds n2 + arisingEdges = zipWith (\l r -> Just $ Edge l r) lE (reverse rE) + in ReduceRuleResult arisingEdges arisingNodes From fa9b5648814f9839232c6bdc2236caf47059edd2 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 18 Nov 2024 21:39:03 +0300 Subject: [PATCH 34/54] Add some doctests in memory manager --- lamagraph-core/src/Core/MemoryManager.hs | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs index c35b922..5a4c1d6 100644 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -9,10 +9,19 @@ module Core.MemoryManager where import Clash.Prelude -import Control.Lens hiding (ifoldl) +import Control.Lens hiding (Index, ifoldl) import Core.Map import Core.Node +{- $setup +>>> import Clash.Prelude +>>> import Core.Node +>>> import Core.Map +>>> import Control.Lens hiding (ifoldl, Index) +>>> :set -XAllowAmbiguousTypes +>>> :set -XLambdaCase +-} + data EdgeEnd (portsNumber :: Nat) = EdgeEnd { _addressOfVertex :: AddressNumber , _idOfPort :: IdOfPort portsNumber @@ -37,7 +46,7 @@ data ActivePair (portsNumber :: Nat) = ActivePair $(makeLenses ''ActivePair) -data MemoryManager (cellsNumber :: Nat) -- (portsNumber :: Nat) +data MemoryManager (cellsNumber :: Nat) = MemoryManager { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" , _activePairs :: Vec cellsNumber Bool @@ -65,7 +74,13 @@ getUnusedAddress busyMap = address indexOfUnused = elemIndex False busyMap address = bitCoerce <$> indexOfUnused --- | Mark given `AddressNumber` as busy or not according to passed flag (`True` means busy) +{- | Mark given `AddressNumber` as busy or not according to passed flag (`True` means busy) + +==== __Example__ + +>>> markAddress (repeat False :: Vec 4 Bool) True 2 +False :> False :> True :> False :> Nil +-} markAddress :: (KnownNat cellsNumber) => Vec cellsNumber Bool -> @@ -167,7 +182,7 @@ data LocalFlag deriving (Eq) {- | Update ports info in attached `Node`. -It accumulates in key-value map, where key is `ActualAddressNum` and value is a pair of `NodePortsInfo` and `LocalFlag` to distinguish local and external nodes. +It accumulates in key-value map, where key is `ActualAddressNumber` and value is a pair of `NodePortsInfo` and `LocalFlag` to distinguish local and external nodes. The first one we can load from locals and another one we have to load from ram -} updatePortsInfoByPort :: From 4afd3468863a475c5235d6dca50a994184ceb964 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 18 Nov 2024 21:42:08 +0300 Subject: [PATCH 35/54] Weakened Index to Unsigned constraint --- lamagraph-core/src/Core/MemoryManager.hs | 36 ++++++++++++++++++------ 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs index 5a4c1d6..691bbbf 100644 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -64,15 +64,35 @@ data Delta (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = Delt $(makeLenses ''Delta) --- | Get address from memory manager that is not busy. Return `Nothing` if all addresses are busy +{- | Cast `Index` to `Unsigned` if possible by adding non-significant zeros + +==== __Example__ + +>>> indexToUnsigned (2 :: Index 4) :: Unsigned 16 +2 +-} +indexToUnsigned :: + forall n m. + (KnownNat n, KnownNat m, 1 <= n, CLog 2 n <= m) => + Index n -> + Unsigned m +indexToUnsigned v = unpack ((def :: BitVector (m - BitSize (Index n))) ++# pack v) + +{- | Get address from memory manager that is not busy. Return `Nothing` if all addresses are busy + +==== __Example__ + +>>> getUnusedAddress (repeat False :: Vec 65536 Bool) +Just 0 +-} getUnusedAddress :: - (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16) => + (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber) => Vec cellsNumber Bool -> Maybe ActualAddressNumber getUnusedAddress busyMap = address where indexOfUnused = elemIndex False busyMap - address = bitCoerce <$> indexOfUnused + address = indexToUnsigned <$> indexOfUnused {- | Mark given `AddressNumber` as busy or not according to passed flag (`True` means busy) @@ -124,7 +144,7 @@ freeUpActivePair busyMap activePairToFree = markAddress (markAddress busyMap Fal -- | Give unused `AddressNumber` to `LocalNode` registerAddressNumToNewNode :: - (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16) => + (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber) => Vec cellsNumber Bool -> ActualAddressNumber registerAddressNumToNewNode busyMap = addressNum @@ -137,7 +157,7 @@ registerAddressNumToNewNode busyMap = addressNum It is the composition of `registerAddressNumToNewNode` and `markAddress` just for usability -} getLoadedFromLocal :: - (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber ~ 16, KnownNat portsNumber) => + (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber, KnownNat portsNumber) => Vec cellsNumber Bool -> LocalNode portsNumber -> (Vec cellsNumber Bool, LoadedNode portsNumber) @@ -257,7 +277,7 @@ newNodeIsActive node = -- | Assign new `ActualAddressNumber` to `LocalNode` and mark busy bit map assignNewAddressToLocalNode :: - (CLog 2 cellsNumber ~ 16, KnownNat cellsNumber, KnownNat portsNumber, 1 <= cellsNumber) => + (CLog 2 cellsNumber <= BitSize AddressNumber, KnownNat cellsNumber, KnownNat portsNumber, 1 <= cellsNumber) => Signal dom (Maybe (LocalNode portsNumber)) -> Signal dom (Vec cellsNumber Bool) -> (Signal dom (Vec cellsNumber Bool), Signal dom (Maybe (LoadedNode portsNumber))) @@ -321,9 +341,9 @@ updateMM :: , KnownNat portsNumber , KnownNat edgeNumber , 1 <= cellsNumber - , CLog 2 cellsNumber ~ 16 + , CLog 2 cellsNumber <= BitSize AddressNumber , 1 <= edgeNumber - , CLog 2 edgeNumber ~ 16 + , CLog 2 edgeNumber <= BitSize AddressNumber , KnownNat maxNumOfChangedNodes , KnownDomain dom ) => From fa5f3bef41177d3bc36614ca3beab2a5c20ff1c7 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 18 Nov 2024 21:43:52 +0300 Subject: [PATCH 36/54] Update simple lambda reduction rule Add epsilon agent Move concrete reduction rules into separate functions add docs with images to them --- lamagraph-core/docs/apply.svg | 126 +++++++++++ lamagraph-core/docs/apply_to_lambda_rule.svg | 174 +++++++++++++++ lamagraph-core/docs/eps_apply_rule.svg | 207 ++++++++++++++++++ lamagraph-core/lamagraph-core.cabal | 1 + .../src/Core/Concrete/ReduceRulesLambda.hs | 74 +++++-- lamagraph-core/src/INet/Net.hs | 5 - 6 files changed, 559 insertions(+), 28 deletions(-) create mode 100644 lamagraph-core/docs/apply.svg create mode 100644 lamagraph-core/docs/apply_to_lambda_rule.svg create mode 100644 lamagraph-core/docs/eps_apply_rule.svg diff --git a/lamagraph-core/docs/apply.svg b/lamagraph-core/docs/apply.svg new file mode 100644 index 0000000..e249467 --- /dev/null +++ b/lamagraph-core/docs/apply.svg @@ -0,0 +1,126 @@ + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @ + + + + + + + + + + + + + + + + + + λ + + + + + + + + + + + + + + + + + + λ + + + + + + + + + + + + + + + + + + + + diff --git a/lamagraph-core/docs/apply_to_lambda_rule.svg b/lamagraph-core/docs/apply_to_lambda_rule.svg new file mode 100644 index 0000000..fbbbc48 --- /dev/null +++ b/lamagraph-core/docs/apply_to_lambda_rule.svg @@ -0,0 +1,174 @@ + +image/svg+xml@ +λ +→ + \ No newline at end of file diff --git a/lamagraph-core/docs/eps_apply_rule.svg b/lamagraph-core/docs/eps_apply_rule.svg new file mode 100644 index 0000000..6a6dd2e --- /dev/null +++ b/lamagraph-core/docs/eps_apply_rule.svg @@ -0,0 +1,207 @@ + +image/svg+xmlϵ +α +... +→ +ϵ +... +ϵ + \ No newline at end of file diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index 3447835..8dede94 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -4,6 +4,7 @@ version: 0.1 license: BSD-2-Clause author: John Smith maintainer: John Smith +extra-doc-files: docs/*.svg common common-options default-extensions: diff --git a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs index 8bdb381..a519234 100644 --- a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs +++ b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs @@ -1,40 +1,68 @@ {- | All modules from Concrete are -1a. Compiled from some dsl in separate file -1b. Compiled from embedded dsl in INet module -2. Written by hands for tests + +1. Compiled from some dsl in separate file + +2. Compiled from embedded dsl in `INet.Net` module + +3. Written by hands for tests -} module Core.Concrete.ReduceRulesLambda where import Clash.Prelude -import Control.Lens +import Control.Lens hiding (Index, imap) import Core.MemoryManager import Core.Node import Core.Reducer import INet.Net +-- | One reduce step (|><|) :: - -- forall portsNumber nodesNumber edgesNumber. - -- (KnownNat portsNumber, KnownNat nodesNumber, KnownNat edgesNumber, edgesNumber ~ portsNumber) => - -- Node portsNumber -> - -- Node portsNumber -> - -- ReduceRuleResult nodesNumber edgesNumber portsNumber Node 2 -> Node 2 -> - ReduceRuleResult 0 2 2 + ReduceRuleResult 2 2 2 lNode |><| rNode = case (lNode ^. nodeType, rNode ^. nodeType) of (Apply, Abs) -> applyToLambdaRule lNode rNode (Abs, Apply) -> applyToLambdaRule lNode rNode + (Eps, _) -> epsToAnyRule lNode rNode + (_, Eps) -> epsToAnyRule rNode lNode _ -> error "There is no rule for this active pair in the reduction rules" - where - applyToLambdaRule n1 n2 = - let arisingNodes = def - portToEdgeEnd p = case p ^. nodeAddress of - Nothing -> error "Port must to be connected" - Just addr -> case addr of - ActualAddress addrNum -> EdgeEnd addrNum (p ^. portConnectedToId) - LocalAddress addrNum -> EdgeEnd addrNum (p ^. portConnectedToId) -- Maybe this is should be more complicated - portsToEdgeEnds node = map (maybe (error "All Ports must to be presented") portToEdgeEnd) (node ^. secondaryPorts) - lE = portsToEdgeEnds n1 - rE = portsToEdgeEnds n2 - arisingEdges = zipWith (\l r -> Just $ Edge l r) lE (reverse rE) - in ReduceRuleResult arisingEdges arisingNodes + +{- | Reduce rule for `Apply` and `Abs` + +<> +-} +applyToLambdaRule :: + (KnownNat nodesNumber) => + Node 2 -> + Node 2 -> + ReduceRuleResult nodesNumber 2 2 +applyToLambdaRule n1 n2 = + let arisingNodes = def + portToEdgeEnd p = case p ^. nodeAddress of + Nothing -> error "Port must to be connected" + Just addr -> case addr of + ActualAddress addrNum -> EdgeEnd addrNum (p ^. portConnectedToId) + LocalAddress addrNum -> EdgeEnd addrNum (p ^. portConnectedToId) -- Maybe this is should be more complicated + portsToEdgeEnds node = map (maybe (error "All Ports must to be presented") portToEdgeEnd) (node ^. secondaryPorts) + lE = portsToEdgeEnds n1 + rE = portsToEdgeEnds n2 + arisingEdges = zipWith (\l r -> Just $ Edge l r) lE (reverse rE) + in ReduceRuleResult arisingEdges arisingNodes + +{- | Reduce rule for `Eps` and everything else. + +<> +-} +epsToAnyRule :: + (KnownNat portsNumber, KnownNat edgesNumber, CLog 2 portsNumber <= BitSize AddressNumber, 1 <= portsNumber) => + Node portsNumber -> + Node portsNumber -> + ReduceRuleResult portsNumber edgesNumber portsNumber +epsToAnyRule _ nSome = + let arisingEdges = def + genNewEpsNode port = Node port def Eps + arisingNodes = + imap + (\i maybePort -> flip LocalNode (indexToUnsigned i) . genNewEpsNode <$> maybePort) + (nSome ^. secondaryPorts) + in ReduceRuleResult arisingEdges arisingNodes diff --git a/lamagraph-core/src/INet/Net.hs b/lamagraph-core/src/INet/Net.hs index 88893cf..f24c440 100644 --- a/lamagraph-core/src/INet/Net.hs +++ b/lamagraph-core/src/INet/Net.hs @@ -5,11 +5,6 @@ import Clash.Prelude data AgentSimpleLambda = Apply | Abs - deriving (NFDataX, Generic, Show, Eq) - -data AgentCombinator - = Delta - | Gamma | Eps deriving (NFDataX, Generic, Show, Eq) From ed75dd2c7aa296446611f89d2472976284bc49d8 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 18 Nov 2024 21:58:52 +0300 Subject: [PATCH 37/54] Rewrite indexToUnsigned via resize and bitCoerce --- lamagraph-core/src/Core/MemoryManager.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs index 691bbbf..b65385d 100644 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -76,7 +76,7 @@ indexToUnsigned :: (KnownNat n, KnownNat m, 1 <= n, CLog 2 n <= m) => Index n -> Unsigned m -indexToUnsigned v = unpack ((def :: BitVector (m - BitSize (Index n))) ++# pack v) +indexToUnsigned v = bitCoerce (resize v :: Index (2 ^ m)) {- | Get address from memory manager that is not busy. Return `Nothing` if all addresses are busy From c8d17afde58ad0f210e5f93b789afea6b607e303 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Tue, 19 Nov 2024 16:44:19 +0300 Subject: [PATCH 38/54] Add skipping svg files in pre-commit --- .pre-commit-config.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 1c9c025..c96c0ce 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -4,7 +4,7 @@ repos: hooks: - id: trailing-whitespace - id: end-of-file-fixer - exclude: "ast/.*|ppr/.*" + exclude: "ast/.*|ppr/.*|.*.svg" - id: check-yaml - id: fix-byte-order-marker - id: mixed-line-ending From 25645701a549ed8b475146e1ff93bcd59b064556 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 25 Nov 2024 12:19:17 +0300 Subject: [PATCH 39/54] Fix doctests Add plugins with solvers in setup part. Perhaps this can be solved more correctly --- lamagraph-core/src/Core/MemoryManager.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs index b65385d..786494a 100644 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager.hs @@ -9,7 +9,7 @@ module Core.MemoryManager where import Clash.Prelude -import Control.Lens hiding (Index, ifoldl) +import Control.Lens hiding (Index, ifoldl, imap, (:>)) import Core.Map import Core.Node @@ -17,9 +17,11 @@ import Core.Node >>> import Clash.Prelude >>> import Core.Node >>> import Core.Map ->>> import Control.Lens hiding (ifoldl, Index) +>>> import Control.Lens hiding (Index, ifoldl, imap, (:>)) >>> :set -XAllowAmbiguousTypes ->>> :set -XLambdaCase +>>> :set -fplugin GHC.TypeLits.Extra.Solver +>>> :set -fplugin GHC.TypeLits.KnownNat.Solver +>>> :set -fplugin GHC.TypeLits.Normalise -} data EdgeEnd (portsNumber :: Nat) = EdgeEnd From 9fce015942cd89dceb795d286357d9f54d11a935 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Thu, 28 Nov 2024 11:08:55 +0300 Subject: [PATCH 40/54] Rename agent constructors --- lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs | 10 +++++----- lamagraph-core/src/INet/Net.hs | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs index a519234..29de6ec 100644 --- a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs +++ b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs @@ -21,10 +21,10 @@ import INet.Net Node 2 -> ReduceRuleResult 2 2 2 lNode |><| rNode = case (lNode ^. nodeType, rNode ^. nodeType) of - (Apply, Abs) -> applyToLambdaRule lNode rNode - (Abs, Apply) -> applyToLambdaRule lNode rNode - (Eps, _) -> epsToAnyRule lNode rNode - (_, Eps) -> epsToAnyRule rNode lNode + (Apply, Abstract) -> applyToLambdaRule lNode rNode + (Abstract, Apply) -> applyToLambdaRule lNode rNode + (Erase, _) -> epsToAnyRule lNode rNode + (_, Erase) -> epsToAnyRule rNode lNode _ -> error "There is no rule for this active pair in the reduction rules" {- | Reduce rule for `Apply` and `Abs` @@ -60,7 +60,7 @@ epsToAnyRule :: ReduceRuleResult portsNumber edgesNumber portsNumber epsToAnyRule _ nSome = let arisingEdges = def - genNewEpsNode port = Node port def Eps + genNewEpsNode port = Node port def Erase arisingNodes = imap (\i maybePort -> flip LocalNode (indexToUnsigned i) . genNewEpsNode <$> maybePort) diff --git a/lamagraph-core/src/INet/Net.hs b/lamagraph-core/src/INet/Net.hs index f24c440..b2de6c7 100644 --- a/lamagraph-core/src/INet/Net.hs +++ b/lamagraph-core/src/INet/Net.hs @@ -4,8 +4,8 @@ import Clash.Prelude data AgentSimpleLambda = Apply - | Abs - | Eps + | Abstract + | Erase deriving (NFDataX, Generic, Show, Eq) -- It is kind of hack. We need do it smarter later From 3547c90ec6a75c98ab3de75f35123958c23bb2a0 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 8 Dec 2024 12:00:28 +0300 Subject: [PATCH 41/54] Rework Port and Node, add Connection type --- lamagraph-core/src/Core/Node.hs | 72 +++++++++++++++++---------------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index 6758acc..e62ec47 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -1,24 +1,35 @@ +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-} module Core.Node where import Clash.Prelude -import Control.Lens (makeLenses, (^.)) +import Control.Lens (makeLenses, set, (^.)) import INet.Net +{- | Type alias for `Maybe Port` with aliased constructors too. +This can be useful for distinguish connected to something `Port`, free `Port` that is not connected and void `Port`. +The last one come from situation when max number of ports (i.e. max arity) greater than arity of the given `Node`. +-} +type Connection (portsNumber :: Nat) = Maybe (Port portsNumber) + +pattern Connected :: Port portsNumber -> Connection portsNumber +pattern Connected x = Just x + +pattern NotConnected :: Connection portsNumber +pattern NotConnected = Nothing +{-# COMPLETE Connected, NotConnected #-} + type AddressNumber = Unsigned 16 type LocalAddressNumber = AddressNumber type ActualAddressNumber = AddressNumber data IdOfPort (portsNumber :: Nat) = Id (Index portsNumber) | Primary - deriving (Generic, Show, Eq, NFDataX) -- Index numberOfPorts - -data Address = ActualAddress ActualAddressNumber | LocalAddress LocalAddressNumber - deriving (NFDataX, Generic, Show, Eq) + deriving (Generic, Show, Eq, NFDataX) data Port (portsNumber :: Nat) = Port - { _nodeAddress :: Maybe Address + { _nodeAddress :: AddressNumber , _portConnectedToId :: IdOfPort portsNumber } deriving (NFDataX, Generic, Show, Eq) @@ -27,8 +38,8 @@ $(makeLenses ''Port) -- | Node in the RAM. data Node portsNumber = Node - { _primaryPort :: Port portsNumber - , _secondaryPorts :: Vec portsNumber (Maybe (Port portsNumber)) + { _primaryPort :: Connection portsNumber + , _secondaryPorts :: Vec portsNumber (Maybe (Connection portsNumber)) , _nodeType :: Agent -- looks like we need some kind of node label. Info about and reduction rules contained IN } deriving (NFDataX, Generic, Show, Eq) @@ -48,33 +59,24 @@ data LoadedNode (portsNumber :: Nat) = LoadedNode $(makeLenses ''LoadedNode) --- | Analog of `LoadedNode` with local address. Redundant, just for simplification of signatures. -data LocalNode (portsNumber :: Nat) = LocalNode - { _numberedNode :: Node portsNumber - , _localAddress :: LocalAddressNumber - } - deriving (NFDataX, Generic, Show, Eq) - -$(makeLenses ''LocalNode) - --- | Check if pair of `LoadedNode` are active, i.e. they are connected by primary ports. -isActive :: - LoadedNode numberOfPorts -> - LoadedNode numberOfPorts -> - Bool -isActive leftNode rightNode = - leftNodePrimaryPortAddress == Just (ActualAddress (rightNode ^. originalAddress)) - && rightNodePrimaryPortAddress == Just (ActualAddress (leftNode ^. originalAddress)) - where - Port leftNodePrimaryPortAddress _ = leftNode ^. containedNode . primaryPort - Port rightNodePrimaryPortAddress _ = rightNode ^. containedNode . primaryPort - -getPortById :: +{- | Check if pair of `LoadedNode` are active, i.e. they are connected by primary ports. +| Check if `Node` is active +-} +nodeIsActive :: + (KnownNat portsNumber) => Node portsNumber -> Bool +nodeIsActive node = + case node ^. primaryPort of + Just port -> case port ^. portConnectedToId of + Primary -> True + _ -> False + _ -> False + +setConnection :: (KnownNat portsNumber) => Node portsNumber -> IdOfPort portsNumber -> - Maybe (Port portsNumber) -getPortById node idOfPort = - case idOfPort of - Primary -> Just $ node ^. primaryPort - Id index -> (node ^. secondaryPorts) !! index + Connection portsNumber -> + Node portsNumber +setConnection node portId connection = case portId of + Primary -> set primaryPort connection node + Id index -> set secondaryPorts (replace index (Just connection) (node ^. secondaryPorts)) node From 3893e18c00345d3a8f7ab664435d3902a15c9afd Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 8 Dec 2024 12:48:25 +0300 Subject: [PATCH 42/54] Split MemoryManager functionality * Extract work with memory * Extract work with accumulated changes * Extract work with accumulating of changes * Add MemoryManager splitting in .cabal file --- lamagraph-core/lamagraph-core.cabal | 4 +- .../Core/MemoryManager/ChangesAccumulator.hs | 155 ++++++++++++++++ .../src/Core/MemoryManager/MemoryManager.hs | 172 ++++++++++++++++++ .../src/Core/MemoryManager/NodeChanges.hs | 55 ++++++ 4 files changed, 385 insertions(+), 1 deletion(-) create mode 100644 lamagraph-core/src/Core/MemoryManager/ChangesAccumulator.hs create mode 100644 lamagraph-core/src/Core/MemoryManager/MemoryManager.hs create mode 100644 lamagraph-core/src/Core/MemoryManager/NodeChanges.hs diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index 8dede94..a9596e6 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -89,7 +89,9 @@ library exposed-modules: Core.Node Core.Reducer - Core.MemoryManager + Core.MemoryManager.MemoryManager + Core.MemoryManager.ChangesAccumulator + Core.MemoryManager.NodeChanges Core.Map Core.Concrete.ReduceRulesLambda INet.Net diff --git a/lamagraph-core/src/Core/MemoryManager/ChangesAccumulator.hs b/lamagraph-core/src/Core/MemoryManager/ChangesAccumulator.hs new file mode 100644 index 0000000..9795f3b --- /dev/null +++ b/lamagraph-core/src/Core/MemoryManager/ChangesAccumulator.hs @@ -0,0 +1,155 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Eta reduce" #-} +{-# HLINT ignore "Functor law" #-} + +module Core.MemoryManager.ChangesAccumulator (getAllChangesByDelta) where + +import Clash.Prelude +import Control.Lens hiding (ifoldl) +import Core.Map +import Core.MemoryManager.NodeChanges +import Core.Node +import Core.Reducer + +-- | Type alias for triple (the address of the external node to update, the id of the port to update, the port to update to) +type UpdateInfo (portsNumber :: Nat) = (AddressNumber, IdOfPort portsNumber, Connection portsNumber) + +{- | Generate update information in attached external `Node`. +The result can be interpreted as +- `Just` `UpdateInfo` +- `Nothing` if `Node` is not in `Interface` +-} +getUpdateInfoByPort :: + forall portsNumber maxNumOfChangedNodes. + (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => + AddressNumber -> + Interface maxNumOfChangedNodes -> + Connection portsNumber -> + IdOfPort portsNumber -> + Maybe (UpdateInfo portsNumber) +getUpdateInfoByPort addressPointTo interface port portId = + case port of + Connected (Port addressNumber connectedToPortId) -> if Just addressNumber `elem` interface then update addressNumber else def + where + newPort = Connected $ Port addressPointTo portId + update addressNum = Just (addressNum, connectedToPortId, newPort) + NotConnected -> Nothing + +{- | The same as `updatePortsInfoByPort`, but updating happens by `Edge`. +In fact it accumulate info about which external `LoadedNode` have become connected with each other +-} +getUpdateInfoByEdge :: + forall portsNumber. + (KnownNat portsNumber) => + Edge portsNumber -> + ( Maybe (UpdateInfo portsNumber) + , Maybe (UpdateInfo portsNumber) + ) +getUpdateInfoByEdge (Edge maybeLeftEdge maybeRightEdge) = + (leftUpdate, rightUpdate) + where + leftUpdate = case maybeRightEdge of + Connected (Port address portId) -> Just (address, portId, maybeLeftEdge) + NotConnected -> Nothing + rightUpdate = case maybeLeftEdge of + Connected (Port address portId) -> Just (address, portId, maybeRightEdge) + NotConnected -> Nothing + +-- | Insert update information into `Map` +insertInInfoVec :: + (KnownNat size, KnownNat portsNumber) => + Map size (Changes portsNumber) -> + Maybe (UpdateInfo portsNumber) -> + Map size (Changes portsNumber) +insertInInfoVec infoVec maybeInsertionInfo = + case maybeInsertionInfo of + Nothing -> infoVec + Just (address, portId, newPort) -> + insertWith + infoVec + (insertFunction portId newPort) + address + where + insertFunction portId newPort maybeInfo = Just $ maybe (constructNewInfo def) constructNewInfo maybeInfo + where + constructNewInfo info@(Changes secPortsInfo _) = case portId of + Primary -> set primeP (Just newPort) info + Id i -> set secP (replace i (Just newPort) secPortsInfo) info + +-- | Accumulate all changes by ports of the given `Node` and write it in the `Map` +accumulatePortsChangesByLoadedNode :: + forall portsNumber maxNumOfChangedNodes. + (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => + Map maxNumOfChangedNodes (Changes portsNumber) -> + Interface maxNumOfChangedNodes -> + LoadedNode portsNumber -> + Map maxNumOfChangedNodes (Changes portsNumber) +accumulatePortsChangesByLoadedNode infoVec interface signalLoadedNode = + let updateToConcreteNode = getUpdateInfoByPort signalAddress interface + signalAddress = view originalAddress signalLoadedNode + infoVecByPrimary = + insertInInfoVec + infoVec + ( updateToConcreteNode + (view (containedNode . primaryPort) signalLoadedNode) + Primary + ) + in ifoldl + ( \oldInfoVec i signalMaybePort -> case signalMaybePort of + Nothing -> oldInfoVec + Just signalPort -> insertInInfoVec oldInfoVec (updateToConcreteNode signalPort (Id i)) + ) + infoVecByPrimary + (view (containedNode . secondaryPorts) signalLoadedNode) + +-- | Accumulate all changes by new `Node`s from `Delta` +accumulateUpdatesByNodes :: + (KnownNat nodesNumber, KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => + Map maxNumOfChangedNodes (Changes portsNumber) -> + Interface maxNumOfChangedNodes -> + Vec nodesNumber (Maybe (LoadedNode portsNumber)) -> + Map maxNumOfChangedNodes (Changes portsNumber) +accumulateUpdatesByNodes infoVec interface loadedNodes = + foldl + ( \oldInfoVec maybeLoadedNode -> case maybeLoadedNode of + Nothing -> oldInfoVec + Just loadedNode -> accumulatePortsChangesByLoadedNode oldInfoVec interface loadedNode + ) + infoVec + loadedNodes + +-- | Insert update information of the `Edge` into the `Map` +insertPairInInfoVec :: + (KnownNat size, KnownNat portsNumber) => + Map size (Changes portsNumber) -> + (Maybe (UpdateInfo portsNumber), Maybe (UpdateInfo portsNumber)) -> + Map size (Changes portsNumber) +insertPairInInfoVec oldInfoVec (maybeLeftUpdateInfo, maybeRightUpdateInfo) = + insertInInfoVec (insertInInfoVec oldInfoVec maybeLeftUpdateInfo) maybeRightUpdateInfo + +-- | Accumulate all changes by `Edge`s from `Delta` +accumulateUpdatesByEdges :: + (KnownNat edgesNumber, KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => + Map maxNumOfChangedNodes (Changes portsNumber) -> + Vec edgesNumber (Maybe (Edge portsNumber)) -> + Map maxNumOfChangedNodes (Changes portsNumber) +accumulateUpdatesByEdges infoVec edgesForUpdate = + foldl + ( \oldInfoVec maybeEdge -> case maybeEdge of + Nothing -> oldInfoVec + Just edge -> insertPairInInfoVec oldInfoVec (getUpdateInfoByEdge edge) + ) + infoVec + edgesForUpdate + +-- | Get all changes from `Delta` +getAllChangesByDelta :: + (KnownNat edgesNumber, KnownNat nodesNumber, KnownNat maxNumOfChangedNodes, KnownNat portsNumber, KnownDomain dom) => + Signal dom (Delta nodesNumber edgesNumber portsNumber) -> + Signal dom (Interface maxNumOfChangedNodes) -> + Signal dom (Map maxNumOfChangedNodes (Changes portsNumber)) +getAllChangesByDelta delta interface = accumulateUpdatesByNodes <$> (accumulateUpdatesByEdges def <$> edgesForUpdate) <*> interface <*> nodesForUpdate + where + edgesForUpdate = view newEdges <$> delta + nodesForUpdate = view newNodes <$> delta diff --git a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs new file mode 100644 index 0000000..4444151 --- /dev/null +++ b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs @@ -0,0 +1,172 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Eta reduce" #-} +{-# HLINT ignore "Functor law" #-} + +module Core.MemoryManager.MemoryManager ( + MemoryManager (..), + busyBitMap, + activePairs, + giveAddresses, + removeActivePair, +) where + +import Clash.Prelude +import Control.Lens hiding (Index, imap) +import Core.Node +import Core.Reducer + +{- $setup +>>> import Clash.Prelude +>>> import Core.Node +>>> import Core.Map +>>> import Control.Lens hiding (Index, ifoldl, imap, (:>)) +>>> :set -XAllowAmbiguousTypes +>>> :set -fplugin GHC.TypeLits.Extra.Solver +>>> :set -fplugin GHC.TypeLits.KnownNat.Solver +>>> :set -fplugin GHC.TypeLits.Normalise +-} + +{- | Cast `Index` to `Unsigned` if possible by adding non-significant zeros + +==== __Example__ + +>>> indexToUnsigned (2 :: Index 4) :: Unsigned 16 +2 +-} +indexToUnsigned :: + forall n m. + (KnownNat n, KnownNat m, 1 <= n, CLog 2 n <= m) => + Index n -> + Unsigned m +indexToUnsigned v = bitCoerce (resize v :: Index (2 ^ m)) + +-- | Get `Vec` of free `AddressNumber`s of given size +getFreeAddresses :: + forall addressesCount dom cellsNumber. + ( (addressesCount + 1) <= cellsNumber + , KnownNat cellsNumber + , KnownNat addressesCount + , KnownDomain dom + , CLog 2 cellsNumber <= BitSize AddressNumber + ) => + Signal dom (SNat addressesCount) -> + Signal dom (Vec cellsNumber Bool) -> + Signal dom (Vec addressesCount AddressNumber) +getFreeAddresses addressesCount busyMap = + helper 0 0 (unbundle busyMap) def + where + helper :: + Signal dom (Index cellsNumber) -> + Index cellsNumber -> + Vec m (Signal dom Bool) -> + Vec addressesCount (Signal dom AddressNumber) -> + Signal dom (Vec addressesCount AddressNumber) + helper allocatedCount busyMapIndex busyMapRemind addresses = case busyMapRemind of + Nil -> error "Memory space is over" + Cons isBusy remind -> + mux + (not <$> isBusy) + ( mux + ((1 + allocatedCount) .==. (fromSNat <$> addressesCount :: Signal dom (Index cellsNumber))) + (bundle (pure (indexToUnsigned busyMapIndex) +>> addresses)) + (helper (allocatedCount + 1) (busyMapIndex + 1) remind (pure (indexToUnsigned busyMapIndex) +>> addresses)) + ) + (helper allocatedCount (busyMapIndex + 1) remind addresses) + +-- | Mark given `AddressNumber`s as busy in busy map +markAddressesAsBusy :: + (KnownDomain dom, KnownNat cellsNumber, KnownNat n, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber) => + Signal dom (Vec cellsNumber Bool) -> + Signal dom (Vec n AddressNumber) -> + Signal dom (Vec cellsNumber Bool) +markAddressesAsBusy busyMap addresses = bundle $ imap (\i _ -> elem (indexToUnsigned i) <$> addresses) (unbundle busyMap) + +data MemoryManager (cellsNumber :: Nat) + = MemoryManager + { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" + , _activePairs :: Vec cellsNumber Bool + } + deriving (Generic, NFDataX, Bundle) + +$(makeLenses ''MemoryManager) + +giveAddresses :: + ( (addressesCount + 1) <= cellsNumber + , KnownNat cellsNumber + , KnownNat addressesCount + , KnownDomain dom + , CLog 2 cellsNumber <= BitSize AddressNumber + ) => + Signal dom (SNat addressesCount) -> + Signal dom (MemoryManager cellsNumber) -> + (Signal dom (Vec addressesCount AddressNumber), Signal dom (MemoryManager cellsNumber)) +giveAddresses addressesCount memoryManager = (addresses, set busyBitMap <$> newBusyMap <*> memoryManager) + where + addresses = getFreeAddresses addressesCount (view busyBitMap <$> memoryManager) + newBusyMap = markAddressesAsBusy (view busyBitMap <$> memoryManager) addresses + +{- | Mark given `AddressNumber` as busy or not according to passed flag (`True` means busy) + +==== __Example__ + +>>> markAddress (repeat False :: Vec 4 Bool) True 2 +False :> False :> True :> False :> Nil +-} +markAddress :: + (KnownNat cellsNumber) => + Vec cellsNumber Bool -> + Bool -> + ActualAddressNumber -> + Vec cellsNumber Bool +markAddress busyMap marker address = + replace address marker busyMap + +-- | Replace processed active pair at `False` in `Vec` of active pairs +deleteActivePair :: + (KnownNat cellsNumber, KnownNat portsNumber) => + Vec cellsNumber Bool -> + ActivePair portsNumber -> + Vec cellsNumber Bool +deleteActivePair oldActivePairs activePairToDelete = + if leftInVec `xor` rightInVec + then newActivePairs + else error "In active pairs map should be exact one address" -- TODO: add link to the docs + where + leftInVec = oldActivePairs !! (activePairToDelete ^. leftNode . originalAddress) + rightInVec = oldActivePairs !! (activePairToDelete ^. rightNode . originalAddress) + newActivePairs = + if leftInVec + then + replace (activePairToDelete ^. leftNode . originalAddress) False oldActivePairs + else + replace (activePairToDelete ^. rightNode . originalAddress) False oldActivePairs + +-- | Mark `ActivePair`'s place as free +freeUpActivePair :: + (KnownNat cellsNumber, KnownNat portsNumber) => + Vec cellsNumber Bool -> + ActivePair portsNumber -> + Vec cellsNumber Bool +freeUpActivePair busyMap activePairToFree = markAddress (markAddress busyMap False leftNodeAddress) False rightNodeAddress + where + chooseAddress choice = activePairToFree ^. choice . originalAddress + leftNodeAddress = chooseAddress leftNode + rightNodeAddress = chooseAddress rightNode + +-- | Remove all information about `ActivePair` from `MemoryManager` +removeActivePair :: + (KnownNat cellsNumber, KnownNat portsNumber, KnownDomain dom) => + Signal dom (ActivePair portsNumber) -> + Signal dom (MemoryManager cellsNumber) -> + Signal dom (MemoryManager cellsNumber) +removeActivePair acPair memoryManager = + set busyBitMap + <$> newBusyMap + <*> ( set activePairs + <$> newActivePairs + <*> memoryManager + ) + where + newActivePairs = deleteActivePair <$> (view activePairs <$> memoryManager) <*> acPair + newBusyMap = freeUpActivePair <$> (view busyBitMap <$> memoryManager) <*> acPair diff --git a/lamagraph-core/src/Core/MemoryManager/NodeChanges.hs b/lamagraph-core/src/Core/MemoryManager/NodeChanges.hs new file mode 100644 index 0000000..e2d1108 --- /dev/null +++ b/lamagraph-core/src/Core/MemoryManager/NodeChanges.hs @@ -0,0 +1,55 @@ +module Core.MemoryManager.NodeChanges ( + Changes (..), + secP, + primeP, + updateLoadedNodesByChanges, +) where + +import Clash.Prelude +import Control.Lens hiding (Index, ifoldl, imap, (:>)) +import Core.Map +import Core.Node +import Data.Maybe + +-- | Data to accumulate all `Port` changes of the `Node` +data Changes (portsNumber :: Nat) + = Changes + { _secP :: Vec portsNumber (Maybe (Connection portsNumber)) + , _primeP :: Maybe (Connection portsNumber) + } + deriving (Show, Eq, Generic, NFDataX, Default) + +$(makeLenses ''Changes) + +-- | Update `Port`s of `Node` by `Changes` +applyChangesToNode :: + (KnownNat portsNumber) => + Node portsNumber -> + Changes portsNumber -> + Node portsNumber +applyChangesToNode oldNode (Changes maybeSecPortsAddr maybePrimaryPort) = + set primaryPort newPrimaryPort (set secondaryPorts newSecondaryPorts oldNode) + where + newSecondaryPorts = + zipWith + (<|>) + maybeSecPortsAddr + (oldNode ^. secondaryPorts) + newPrimaryPort = case maybePrimaryPort of + Nothing -> oldNode ^. primaryPort + Just primPort -> primPort + +-- | Update external `LoadedNode`s by accumulated `Changes` +updateLoadedNodesByChanges :: + (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => + Vec maxNumOfChangedNodes (Maybe (LoadedNode portsNumber)) -> + Map maxNumOfChangedNodes (Changes portsNumber) -> + Vec maxNumOfChangedNodes (Maybe (LoadedNode portsNumber)) +updateLoadedNodesByChanges externalLoadedNodes mapOfChanges = + map + (\maybeLoadedNode -> applyChangesToLoadedNode <$> maybeLoadedNode <*> (getChangesByLoadedNode <$> maybeLoadedNode)) + externalLoadedNodes + where + getChangesByAddress address = fromMaybe (error "some error") (find mapOfChanges address) -- TODO: think about error message + getChangesByLoadedNode loadedNode = getChangesByAddress $ loadedNode ^. originalAddress + applyChangesToLoadedNode loadedNode change = over containedNode (`applyChangesToNode` change) loadedNode From 3262a0455fbcbef8345e2eea4b76f4d5e904bbdb Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 8 Dec 2024 13:07:21 +0300 Subject: [PATCH 43/54] Replace Edge, ActivePair and Delta type --- lamagraph-core/src/Core/Reducer.hs | 35 +++++++++++++++++++++++++----- 1 file changed, 30 insertions(+), 5 deletions(-) diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index a411a49..0363be7 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -1,25 +1,50 @@ -{-# HLINT ignore "Functor law" #-} --- {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Functor law" #-} + module Core.Reducer where import Clash.Prelude -import Control.Lens (makeLenses, view, (^.)) -import Core.MemoryManager +import Control.Lens import Core.Node type NumOfNodesToStore = Unsigned 3 type NumOfEdgesToStore = Unsigned 3 +data Edge (portsNumber :: Nat) = Edge + { _leftEnd :: Connection portsNumber + , _rightEnd :: Connection portsNumber + } + deriving (Generic, NFDataX, Show, Eq) + +$(makeLenses ''Edge) + +data ActivePair (portsNumber :: Nat) = ActivePair + { _leftNode :: LoadedNode portsNumber + , _rightNode :: LoadedNode portsNumber + } + deriving (Show, Eq, Generic, NFDataX, Bundle) +$(makeLenses ''ActivePair) + -- | Result of abstract reduction rule data ReduceRuleResult (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = ReduceRuleResult { _edges :: Vec edgesNumber (Maybe (Edge portsNumber)) - , _nodes :: Vec nodesNumber (Maybe (LocalNode portsNumber)) + , _nodes :: Vec nodesNumber (Maybe (LoadedNode portsNumber)) } $(makeLenses ''ReduceRuleResult) +data Delta (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = Delta + { _newNodes :: Vec nodesNumber (Maybe (LoadedNode portsNumber)) + , _newEdges :: Vec edgesNumber (Maybe (Edge portsNumber)) + , _activePair :: ActivePair portsNumber + } + deriving (Show, Eq, Generic, NFDataX) + +$(makeLenses ''Delta) + +type Interface externalNodesNumber = Vec externalNodesNumber (Maybe AddressNumber) + toDelta :: (KnownNat portsNumber, KnownNat edgesNumber, KnownNat nodesNumber) => ActivePair portsNumber -> From 7ee225da07e90a13e16193ca874391d366663c30 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 8 Dec 2024 16:49:47 +0300 Subject: [PATCH 44/54] Replace types in MemoryManager modules --- lamagraph-core/src/Core/Loader.hs | 1 + lamagraph-core/src/Core/MemoryManager.hs | 452 ------------------ .../Core/MemoryManager/ChangesAccumulator.hs | 1 - .../src/Core/MemoryManager/MemoryManager.hs | 29 +- .../src/Core/MemoryManager/NodeChanges.hs | 28 ++ lamagraph-core/src/Core/Reducer.hs | 28 +- 6 files changed, 50 insertions(+), 489 deletions(-) delete mode 100644 lamagraph-core/src/Core/MemoryManager.hs diff --git a/lamagraph-core/src/Core/Loader.hs b/lamagraph-core/src/Core/Loader.hs index 3567a7d..381f4b0 100644 --- a/lamagraph-core/src/Core/Loader.hs +++ b/lamagraph-core/src/Core/Loader.hs @@ -1,6 +1,7 @@ module Core.Loader where import Clash.Prelude +import Core.MemoryManager.NodeChanges import Core.Node -- | Get `Node` by his `AddressNumber` from RAM. Actually, preparing to reducer work. diff --git a/lamagraph-core/src/Core/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager.hs deleted file mode 100644 index 786494a..0000000 --- a/lamagraph-core/src/Core/MemoryManager.hs +++ /dev/null @@ -1,452 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE LambdaCase #-} -{-# HLINT ignore "Eta reduce" #-} -{-# LANGUAGE PartialTypeSignatures #-} -{-# OPTIONS_GHC -Wno-partial-type-signatures #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} - -module Core.MemoryManager where - -import Clash.Prelude -import Control.Lens hiding (Index, ifoldl, imap, (:>)) -import Core.Map -import Core.Node - -{- $setup ->>> import Clash.Prelude ->>> import Core.Node ->>> import Core.Map ->>> import Control.Lens hiding (Index, ifoldl, imap, (:>)) ->>> :set -XAllowAmbiguousTypes ->>> :set -fplugin GHC.TypeLits.Extra.Solver ->>> :set -fplugin GHC.TypeLits.KnownNat.Solver ->>> :set -fplugin GHC.TypeLits.Normalise --} - -data EdgeEnd (portsNumber :: Nat) = EdgeEnd - { _addressOfVertex :: AddressNumber - , _idOfPort :: IdOfPort portsNumber - } - deriving (Generic, NFDataX, Show, Eq) - -$(makeLenses ''EdgeEnd) - -data Edge (portsNumber :: Nat) = Edge - { _leftEnd :: EdgeEnd portsNumber - , _rightEnd :: EdgeEnd portsNumber - } - deriving (Generic, NFDataX, Show, Eq) - -$(makeLenses ''Edge) - -data ActivePair (portsNumber :: Nat) = ActivePair - { _leftNode :: LoadedNode portsNumber - , _rightNode :: LoadedNode portsNumber - } - deriving (Show, Eq, Generic, NFDataX, Bundle) - -$(makeLenses ''ActivePair) - -data MemoryManager (cellsNumber :: Nat) - = MemoryManager - { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" - , _activePairs :: Vec cellsNumber Bool - } - deriving (Generic, NFDataX, Bundle) - -$(makeLenses ''MemoryManager) - -data Delta (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = Delta - { _newNodes :: Vec nodesNumber (Maybe (LocalNode portsNumber)) - , _newEdges :: Vec edgesNumber (Maybe (Edge portsNumber)) - , _activePair :: ActivePair portsNumber - } - deriving (Show, Eq, Generic, NFDataX) - -$(makeLenses ''Delta) - -{- | Cast `Index` to `Unsigned` if possible by adding non-significant zeros - -==== __Example__ - ->>> indexToUnsigned (2 :: Index 4) :: Unsigned 16 -2 --} -indexToUnsigned :: - forall n m. - (KnownNat n, KnownNat m, 1 <= n, CLog 2 n <= m) => - Index n -> - Unsigned m -indexToUnsigned v = bitCoerce (resize v :: Index (2 ^ m)) - -{- | Get address from memory manager that is not busy. Return `Nothing` if all addresses are busy - -==== __Example__ - ->>> getUnusedAddress (repeat False :: Vec 65536 Bool) -Just 0 --} -getUnusedAddress :: - (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber) => - Vec cellsNumber Bool -> - Maybe ActualAddressNumber -getUnusedAddress busyMap = address - where - indexOfUnused = elemIndex False busyMap - address = indexToUnsigned <$> indexOfUnused - -{- | Mark given `AddressNumber` as busy or not according to passed flag (`True` means busy) - -==== __Example__ - ->>> markAddress (repeat False :: Vec 4 Bool) True 2 -False :> False :> True :> False :> Nil --} -markAddress :: - (KnownNat cellsNumber) => - Vec cellsNumber Bool -> - Bool -> - ActualAddressNumber -> - Vec cellsNumber Bool -markAddress busyMap marker address = - replace address marker busyMap - --- | Replace processed active pair at `Nothing` in `Vec` of active pairs -deleteActivePair :: - (KnownNat cellsNumber, KnownNat portsNumber) => - Vec cellsNumber Bool -> - ActivePair portsNumber -> - Vec cellsNumber Bool -deleteActivePair oldActivePairs activePairToDelete = - if leftInVec `xor` rightInVec - then newActivePairs - else error "In active pairs map should be exact one address" - where - leftInVec = oldActivePairs !! (activePairToDelete ^. leftNode . originalAddress) - rightInVec = oldActivePairs !! (activePairToDelete ^. rightNode . originalAddress) - newActivePairs = - if leftInVec - then - replace (activePairToDelete ^. leftNode . originalAddress) False oldActivePairs - else - replace (activePairToDelete ^. rightNode . originalAddress) False oldActivePairs - --- | Mark `ActivePair`'s place as free -freeUpActivePair :: - (KnownNat cellsNumber, KnownNat portsNumber) => - Vec cellsNumber Bool -> - ActivePair portsNumber -> - Vec cellsNumber Bool -freeUpActivePair busyMap activePairToFree = markAddress (markAddress busyMap False leftNodeAddress) False rightNodeAddress - where - chooseAddress choice = activePairToFree ^. choice . originalAddress - leftNodeAddress = chooseAddress leftNode - rightNodeAddress = chooseAddress rightNode - --- | Give unused `AddressNumber` to `LocalNode` -registerAddressNumToNewNode :: - (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber) => - Vec cellsNumber Bool -> - ActualAddressNumber -registerAddressNumToNewNode busyMap = addressNum - where - addressNum = case getUnusedAddress busyMap of - Nothing -> error "Memory space is over" - Just address -> address - -{- | Assign actual `AddressNumber` to `LocalNode` and mark busy bit map according to this. -It is the composition of `registerAddressNumToNewNode` and `markAddress` just for usability --} -getLoadedFromLocal :: - (KnownNat cellsNumber, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber, KnownNat portsNumber) => - Vec cellsNumber Bool -> - LocalNode portsNumber -> - (Vec cellsNumber Bool, LoadedNode portsNumber) -getLoadedFromLocal busyMap localNode = (newBusyMap, LoadedNode node newAddress) - where - newAddress = registerAddressNumToNewNode busyMap - newBusyMap = markAddress busyMap True newAddress - node = localNode ^. numberedNode - --- | Data to accumulate all `Port` changes of the `Node` -data NodePortsInfo (portsNumber :: Nat) - = NodePortInfo - { _secP :: Vec portsNumber (Maybe (Port portsNumber)) - , _primeP :: Maybe (Port portsNumber) - } - deriving (Show, Eq, Generic, NFDataX, Default) - -$(makeLenses ''NodePortsInfo) - --- | Update `Port`s of `Node` by `NodePortsInfo` -updateNodeByPortsInfo :: - (KnownNat portsNumber) => - Node portsNumber -> - NodePortsInfo portsNumber -> - Node portsNumber -updateNodeByPortsInfo oldNode (NodePortInfo maybeSecPortsAddr maybePrimaryPort) = - set primaryPort newPrimPort (set secondaryPorts newSecPorts oldNode) - where - newSecPorts = - zipWith - (<|>) - maybeSecPortsAddr - (oldNode ^. secondaryPorts) - newPrimPort = case maybePrimaryPort of - Nothing -> oldNode ^. primaryPort - Just primPort -> primPort - --- | The flag to distinguish between nodes that need to be loaded from ram and local ones -data LocalFlag - = Local - | External - deriving (Eq) - -{- | Update ports info in attached `Node`. -It accumulates in key-value map, where key is `ActualAddressNumber` and value is a pair of `NodePortsInfo` and `LocalFlag` to distinguish local and external nodes. -The first one we can load from locals and another one we have to load from ram --} -updatePortsInfoByPort :: - forall portsNumber maxNumOfChangedNodes. - (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => - Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag) -> - LoadedNode portsNumber -> - Port portsNumber -> - IdOfPort portsNumber -> - Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag) -updatePortsInfoByPort infoVec localNodeWithAddress (Port maybeAddr connectedToPortId) portId = - case maybeAddr of - Nothing -> infoVec -- or @error "Port must be connected"@ - Just addr -> case addr of - LocalAddress localAddressNum -> update Local localAddressNum - ActualAddress addressNum -> update External addressNum - where - update localFlag addressNum = - insertWith - infoVec - ( \case - Nothing -> Just (constructNewInfo def, localFlag) - Just (info, _) -> Just (constructNewInfo info, localFlag) - ) - addressNum - where - newPort = Port (Just $ ActualAddress (localNodeWithAddress ^. originalAddress)) portId - constructNewInfo info@(NodePortInfo secPortsInfo _) = case connectedToPortId of - Primary -> set primeP (Just newPort) info - Id i -> set secP (replace i (Just newPort) secPortsInfo) info - -{- | The same as `updatePortsInfoByPort`, but updating happens by `Edge`. -In fact it accumulate info about which external `LoadedNode` have become connected with each other --} -updatePortsInfoByEdge :: - forall portsNumber maxNumOfChangedNodes. - (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => - Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag) -> - Edge portsNumber -> - Map maxNumOfChangedNodes (NodePortsInfo portsNumber, LocalFlag) -updatePortsInfoByEdge oldInfoVec (Edge leftE rightE) = - update - rightAddrNum - leftAddrNum - (rightE ^. idOfPort) - (leftE ^. idOfPort) - $ update leftAddrNum rightAddrNum (leftE ^. idOfPort) (rightE ^. idOfPort) oldInfoVec - where - leftAddrNum = leftE ^. addressOfVertex - rightAddrNum = rightE ^. addressOfVertex - update addrToUpdate addrToWhichUpdate connectedToPortId portId infoVec = - insertWith - infoVec - ( \case - Nothing -> Just (constructNewInfo (NodePortInfo def Nothing), External) - Just (info, _) -> Just (constructNewInfo info, External) - ) - addrToUpdate - where - newPort = Port (Just $ ActualAddress addrToWhichUpdate) portId - constructNewInfo info@(NodePortInfo secPortsInfo _) = case connectedToPortId of - Primary -> set primeP (Just newPort) info - Id i -> set secP (replace i (Just newPort) secPortsInfo) info - --- Check if `Node` is active -newNodeIsActive :: - (KnownNat portsNumber) => Node portsNumber -> Bool -newNodeIsActive node = - case node ^. primaryPort . portConnectedToId of - Primary -> True - _ -> False - --- | Assign new `ActualAddressNumber` to `LocalNode` and mark busy bit map -assignNewAddressToLocalNode :: - (CLog 2 cellsNumber <= BitSize AddressNumber, KnownNat cellsNumber, KnownNat portsNumber, 1 <= cellsNumber) => - Signal dom (Maybe (LocalNode portsNumber)) -> - Signal dom (Vec cellsNumber Bool) -> - (Signal dom (Vec cellsNumber Bool), Signal dom (Maybe (LoadedNode portsNumber))) -assignNewAddressToLocalNode signalMaybeLocalNode busyMap = case sequenceA signalMaybeLocalNode of - Nothing -> (busyMap, def) - Just signalLocalNode -> - let (signalBusyMap, loadedSignal) = unbundle (getLoadedFromLocal <$> busyMap <*> signalLocalNode) - in (signalBusyMap, Just <$> loadedSignal) - --- | Update local-to-loaded map -updateLocalAddressToLoaded :: - (KnownDomain dom, KnownNat portsNumber) => - (Signal dom LocalAddressNumber -> Signal dom (LoadedNode portsNumber)) -> - Signal dom (LocalNode portsNumber) -> - Signal dom ActualAddressNumber -> - Signal dom LocalAddressNumber -> - Signal dom (LoadedNode portsNumber) -updateLocalAddressToLoaded oldMap localNode actualAddr x = - mux - (x .==. (view localAddress <$> localNode)) - ((LoadedNode . view numberedNode <$> localNode) <*> actualAddr) - (oldMap (view localAddress <$> localNode)) - --- | Accumulate all changes by ports of the given `Node` and write it in the `Map` -accumulatePortsChangesByLoadedNode :: - (KnownNat portsNumber1, KnownNat maxNumOfChangedNodes) => - Signal dom (Map maxNumOfChangedNodes (NodePortsInfo portsNumber1, LocalFlag)) -> - Signal dom (LoadedNode portsNumber1) -> - Signal dom (Map maxNumOfChangedNodes (NodePortsInfo portsNumber1, LocalFlag)) -accumulatePortsChangesByLoadedNode infoVec signalLoadedNode = - let infoVecByPrimary = - updatePortsInfoByPort - <$> infoVec - <*> signalLoadedNode - <*> (view (containedNode . primaryPort) <$> signalLoadedNode) - <*> pure Primary - in ifoldl - ( \oldInfoVec i signalMaybePort -> - case sequenceA signalMaybePort of - Nothing -> oldInfoVec - Just signalPort -> - updatePortsInfoByPort - <$> oldInfoVec - <*> signalLoadedNode - <*> signalPort - <*> pure (Id i) - ) - infoVecByPrimary - (unbundle (view (containedNode . secondaryPorts) <$> signalLoadedNode)) - --- | Type alias for partial applied `blockRam` -type Ram dom portsNumber = - ( Signal dom ActualAddressNumber -> - Signal dom (Maybe (ActualAddressNumber, Maybe (Node portsNumber))) -> - Signal dom (Maybe (Node portsNumber)) - ) - -updateMM :: - forall (cellsNumber :: Nat) (portsNumber :: Nat) (edgeNumber :: Nat) (dom :: Domain) (maxNumOfChangedNodes :: Nat). - ( KnownNat cellsNumber - , KnownNat portsNumber - , KnownNat edgeNumber - , 1 <= cellsNumber - , CLog 2 cellsNumber <= BitSize AddressNumber - , 1 <= edgeNumber - , CLog 2 edgeNumber <= BitSize AddressNumber - , KnownNat maxNumOfChangedNodes - , KnownDomain dom - ) => - Ram dom portsNumber -> - Signal dom (MemoryManager cellsNumber) -> - Signal dom (Delta cellsNumber edgeNumber portsNumber) -> - ( Signal dom (MemoryManager cellsNumber) - , Ram dom portsNumber - ) --- it is possible to merge all foldl into one -updateMM ram memoryManager delta = (MemoryManager <$> markedBusyBitMap <*> newActives, ram) - where - localNodesSignal = unbundle $ view newNodes <$> delta :: _ (Signal _ _) - activePairSignal = view activePair <$> delta - -- map of local and actual `AddressNumber` - localActualMapDef = error "Nothing is written at this local address" - updatesInfo = def :: Signal dom (Map maxNumOfChangedNodes (NodePortsInfo _, LocalFlag)) - -- removed the processed active pair - pairsAfterDelete = (deleteActivePair . view activePairs <$> memoryManager) <*> activePairSignal - -- freed up space from an active pair - freedFromActivePair = (freeUpActivePair . view busyBitMap <$> memoryManager) <*> activePairSignal - {- gave the local nodes free addresses, marking the occupied ones. - Received a marked map address:busy, a list of new nodes with their actual addresses and a map (local address):(loaded node). - It also accumulate all changes in ports in the `Map` and updates actives-} - (markedBusyBitMap, localAddressToLoadedMap, newActives, infoAboutUpdatesByNodes) = - foldl - ( \(busyMap, localToActual, oldActives, accumulatedInfoMap) signalMaybeLocalNode -> - let (newBusyMap, newLoadedNode) = assignNewAddressToLocalNode signalMaybeLocalNode busyMap - (actualAddr, actives, infoVec) = case sequenceA newLoadedNode of - Nothing -> (def, oldActives, accumulatedInfoMap) - Just localLoadedNode -> - let addressIsActive = (newNodeIsActive . view containedNode <$> localLoadedNode) - in ( sequenceA $ Just $ view originalAddress <$> localLoadedNode - , mux addressIsActive ((replace . view originalAddress <$> localLoadedNode) <*> addressIsActive <*> actives) actives - , accumulatePortsChangesByLoadedNode accumulatedInfoMap localLoadedNode - ) - newLocalToActual = case sequenceA actualAddr of - Nothing -> localToActual - Just addr -> case sequenceA signalMaybeLocalNode of - Nothing -> localToActual - Just signalLocal -> updateLocalAddressToLoaded localToActual signalLocal addr - in (newBusyMap, newLocalToActual, actives, infoVec) - ) - ( freedFromActivePair - , localActualMapDef - , pairsAfterDelete - , updatesInfo - ) - localNodesSignal - -- accumulate all ports changes from edges. i.e. connect some external nodes with each other - infoAboutAllUpdates = - foldl - ( \infoVec signalMaybeEdge -> case sequenceA signalMaybeEdge of - Nothing -> infoVec - Just signalEdge -> updatePortsInfoByEdge <$> infoVec <*> signalEdge - ) - infoAboutUpdatesByNodes - (unbundle $ view newEdges <$> delta) - -- read all necessary external nodes from ram and update them with the local ones - nodesToWrite = - map - ( \signalMaybePair -> - case sequenceA signalMaybePair of - Nothing -> def -- same as @pure Nothing@ - Just signalPair -> - let addr = fst <$> signalPair :: Signal dom AddressNumber - signalMaybeInfo = snd <$> signalPair - in case sequenceA signalMaybeInfo of - Nothing -> def - Just signalInfo -> - let localFlag = snd <$> signalInfo - info = fst <$> signalInfo - node = readByAddressAndFlag addr localFlag - in mux - (localFlag .==. pure External) - (sequenceA $ Just $ LoadedNode <$> (updateNodeByPortsInfo <$> node <*> info) <*> addr) - ( sequenceA $ - Just $ - LoadedNode <$> (updateNodeByPortsInfo <$> node <*> info) <*> (view originalAddress <$> localAddressToLoadedMap addr) - ) - ) - (unbundle infoAboutAllUpdates) - -- write all changes into the ram - _ = - map - (maybe def writeByLoadedNode . sequenceA) - nodesToWrite - {---------------- - Helping functions - ----------------} - - -- read `Node` by `AddressNumber`. From the locals or from the RAM according to the flag - readByAddressAndFlag addressNumber localFlag = mux (localFlag .==. pure External) externalCase localCase - where - externalCase = case sequenceA $ ram addressNumber (pure Nothing) of - Nothing -> error "There is no Node by this address" - Just node -> node - localCase = view containedNode <$> localAddressToLoadedMap addressNumber - - -- write `Node` by the `ActualAddressNumber` in the RAM - writeByLoadedNode loadedNode = - ram - (view originalAddress <$> loadedNode) - (sequenceA $ Just $ bundle (view originalAddress <$> loadedNode, sequenceA $ Just $ view containedNode <$> loadedNode)) diff --git a/lamagraph-core/src/Core/MemoryManager/ChangesAccumulator.hs b/lamagraph-core/src/Core/MemoryManager/ChangesAccumulator.hs index 9795f3b..2935915 100644 --- a/lamagraph-core/src/Core/MemoryManager/ChangesAccumulator.hs +++ b/lamagraph-core/src/Core/MemoryManager/ChangesAccumulator.hs @@ -10,7 +10,6 @@ import Control.Lens hiding (ifoldl) import Core.Map import Core.MemoryManager.NodeChanges import Core.Node -import Core.Reducer -- | Type alias for triple (the address of the external node to update, the id of the port to update, the port to update to) type UpdateInfo (portsNumber :: Nat) = (AddressNumber, IdOfPort portsNumber, Connection portsNumber) diff --git a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs index 4444151..749ff28 100644 --- a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs @@ -7,6 +7,9 @@ module Core.MemoryManager.MemoryManager ( MemoryManager (..), busyBitMap, activePairs, + ActivePair (..), + leftNode, + rightNode, giveAddresses, removeActivePair, ) where @@ -14,7 +17,6 @@ module Core.MemoryManager.MemoryManager ( import Clash.Prelude import Control.Lens hiding (Index, imap) import Core.Node -import Core.Reducer {- $setup >>> import Clash.Prelude @@ -27,6 +29,22 @@ import Core.Reducer >>> :set -fplugin GHC.TypeLits.Normalise -} +data ActivePair (portsNumber :: Nat) = ActivePair + { _leftNode :: LoadedNode portsNumber + , _rightNode :: LoadedNode portsNumber + } + deriving (Show, Eq, Generic, NFDataX, Bundle) +$(makeLenses ''ActivePair) + +data MemoryManager (cellsNumber :: Nat) + = MemoryManager + { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" + , _activePairs :: Vec cellsNumber Bool + } + deriving (Generic, NFDataX, Bundle) + +$(makeLenses ''MemoryManager) + {- | Cast `Index` to `Unsigned` if possible by adding non-significant zeros ==== __Example__ @@ -82,15 +100,6 @@ markAddressesAsBusy :: Signal dom (Vec cellsNumber Bool) markAddressesAsBusy busyMap addresses = bundle $ imap (\i _ -> elem (indexToUnsigned i) <$> addresses) (unbundle busyMap) -data MemoryManager (cellsNumber :: Nat) - = MemoryManager - { _busyBitMap :: Vec cellsNumber Bool -- map Address : Bool. tell smth like "this Address is busy, so you can not to write here" - , _activePairs :: Vec cellsNumber Bool - } - deriving (Generic, NFDataX, Bundle) - -$(makeLenses ''MemoryManager) - giveAddresses :: ( (addressesCount + 1) <= cellsNumber , KnownNat cellsNumber diff --git a/lamagraph-core/src/Core/MemoryManager/NodeChanges.hs b/lamagraph-core/src/Core/MemoryManager/NodeChanges.hs index e2d1108..b6c7933 100644 --- a/lamagraph-core/src/Core/MemoryManager/NodeChanges.hs +++ b/lamagraph-core/src/Core/MemoryManager/NodeChanges.hs @@ -2,15 +2,43 @@ module Core.MemoryManager.NodeChanges ( Changes (..), secP, primeP, + Edge (..), + leftEnd, + rightEnd, + Delta (..), + newNodes, + newEdges, + activePair, + Interface, updateLoadedNodesByChanges, ) where import Clash.Prelude import Control.Lens hiding (Index, ifoldl, imap, (:>)) import Core.Map +import Core.MemoryManager.MemoryManager import Core.Node import Data.Maybe +data Edge (portsNumber :: Nat) = Edge + { _leftEnd :: Connection portsNumber + , _rightEnd :: Connection portsNumber + } + deriving (Generic, NFDataX, Show, Eq) + +$(makeLenses ''Edge) + +data Delta (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = Delta + { _newNodes :: Vec nodesNumber (Maybe (LoadedNode portsNumber)) + , _newEdges :: Vec edgesNumber (Maybe (Edge portsNumber)) + , _activePair :: ActivePair portsNumber + } + deriving (Show, Eq, Generic, NFDataX) + +$(makeLenses ''Delta) + +type Interface externalNodesNumber = Vec externalNodesNumber (Maybe AddressNumber) + -- | Data to accumulate all `Port` changes of the `Node` data Changes (portsNumber :: Nat) = Changes diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index 0363be7..d4ecdde 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -6,26 +6,13 @@ module Core.Reducer where import Clash.Prelude import Control.Lens +import Core.MemoryManager.MemoryManager +import Core.MemoryManager.NodeChanges import Core.Node type NumOfNodesToStore = Unsigned 3 type NumOfEdgesToStore = Unsigned 3 -data Edge (portsNumber :: Nat) = Edge - { _leftEnd :: Connection portsNumber - , _rightEnd :: Connection portsNumber - } - deriving (Generic, NFDataX, Show, Eq) - -$(makeLenses ''Edge) - -data ActivePair (portsNumber :: Nat) = ActivePair - { _leftNode :: LoadedNode portsNumber - , _rightNode :: LoadedNode portsNumber - } - deriving (Show, Eq, Generic, NFDataX, Bundle) -$(makeLenses ''ActivePair) - -- | Result of abstract reduction rule data ReduceRuleResult (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = ReduceRuleResult { _edges :: Vec edgesNumber (Maybe (Edge portsNumber)) @@ -34,17 +21,6 @@ data ReduceRuleResult (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: $(makeLenses ''ReduceRuleResult) -data Delta (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = Delta - { _newNodes :: Vec nodesNumber (Maybe (LoadedNode portsNumber)) - , _newEdges :: Vec edgesNumber (Maybe (Edge portsNumber)) - , _activePair :: ActivePair portsNumber - } - deriving (Show, Eq, Generic, NFDataX) - -$(makeLenses ''Delta) - -type Interface externalNodesNumber = Vec externalNodesNumber (Maybe AddressNumber) - toDelta :: (KnownNat portsNumber, KnownNat edgesNumber, KnownNat nodesNumber) => ActivePair portsNumber -> From be705c9a496e867fd9a2981687ea15cdbf9781da Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Sun, 8 Dec 2024 21:50:09 +0300 Subject: [PATCH 45/54] Rewrite addresses allocated to Vec of Maybe --- .../src/Core/MemoryManager/MemoryManager.hs | 36 ++++++++++--------- lamagraph-core/src/Core/Node.hs | 6 ++++ 2 files changed, 25 insertions(+), 17 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs index 749ff28..5aeed67 100644 --- a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs @@ -61,16 +61,17 @@ indexToUnsigned v = bitCoerce (resize v :: Index (2 ^ m)) -- | Get `Vec` of free `AddressNumber`s of given size getFreeAddresses :: - forall addressesCount dom cellsNumber. - ( (addressesCount + 1) <= cellsNumber - , KnownNat cellsNumber - , KnownNat addressesCount + forall maxAddressesCount dom cellsNumber. + ( KnownNat cellsNumber + , KnownNat maxAddressesCount , KnownDomain dom , CLog 2 cellsNumber <= BitSize AddressNumber + , 1 <= cellsNumber + , maxAddressesCount <= cellsNumber ) => - Signal dom (SNat addressesCount) -> + Signal dom (Index cellsNumber) -> Signal dom (Vec cellsNumber Bool) -> - Signal dom (Vec addressesCount AddressNumber) + Signal dom (Vec maxAddressesCount (Maybe AddressNumber)) getFreeAddresses addressesCount busyMap = helper 0 0 (unbundle busyMap) def where @@ -78,17 +79,17 @@ getFreeAddresses addressesCount busyMap = Signal dom (Index cellsNumber) -> Index cellsNumber -> Vec m (Signal dom Bool) -> - Vec addressesCount (Signal dom AddressNumber) -> - Signal dom (Vec addressesCount AddressNumber) + Vec maxAddressesCount (Signal dom (Maybe AddressNumber)) -> + Signal dom (Vec maxAddressesCount (Maybe AddressNumber)) helper allocatedCount busyMapIndex busyMapRemind addresses = case busyMapRemind of Nil -> error "Memory space is over" Cons isBusy remind -> mux (not <$> isBusy) ( mux - ((1 + allocatedCount) .==. (fromSNat <$> addressesCount :: Signal dom (Index cellsNumber))) - (bundle (pure (indexToUnsigned busyMapIndex) +>> addresses)) - (helper (allocatedCount + 1) (busyMapIndex + 1) remind (pure (indexToUnsigned busyMapIndex) +>> addresses)) + ((1 + allocatedCount) .==. addressesCount) + (bundle (pure (Just $ indexToUnsigned busyMapIndex) +>> addresses)) + (helper (allocatedCount + 1) (busyMapIndex + 1) remind (pure (Just $ indexToUnsigned busyMapIndex) +>> addresses)) ) (helper allocatedCount (busyMapIndex + 1) remind addresses) @@ -96,20 +97,21 @@ getFreeAddresses addressesCount busyMap = markAddressesAsBusy :: (KnownDomain dom, KnownNat cellsNumber, KnownNat n, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber) => Signal dom (Vec cellsNumber Bool) -> - Signal dom (Vec n AddressNumber) -> + Signal dom (Vec n (Maybe AddressNumber)) -> Signal dom (Vec cellsNumber Bool) -markAddressesAsBusy busyMap addresses = bundle $ imap (\i _ -> elem (indexToUnsigned i) <$> addresses) (unbundle busyMap) +markAddressesAsBusy busyMap addresses = bundle $ imap (\i _ -> elem (Just $ indexToUnsigned i) <$> addresses) (unbundle busyMap) giveAddresses :: - ( (addressesCount + 1) <= cellsNumber + ( 1 <= cellsNumber , KnownNat cellsNumber - , KnownNat addressesCount + , KnownNat maxAddressesCount , KnownDomain dom , CLog 2 cellsNumber <= BitSize AddressNumber + , maxAddressesCount <= cellsNumber ) => - Signal dom (SNat addressesCount) -> + Signal dom (Index cellsNumber) -> Signal dom (MemoryManager cellsNumber) -> - (Signal dom (Vec addressesCount AddressNumber), Signal dom (MemoryManager cellsNumber)) + (Signal dom (Vec maxAddressesCount (Maybe AddressNumber)), Signal dom (MemoryManager cellsNumber)) giveAddresses addressesCount memoryManager = (addresses, set busyBitMap <$> newBusyMap <*> memoryManager) where addresses = getFreeAddresses addressesCount (view busyBitMap <$> memoryManager) diff --git a/lamagraph-core/src/Core/Node.hs b/lamagraph-core/src/Core/Node.hs index e62ec47..31b1929 100644 --- a/lamagraph-core/src/Core/Node.hs +++ b/lamagraph-core/src/Core/Node.hs @@ -80,3 +80,9 @@ setConnection :: setConnection node portId connection = case portId of Primary -> set primaryPort connection node Id index -> set secondaryPorts (replace index (Just connection) (node ^. secondaryPorts)) node + +getAllConnections :: + (KnownNat portsNumber) => + Node portsNumber -> + Vec (portsNumber + 1) (Maybe (Connection portsNumber)) +getAllConnections node = Just (node ^. primaryPort) :> (node ^. secondaryPorts) From 164643ddde4e9954391c3fe5b8679c4cd508a3dd Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 12:27:57 +0300 Subject: [PATCH 46/54] Add giveActiveAddressNumber function --- lamagraph-core/src/Core/MemoryManager/MemoryManager.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs index 5aeed67..bbf6e0b 100644 --- a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs @@ -12,6 +12,7 @@ module Core.MemoryManager.MemoryManager ( rightNode, giveAddresses, removeActivePair, + giveActiveAddressNumber, ) where import Clash.Prelude @@ -181,3 +182,12 @@ removeActivePair acPair memoryManager = where newActivePairs = deleteActivePair <$> (view activePairs <$> memoryManager) <*> acPair newBusyMap = freeUpActivePair <$> (view busyBitMap <$> memoryManager) <*> acPair + +-- | Give `AddressNumber` of some active `Node`. It returns `Nothing` if there is no `ActivePair`s in the net +giveActiveAddressNumber :: + (KnownNat cellsNumber, KnownDomain dom, 1 <= cellsNumber, CLog 2 cellsNumber <= BitSize AddressNumber) => + Signal dom (MemoryManager cellsNumber) -> + Signal dom (Maybe AddressNumber) +giveActiveAddressNumber memoryManager = case traverse (findIndex id . view activePairs) memoryManager of + Just signalIndex -> Just . indexToUnsigned <$> signalIndex + Nothing -> def From 43c3e6fb70e21e4c62f38b5da59b8b13d5946405 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 12:39:50 +0300 Subject: [PATCH 47/54] Fix the case when necessary amount of memory is zero --- lamagraph-core/src/Core/MemoryManager/MemoryManager.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs index bbf6e0b..30f52ac 100644 --- a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs @@ -73,8 +73,7 @@ getFreeAddresses :: Signal dom (Index cellsNumber) -> Signal dom (Vec cellsNumber Bool) -> Signal dom (Vec maxAddressesCount (Maybe AddressNumber)) -getFreeAddresses addressesCount busyMap = - helper 0 0 (unbundle busyMap) def +getFreeAddresses addressesCount busyMap = mux (addressesCount .==. pure 0) def (helper 0 0 (unbundle busyMap) def) where helper :: Signal dom (Index cellsNumber) -> From 01db43eef80c167cf79cd15366ed7e66c68bad47 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 12:48:29 +0300 Subject: [PATCH 48/54] Add necessary loading functions --- lamagraph-core/src/Core/Loader.hs | 59 ++++++++++++++++++++++++------- 1 file changed, 47 insertions(+), 12 deletions(-) diff --git a/lamagraph-core/src/Core/Loader.hs b/lamagraph-core/src/Core/Loader.hs index 381f4b0..b0c5ec9 100644 --- a/lamagraph-core/src/Core/Loader.hs +++ b/lamagraph-core/src/Core/Loader.hs @@ -1,22 +1,57 @@ module Core.Loader where import Clash.Prelude +import Control.Lens (view) +import Core.MemoryManager.MemoryManager (ActivePair (ActivePair)) import Core.MemoryManager.NodeChanges import Core.Node --- | Get `Node` by his `AddressNumber` from RAM. Actually, preparing to reducer work. -loader :: +-- | Type alias for partial applied `blockRam` +type Ram dom portsNumber = + ( Signal dom AddressNumber -> + Signal dom (Maybe (AddressNumber, Maybe (Node portsNumber))) -> + Signal dom (Maybe (Node portsNumber)) + ) + +-- | Read external `Node`s from ram +loadInterface :: ( KnownDomain dom , HiddenClockResetEnable dom - , KnownNat numberOfPorts + , KnownNat portsNumber + , KnownNat externalNodesNumber ) => - (Signal dom AddressNumber -> Signal dom (Node numberOfPorts)) -> - Signal dom (Maybe AddressNumber) -> - Signal dom (Maybe (LoadedNode numberOfPorts)) -loader ram mbAddressNumberToLoad = - mkLoadedNode <$> mbNode <*> mbAddressNumberToLoad + Ram dom portsNumber -> + Signal dom (Interface externalNodesNumber) -> + Signal dom (Vec externalNodesNumber (Maybe (LoadedNode portsNumber))) +loadInterface ram interface = + bundle $ + map + (traverse readFromRam . sequenceA) + (unbundle interface) + where + partRam address = ram address def + readFromRam address = case sequenceA (partRam address) of + Just node -> LoadedNode <$> node <*> address + Nothing -> error "An attempt to read at a free address" + +-- | Load `ActivePair` by `AddressNumber`. It is assumed that `AddressNumber` is actually active +loadActivePair :: + (KnownDomain dom, HiddenClockResetEnable dom, KnownNat portsNumber) => + Ram dom portsNumber -> + Signal dom AddressNumber -> + Signal dom (ActivePair portsNumber) +loadActivePair ram leftActiveNodeAddress = + ActivePair + <$> (LoadedNode <$> leftActiveNode <*> leftActiveNodeAddress) + <*> (LoadedNode <$> rightActiveNode <*> rightActiveNodeAddress) where - mkLoadedNode node address = LoadedNode <$> node <*> address - mbNode = case sequenceA mbAddressNumberToLoad of - Nothing -> pure Nothing - Just n -> sequenceA $ Just (ram n) + partRam address = ram address def + getNodeByAddress address = case sequenceA $ partRam address of + Just node -> node + Nothing -> error "An attempt to read at a free address" + getRightActiveNodeAddress node = case view primaryPort node of + Connected port -> view nodeAddress port + NotConnected -> error "Wrong definition of active pair" + leftActiveNode = getNodeByAddress leftActiveNodeAddress + rightActiveNodeAddress = getRightActiveNodeAddress <$> leftActiveNode + rightActiveNode = getNodeByAddress rightActiveNodeAddress From 9e46b3205dc60d6045dc86f717711d723b74ebed Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 12:49:11 +0300 Subject: [PATCH 49/54] Rewrite Reducer --- lamagraph-core/src/Core/Reducer.hs | 80 ++++++++++++++++++++++++------ 1 file changed, 66 insertions(+), 14 deletions(-) diff --git a/lamagraph-core/src/Core/Reducer.hs b/lamagraph-core/src/Core/Reducer.hs index d4ecdde..290c5cb 100644 --- a/lamagraph-core/src/Core/Reducer.hs +++ b/lamagraph-core/src/Core/Reducer.hs @@ -1,17 +1,16 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} - {-# HLINT ignore "Functor law" #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} module Core.Reducer where import Clash.Prelude -import Control.Lens +import Control.Lens hiding (Index) import Core.MemoryManager.MemoryManager import Core.MemoryManager.NodeChanges import Core.Node - -type NumOfNodesToStore = Unsigned 3 -type NumOfEdgesToStore = Unsigned 3 +import INet.Net -- | Result of abstract reduction rule data ReduceRuleResult (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: Nat) = ReduceRuleResult @@ -21,6 +20,22 @@ data ReduceRuleResult (nodesNumber :: Nat) (edgesNumber :: Nat) (portsNumber :: $(makeLenses ''ReduceRuleResult) +type ChooseReductionRule cellsNumber nodesNumber edgesNumber portsNumber = + Agent -> Agent -> ReductionRuleInfo cellsNumber nodesNumber edgesNumber portsNumber + +-- | Information about concrete reduction rule: reduction function and count of new nodes +data ReductionRuleInfo cellsNumber maxNumOfNewNodes maxNumOfNewEdges portsNumber + = ReduceFunctionInfo + { _reductionFunction :: + Vec maxNumOfNewNodes (Maybe AddressNumber) -> + LoadedNode portsNumber -> + LoadedNode portsNumber -> + ReduceRuleResult maxNumOfNewNodes maxNumOfNewEdges portsNumber + , _necessaryAddressesCount :: Index cellsNumber + } + +$(makeLenses ''ReductionRuleInfo) + toDelta :: (KnownNat portsNumber, KnownNat edgesNumber, KnownNat nodesNumber) => ActivePair portsNumber -> @@ -28,14 +43,51 @@ toDelta :: Delta nodesNumber edgesNumber portsNumber toDelta acPair reduceResult = Delta (reduceResult ^. nodes) (reduceResult ^. edges) acPair +{- | Get all `AddressNumber`s of external `Node`s of `ActivePair`, i.e. collect addresses of connected to active pair nodes + +__Note__ maxNumOfChangedNodes have to be specified +-} +getInterface :: + (KnownNat portsNumber, KnownNat maxNumOfChangedNodes) => + ActivePair portsNumber -> + Interface maxNumOfChangedNodes +getInterface (ActivePair (LoadedNode lNode leftAddress) (LoadedNode rNode rightAddress)) = + foldl + (\oldInterface maybeConnection -> maybe oldInterface (updateInterfaceByConnection oldInterface) maybeConnection) + def + allConnections + where + isExternal address = not (address == leftAddress || address == rightAddress) + allConnections = + getAllConnections lNode ++ getAllConnections rNode + updateInterfaceByConnection interface connection = case connection of + Connected (Port address _) -> if isExternal address && Just address `notElem` interface then Just address +>> interface else interface + NotConnected -> interface + +-- | Apply reduction rule by `ActivePair` and allocate necessary amount of memory reducer :: - forall dom portsNumber nodesNumber edgesNumber. - (KnownDomain dom, KnownNat portsNumber, KnownNat nodesNumber, KnownNat edgesNumber) => - (Node portsNumber -> Node portsNumber -> ReduceRuleResult nodesNumber edgesNumber portsNumber) -> + forall dom portsNumber nodesNumber edgesNumber cellsNumber. + ( KnownDomain dom + , KnownNat portsNumber + , KnownNat nodesNumber + , KnownNat edgesNumber + , KnownNat cellsNumber + , 1 <= cellsNumber + , CLog 2 cellsNumber <= BitSize AddressNumber + , nodesNumber <= cellsNumber + ) => + ChooseReductionRule cellsNumber nodesNumber edgesNumber portsNumber -> + Signal dom (MemoryManager cellsNumber) -> Signal dom (ActivePair portsNumber) -> - Signal dom (Delta nodesNumber edgesNumber portsNumber) -reducer transFunction activeP = toDelta <$> activeP <*> reduceRuleRes + (Signal dom (Delta nodesNumber edgesNumber portsNumber), Signal dom (MemoryManager cellsNumber)) +reducer chooseReductionRule memoryManager activeP = (toDelta <$> activeP <*> reduceRuleResult, newMemoryManager) where - leftLNode = (^. leftNode) <$> activeP - rightLNode = (^. rightNode) <$> activeP - reduceRuleRes = transFunction <$> (view containedNode <$> leftLNode) <*> (view containedNode <$> rightLNode) + leftLoadedNode = view leftNode <$> activeP + rightLoadedNode = view rightNode <$> activeP + leftNodeType = view (containedNode . nodeType) <$> leftLoadedNode + rightNodeType = view (containedNode . nodeType) <$> rightLoadedNode + reductionRuleInfo = chooseReductionRule <$> leftNodeType <*> rightNodeType + transitionFunction = view reductionFunction <$> reductionRuleInfo + (freeAddresses, newMemoryManager) = + giveAddresses (view necessaryAddressesCount <$> reductionRuleInfo) memoryManager + reduceRuleResult = transitionFunction <*> freeAddresses <*> leftLoadedNode <*> rightLoadedNode From b68595598f311a9094a24d9ffa5bc33d120fb14c Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 12:51:22 +0300 Subject: [PATCH 50/54] [WIP] Add core function An approximate view of main function. !Do not handled the end point! --- lamagraph-core/lamagraph-core.cabal | 1 + lamagraph-core/src/Core/Core.hs | 77 +++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+) create mode 100644 lamagraph-core/src/Core/Core.hs diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index a9596e6..5709ecf 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -87,6 +87,7 @@ library import: common-options hs-source-dirs: src exposed-modules: + Core.Core Core.Node Core.Reducer Core.MemoryManager.MemoryManager diff --git a/lamagraph-core/src/Core/Core.hs b/lamagraph-core/src/Core/Core.hs new file mode 100644 index 0000000..f337c08 --- /dev/null +++ b/lamagraph-core/src/Core/Core.hs @@ -0,0 +1,77 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Eta reduce" #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} + +module Core.Core where + +import Clash.Prelude +import Control.Lens hiding ((:>)) +import Core.Loader (Ram, loadActivePair, loadInterface) +import Core.MemoryManager.ChangesAccumulator (getAllChangesByDelta) +import Core.MemoryManager.MemoryManager ( + ActivePair, + MemoryManager, + giveActiveAddressNumber, + leftNode, + removeActivePair, + rightNode, + ) +import Core.MemoryManager.NodeChanges +import Core.Node +import Core.Reducer (ChooseReductionRule, getInterface, reducer) + +core :: + forall portsNumber nodesNumber edgesNumber cellsNumber dom. + ( KnownNat portsNumber + , KnownNat nodesNumber + , KnownNat edgesNumber + , KnownNat cellsNumber + , 1 <= cellsNumber + , CLog 2 cellsNumber <= BitSize AddressNumber + , nodesNumber <= cellsNumber + , KnownDomain dom + , HiddenClockResetEnable dom + , Enum AddressNumber + ) => + Vec cellsNumber (Maybe (Node portsNumber)) -> -- Initial network + MemoryManager cellsNumber -> -- Initial information about busy addresses and active pairs + ChooseReductionRule cellsNumber nodesNumber edgesNumber portsNumber -> + Signal dom (Vec cellsNumber (Maybe (Node portsNumber))) +core initialNetwork initialMemoryManager chooseReductionRule = bundle $ map (`ram` def) (unbundle allAddresses) + where + memoryManager = register @dom initialMemoryManager allocatedAddressesMemoryManager + ram = blockRam initialNetwork :: Ram dom portsNumber + activeAddress = case sequenceA $ giveActiveAddressNumber memoryManager of + Just x -> x + Nothing -> error "" -- end of program. TODO: add handling of this + acPair = loadActivePair ram activeAddress + removedActivePairMemoryManager = removeActivePair acPair memoryManager + _ = removeActivePairFromRam ram acPair + (delta, allocatedAddressesMemoryManager) = reducer chooseReductionRule removedActivePairMemoryManager acPair + -- instead of "@portsNumber @nodesNumber" it possible to write ":: Signal dom (Interface nodesNumber)" + interface = getInterface @portsNumber @nodesNumber <$> acPair + externalNodes = loadInterface ram interface + changes = updateLoadedNodesByChanges <$> externalNodes <*> getAllChangesByDelta delta interface + _ = writeChanges ram changes + allAddresses = pure (generateI (+ 1) (0 :: AddressNumber)) + +writeChanges :: + (KnownNat maxNumOfChangedNodes, KnownNat portsNumber, KnownDomain dom, HiddenClockResetEnable dom) => + Ram dom portsNumber -> + Signal dom (Vec maxNumOfChangedNodes (Maybe (LoadedNode portsNumber))) -> + Vec maxNumOfChangedNodes (Signal dom (Maybe (Node portsNumber))) +writeChanges ram changes = map writeByLoadedNode (unbundle changes) + where + writeByLoadedNode signalMaybeLoadedNode = case sequenceA signalMaybeLoadedNode of + Nothing -> ram (pure 0) def + Just signalLoadedNode -> + let f = Just (view originalAddress <$> signalLoadedNode, Just . view containedNode <$> signalLoadedNode) + in ram (pure 0) (traverse bundle f) + +removeActivePairFromRam :: + Ram dom portsNumber -> Signal dom (ActivePair portsNumber) -> Vec 2 (Signal dom (Maybe (Node portsNumber))) +removeActivePairFromRam ram acPair = map (\address -> partRam (Just <$> bundle (address, def))) (leftAddress :> rightAddress :> Nil) + where + partRam = ram def + leftAddress = view (leftNode . originalAddress) <$> acPair + rightAddress = view (rightNode . originalAddress) <$> acPair From 2ca782dddea15fc399cd49ba7b0f47a353ef906d Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 14:07:01 +0300 Subject: [PATCH 51/54] Fix pedantic build --- lamagraph-core/lamagraph-core.cabal | 1 + .../src/Core/Concrete/ReduceRulesLambda.hs | 42 +++---------------- 2 files changed, 6 insertions(+), 37 deletions(-) diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index 5709ecf..34ae3d9 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -87,6 +87,7 @@ library import: common-options hs-source-dirs: src exposed-modules: + Core.Loader Core.Core Core.Node Core.Reducer diff --git a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs index 29de6ec..de0252a 100644 --- a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs +++ b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-unused-imports #-} + {- | All modules from Concrete are 1. Compiled from some dsl in separate file @@ -10,23 +12,12 @@ module Core.Concrete.ReduceRulesLambda where import Clash.Prelude import Control.Lens hiding (Index, imap) -import Core.MemoryManager +import Core.MemoryManager.NodeChanges import Core.Node import Core.Reducer +import Data.Maybe import INet.Net --- | One reduce step -(|><|) :: - Node 2 -> - Node 2 -> - ReduceRuleResult 2 2 2 -lNode |><| rNode = case (lNode ^. nodeType, rNode ^. nodeType) of - (Apply, Abstract) -> applyToLambdaRule lNode rNode - (Abstract, Apply) -> applyToLambdaRule lNode rNode - (Erase, _) -> epsToAnyRule lNode rNode - (_, Erase) -> epsToAnyRule rNode lNode - _ -> error "There is no rule for this active pair in the reduction rules" - {- | Reduce rule for `Apply` and `Abs` <> @@ -38,31 +29,8 @@ applyToLambdaRule :: ReduceRuleResult nodesNumber 2 2 applyToLambdaRule n1 n2 = let arisingNodes = def - portToEdgeEnd p = case p ^. nodeAddress of - Nothing -> error "Port must to be connected" - Just addr -> case addr of - ActualAddress addrNum -> EdgeEnd addrNum (p ^. portConnectedToId) - LocalAddress addrNum -> EdgeEnd addrNum (p ^. portConnectedToId) -- Maybe this is should be more complicated - portsToEdgeEnds node = map (maybe (error "All Ports must to be presented") portToEdgeEnd) (node ^. secondaryPorts) + portsToEdgeEnds node = map (fromMaybe (error "All Ports must to be presented")) (node ^. secondaryPorts) lE = portsToEdgeEnds n1 rE = portsToEdgeEnds n2 arisingEdges = zipWith (\l r -> Just $ Edge l r) lE (reverse rE) in ReduceRuleResult arisingEdges arisingNodes - -{- | Reduce rule for `Eps` and everything else. - -<> --} -epsToAnyRule :: - (KnownNat portsNumber, KnownNat edgesNumber, CLog 2 portsNumber <= BitSize AddressNumber, 1 <= portsNumber) => - Node portsNumber -> - Node portsNumber -> - ReduceRuleResult portsNumber edgesNumber portsNumber -epsToAnyRule _ nSome = - let arisingEdges = def - genNewEpsNode port = Node port def Erase - arisingNodes = - imap - (\i maybePort -> flip LocalNode (indexToUnsigned i) . genNewEpsNode <$> maybePort) - (nSome ^. secondaryPorts) - in ReduceRuleResult arisingEdges arisingNodes From 1240556cd483bf9e87fdddfad3cfdf2a748f705f Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 14:49:05 +0300 Subject: [PATCH 52/54] Add specific reduce rules for simple lambdas Add reduction rules and chooseReductionRule function --- .../src/Core/Concrete/ReduceRulesLambda.hs | 66 +++++++++++++++---- 1 file changed, 55 insertions(+), 11 deletions(-) diff --git a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs index de0252a..b926eea 100644 --- a/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs +++ b/lamagraph-core/src/Core/Concrete/ReduceRulesLambda.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - {- | All modules from Concrete are 1. Compiled from some dsl in separate file @@ -11,7 +9,7 @@ module Core.Concrete.ReduceRulesLambda where import Clash.Prelude -import Control.Lens hiding (Index, imap) +import Control.Lens hiding (Index, imap, (:>)) import Core.MemoryManager.NodeChanges import Core.Node import Core.Reducer @@ -23,14 +21,60 @@ import INet.Net <> -} applyToLambdaRule :: - (KnownNat nodesNumber) => - Node 2 -> - Node 2 -> - ReduceRuleResult nodesNumber 2 2 -applyToLambdaRule n1 n2 = + Vec 2 (Maybe AddressNumber) -> + LoadedNode 2 -> + LoadedNode 2 -> + ReduceRuleResult 2 2 2 +applyToLambdaRule _ loadedNodeLeft loadedNodeRight = let arisingNodes = def - portsToEdgeEnds node = map (fromMaybe (error "All Ports must to be presented")) (node ^. secondaryPorts) - lE = portsToEdgeEnds n1 - rE = portsToEdgeEnds n2 + portsToEdgeEnds node = map (fromMaybe (error "Agent type of the node is incorrect")) (node ^. containedNode . secondaryPorts) + lE = portsToEdgeEnds loadedNodeLeft + rE = portsToEdgeEnds loadedNodeRight arisingEdges = zipWith (\l r -> Just $ Edge l r) lE (reverse rE) in ReduceRuleResult arisingEdges arisingNodes + +{- | Reduce rule fot `Erase` and `Abstract` or `Apply` + +<> + +__Note__ this rule is not symmetric!! Erasure node is first +-} +eraseToAbstractOrApplyRule :: + Vec 2 (Maybe AddressNumber) -> + LoadedNode 2 -> + LoadedNode 2 -> + ReduceRuleResult 2 2 2 +eraseToAbstractOrApplyRule ((Just address1) :> (Just address2) :> Nil) _ loadedNodeAny = + let arisingEdges = def :: Vec 2 (Maybe (Edge 2)) + genEraseNodeByConnection address connection = LoadedNode (Node connection def Erase) address + arisingNodes = + zipWith + ( \address maybeConnection -> + Just $ + maybe + (error "Agent type of the node is incorrect") + (genEraseNodeByConnection address) + maybeConnection + ) + (address1 :> address2 :> Nil) + (loadedNodeAny ^. containedNode . secondaryPorts) + in ReduceRuleResult arisingEdges arisingNodes +eraseToAbstractOrApplyRule _ _ _ = error "The amount of required memory is incorrectly specified" + +-- | Reduce rule for `Erase` and `Erase` +eraseToErase :: + Vec 2 (Maybe AddressNumber) -> + LoadedNode 2 -> + LoadedNode 2 -> + ReduceRuleResult 2 2 2 +eraseToErase _ _ _ = ReduceRuleResult def def + +-- | A function to determine which reduction rule should be applied and how much memory is required for this +getReduceRuleInfo :: (KnownNat cellsNumber) => Agent -> Agent -> ReductionRuleInfo cellsNumber 2 2 2 +getReduceRuleInfo agent1 agent2 = case (agent1, agent2) of + (Apply, Abstract) -> ReduceFunctionInfo applyToLambdaRule 0 + (Abstract, Apply) -> ReduceFunctionInfo applyToLambdaRule 0 + (Erase, Erase) -> ReduceFunctionInfo eraseToErase 0 + (Erase, _) -> ReduceFunctionInfo eraseToAbstractOrApplyRule 2 + (_, Erase) -> ReduceFunctionInfo (\addresses nodeAny nodeErase -> eraseToAbstractOrApplyRule addresses nodeErase nodeAny) 2 + (_, _) -> error "There is no rule for this pair of agent in reduction rules" From 63aa4ef50fcfb5f5e618aea412346fc51a3f1218 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 14:50:40 +0300 Subject: [PATCH 53/54] Add example of initial net --- lamagraph-core/lamagraph-core.cabal | 1 + lamagraph-core/src/Core/Concrete/Initial.hs | 34 +++++++++++++++++++++ 2 files changed, 35 insertions(+) create mode 100644 lamagraph-core/src/Core/Concrete/Initial.hs diff --git a/lamagraph-core/lamagraph-core.cabal b/lamagraph-core/lamagraph-core.cabal index 34ae3d9..0d36567 100644 --- a/lamagraph-core/lamagraph-core.cabal +++ b/lamagraph-core/lamagraph-core.cabal @@ -96,6 +96,7 @@ library Core.MemoryManager.NodeChanges Core.Map Core.Concrete.ReduceRulesLambda + Core.Concrete.Initial INet.Net default-language: Haskell2010 diff --git a/lamagraph-core/src/Core/Concrete/Initial.hs b/lamagraph-core/src/Core/Concrete/Initial.hs new file mode 100644 index 0000000..6f92d5a --- /dev/null +++ b/lamagraph-core/src/Core/Concrete/Initial.hs @@ -0,0 +1,34 @@ +-- | Module with initial configuration. It will generate (by TemplateHaskell?) automatically in the future +module Core.Concrete.Initial where + +import Clash.Prelude +import Core.Node +import INet.Net + +{- | Initial Net view of \((\lambda x. x)(\lambda y. y)\) + +<> +-} +initialIdApplyToId :: Vec (2 ^ BitSize AddressNumber) (Maybe (Node 2)) +initialIdApplyToId = Just applyNode +>> Just abstract1Node +>> Just abstract2Node +>> def + where + applyAddressNumber = 0 + abstract1AddressNumber = 1 + abstract2AddressNumber = 2 + applyNode = + let prPort = Port abstract2AddressNumber Primary + port1 = Port abstract1AddressNumber Primary + secPorts = Just NotConnected :> Just (Connected port1) :> Nil + in Node (Just prPort) secPorts Apply + abstract1Node = + let prPort = Port applyAddressNumber (Id 1) + port0 = Port abstract1AddressNumber (Id 1) + port1 = Port abstract1AddressNumber (Id 0) + secPorts = Just (Connected port0) :> Just (Connected port1) :> Nil + in Node (Just prPort) secPorts Abstract + abstract2Node = + let prPort = Port applyAddressNumber Primary + port0 = Port abstract2AddressNumber (Id 1) + port1 = Port abstract2AddressNumber (Id 0) + secPorts = Just (Connected port0) :> Just (Connected port1) :> Nil + in Node (Just prPort) secPorts Abstract From 462d8d557bd8b154535f66628622c14267723030 Mon Sep 17 00:00:00 2001 From: Efim Kubishkin Date: Mon, 9 Dec 2024 17:38:41 +0300 Subject: [PATCH 54/54] Add functions to export list for doctests --- lamagraph-core/src/Core/MemoryManager/MemoryManager.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs index 30f52ac..37abd32 100644 --- a/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs +++ b/lamagraph-core/src/Core/MemoryManager/MemoryManager.hs @@ -13,6 +13,8 @@ module Core.MemoryManager.MemoryManager ( giveAddresses, removeActivePair, giveActiveAddressNumber, + indexToUnsigned, + markAddress, ) where import Clash.Prelude