Core rewrite

lamagraph-core/lamagraph-core.cabal

@@ -87,9 +87,12 @@ library
   import: common-options
   hs-source-dirs: src
   exposed-modules:
+    Core.Core
     Core.Node
     Core.Reducer
-    Core.MemoryManager
+    Core.MemoryManager.MemoryManager
+    Core.MemoryManager.ChangesAccumulator
+    Core.MemoryManager.NodeChanges
     Core.Map
     Core.Concrete.ReduceRulesLambda
     INet.Net

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)

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

lamagraph-core/src/Core/Loader.hs

@@ -1,21 +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