Core rewrite

.vscode/settings.json

@@ -49,5 +49,8 @@
     "editor.rulers": [
       120
     ]
+  },
+  "[jsonc]": {
+    "editor.defaultFormatter": "vscode.json-language-features"
   }
 }

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"

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
@@ -85,7 +86,12 @@ library
   import: common-options
   hs-source-dirs: src
   exposed-modules:
-    Example.Project
+    Core.Node
+    Core.Reducer
+    Core.MemoryManager
+    Core.Map
+    Core.Concrete.ReduceRulesLambda
+    INet.Net
   default-language: Haskell2010
 
 -- Builds the executable 'clash', with lamagraph-core project in scope
@@ -123,7 +129,8 @@ test-suite test-library
   ghc-options: -threaded
   main-is: unittests.hs
   other-modules:
-    Tests.Example.Project
+    Tests.Core.Node
+    NodeGenerate
   build-depends:
     lamagraph-core,
     QuickCheck,

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

lamagraph-core/src/Core/Loader.hs

@@ -0,0 +1,21 @@
+module Core.Loader where
+
+import Clash.Prelude
+import Core.Node
+
+-- | Get `Node` by his `AddressNumber` from RAM. Actually, preparing to reducer work.
+loader ::
+  ( KnownDomain dom
+  , HiddenClockResetEnable dom
+  , KnownNat numberOfPorts
+  ) =>
+  (Signal dom AddressNumber -> Signal dom (Node numberOfPorts)) ->
+  Signal dom (Maybe AddressNumber) ->
+  Signal dom (Maybe (LoadedNode numberOfPorts))
+loader ram mbAddressNumberToLoad =
+  mkLoadedNode <$> mbNode <*> mbAddressNumberToLoad
+ where
+  mkLoadedNode node address = LoadedNode <$> node <*> address
+  mbNode = case sequenceA mbAddressNumberToLoad of
+    Nothing -> pure Nothing
+    Just n -> sequenceA $ Just (ram n)

lamagraph-core/src/Core/Map.hs

@@ -0,0 +1,70 @@
+{-# 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
+-}
+type Map (size :: Nat) v = (Vec size (Maybe (AddressNumber, Maybe v)))
+
+find ::
+  (KnownNat size) =>
+  Map size v ->
+  AddressNumber ->
+  Maybe v
+find dict key = case dict of
+  Nil -> Nothing
+  (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.
+
+TODO: fix @id@ case. If @func@ is isomorphic to @id@ then @insertWith@ works incorrect
+-}
+insertWith ::
+  (KnownNat size, Eq v) =>
+  Map size v ->
+  (Maybe v -> Maybe v) ->
+  AddressNumber ->
+  Map size v
+insertWith dict func key = if dict /= updated then updated else inserted
+ where
+  updated = update key func dict
+  inserted = insert key (func Nothing) dict
+
+-- | 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
+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 1 (Just 1) (def :: Map 2 AddressNumber)
+Just (1,Just 1) :> Nothing :> Nil
+-}
+insert ::
+  AddressNumber ->
+  Maybe v ->
+  Map size v ->
+  Map size v
+insert key value dict = case dict of
+  h `Cons` t -> case h of
+    Nothing -> Just (key, value) `Cons` t
+    Just _ -> h `Cons` insert key value t
+  Nil -> error "All addresses are written"