[<<][rtl][>>][..]
Fri Aug 3 08:13:13 EDT 2018

seqInitMem

seqRun (\((r2, r1),
          (r3, r5, r7, r9),
          [r0]) -> do {r4 <- seqADD (seqInt 1) r0 r3;
                       r6 <- seqADD (seqInt 4) r5 (seqInt 1);
                       r8 <- seqADD (seqInt 5) r7 (seqInt 1);
                       r10 <- seqADD (seqInt 6) r9 (seqInt 1);
                       return ((r4, r6, r8, r10), [r3])})
       ((seqInt 0, seqInitMem),
        (seqInt 0, seqInt 0, seqInt 0, seqInt 0))

The memories need to be initialized before the loop runs.



Here's the diff.  I'm going to revert it.



tom@panda:~/asm_tools$ git diff
diff --git a/SeqPrim.hs b/SeqPrim.hs
index 669c340..0e4826f 100644
--- a/SeqPrim.hs
+++ b/SeqPrim.hs
@@ -7,7 +7,7 @@
 
 module SeqPrim(
   seqADD, seqSUB, seqAND, seqEQU, seqIF, seqCONC, seqSLICE,
-  seqInt, seqInitMem, seqUpdateMem,
+  seqInt, seqInitMem, seqMemRd, seqMemWr, --seqUpdateMem, 
   seqRun
   ) where
 import Data.IntMap.Strict
@@ -51,15 +51,23 @@ seqEQU = op2 $ \a b   -> if a == b then 1 else 0
 seqCONC  = op3 $ \bs a b -> (a `shiftL` bs) .|. b
 seqSLICE = op2 $ shiftR
 
-seqInitMem :: IntMap Int
-seqInitMem = empty
+type Mem s = STUArray s Int Int
+seqInitMem :: ST s (Mem s)
+seqInitMem = newArray (0, 256) 0  -- FIXME: size!
+
+seqUpdateMem :: ((Int, Int, Int, Int), Mem s) ->  ST s (Int, Mem s)
+seqUpdateMem (args@(wEn,wAddr,wData,rAddr), arr) = do
+  rData <- readArray arr rAddr
+  case wEn of
+    0 -> return ()
+    1 -> writeArray arr wAddr wData
+    _ -> error $ "seqUpdateMem: " ++ show args
+  return (rData, arr)
+
+
+seqMemRd :: ((Int, Int, Int, Int), Mem s) ->  ST s (Int, Mem s)
+seqMemWr :: ((Int, Int, Int, Int), Mem s) ->  ST s (Int, Mem s)
 
-seqUpdateMem :: ((Int, Int, Int, Int), IntMap Int) -> (Int,  IntMap Int)
-seqUpdateMem ((wEn,wAddr,wData,rAddr), mem) = (rData, mem') where
-  rData = findWithDefault 0 rAddr mem
-  mem' = case wEn == 0 of
-           True  -> mem
-           False -> insert wAddr wData mem
 
 seqInt :: Integer -> Int
 seqInt = fromIntegral
@@ -70,37 +78,24 @@ seqInt = fromIntegral
 -- r: register state (tuple of Int)
 -- i/o is collected in a concrete [] type to make it easier to handle.
 
-seqRun :: ((a, r, [Int]) -> forall s. ST s (r, [Int])) -> (a, r) -> [[Int]] -> [[Int]]
-seqRun f (a,r0) i = runST $ u r0 i where
-  u _ [] = return []
-  u r (i:is) = do
-    (r',o) <- f (a, r,i)
-    os <- u r' is
-    return (o:os)
-
-
--- seqRun' ::
---   (forall s. (m,r,[Int]) -> ST s (m, r, [Int])
---   ,(m,r)) -> [[Int]] -> [[Int]]
--- seqRun' (f, (m0, r0)) is = runST $ u m0 r0 is where
-
---   u _ _ [] = return []
---   u m r (i:is) = do
---     (m',r',o) <- f' (m,r,i)
---     os <- (u m' r' is)
---     return (o:os)
-
-
-seqRun' :: ((m,r,[Int]) -> forall s. ST s (m, r, [Int])) -> (m, r) ->  [[Int]] -> [[Int]]
-seqRun' f (m0, r0) is = runST $ u m0 r0 is where
-  u _ _ [] = return []
-  u m r (i:is) = do
-    (m',r',o) <- f (m,r,i)
-    os <- (u m' r' is)
-    return (o:os)
-    
-
--- seqRun = undefined
+seqRun ::
+  ((a, r, [Int]) -> forall s. ST s (r, [Int]))
+  -> (forall s. ST s a)
+  -> r
+  -> [[Int]] -> [[Int]]
+seqRun f ma r0 i = runST m where
+  m = do
+    -- Initialize mutable state (e.g. arrays)
+    a <- ma
+    -- Run loop
+    let u _ [] = return []
+        u r (i:is) = do
+          (r',o) <- f (a, r,i)
+          os <- u r' is
+          return (o:os)
+    u r0 i
+
+
 
 -- For ST, it is important to understand which s parameters are
 -- specific, and which are generic.
diff --git a/SeqTH.hs b/SeqTH.hs
index ca56074..fa19181 100644
--- a/SeqTH.hs
+++ b/SeqTH.hs
@@ -46,18 +46,17 @@ toExp  (outputs, bindings) = exp where
   -- trying to make the loop function and initial state explicit,
   -- which I don't want to understand yet.  It seems best to just
   -- generate a closed expression.
+  exp = app3 (seqVar "Run") update memInit stateInit
   
-  
-  exp = app2 (seqVar "Run") update init
-  
-  init = TupE [memInit, stateInit]
   update =
-    LamE [TupP [memIn, stateIn, inputs]] $
+    LamE [TupP [memRefs, stateIn, inputs]] $
     DoE $
+    memRead ++
     bindings' ++
-    [NoBindS $ AppE
-     (VarE $ mkName "return")
-     (TupE [stateOut, outputs'])]
+    memWrite ++
+    (return' $ TupE [stateOut, outputs'])
+
+  return' e = [NoBindS $ AppE (VarE $ mkName "return") e]
   
   partition t = map snd $ filter ((t ==) . fst) tagged
   tagged = map p' bindings
@@ -69,8 +68,8 @@ toExp  (outputs, bindings) = exp where
   p _              = E
     
   bindings' =
-    [BindS (nodeNumPat n) (termExp e)
-    | (n, e) <- partition E]
+    [BindS (nodeNumPat n) (termExp e) |
+     (n, e) <- partition E]
 
   -- I/O is more conveniently exposed as lists, which would be the
   -- same interface as the source code.  State can use tuples: it will
@@ -84,17 +83,43 @@ toExp  (outputs, bindings) = exp where
   stateIn   = tupP' $ map (nodeNumPat . fst) $ ds
   stateOut  = tupE' [nodeExp n | (_, (Delay _ n)) <- ds]
 
-  mrs = partition MR
-  mi _ = tupE' $ [int 0, seqVar "InitMem"]
-  mr (rd, MemRd _ (MemNode mem)) =
-    tupP' [nodeNumPat rd, nodeNumPat mem]
-  memInit  = tupE' $ map mi mrs
-  memIn  = tupP' $ map mr mrs
-  memOut =
-    tupE' [AppE (seqVar "UpdateMem") $
-            TupE [tupE' $ map nodeExp [a,b,c,d],
-                  nodeNumExp n]
-          | (n, (MemWr (a,b,c,d))) <- partition MW]
+  
+
+  -- For ST, memories are different.  The question is whether to
+  -- implement it in the generated code, or to use functions.  It
+  -- seems possible to implement MemRd and MemWr directly as monadic
+  -- operators.  The use of tuples makes it hard to "fmap".
+
+  -- Here's the current strategy:
+  -- . Create an initializer that produces a tuple of arrays
+  -- . Create imperative memory read functions, inserted at the start of the loop
+  -- . Same for write, at the end
+
+  memRefs  = tupP' $ map (nodeNumPat . fst) $ partition MR
+  memInit  = tupE' []
+  memRead  = [BindS (nodeNumPat rData) ()
+             | (rData, (MemRd td arr)) <- partition MR]
+  memWrite = [BindS _ _ | (_, (MemWr (_,_,_,_))) <- partition MW]
+
+
+  -- -- Memories need to be instantiated before the loop starts.
+  -- mrs = partition MR
+  -- mi _ = tupE' $ [int 0, seqVar "InitMem"]
+
+  -- mr (rd, MemRd _ (MemNode mem)) =
+  --   tupP' [nodeNumPat rd, nodeNumPat mem]
+  -- memInit =
+  --   DoE $
+  --   [BindS (VarP $ mkName $ "m" ++ show n) (mi mr) | (mi,n) <- zip mrs [0..]]
+  --   ++ (return' $ tupE' [VarE $ mkName $ "m" ++ show n | (_,n) <- zip mrs [0..]])
+  -- -- tupE' $ map mi mrs
+  
+  -- memIn  = tupP' $ map mr mrs
+  -- memOut =
+  --   tupE' [AppE (seqVar "UpdateMem") $
+  --           TupE [tupE' $ map nodeExp [a,b,c,d],
+  --                 nodeNumExp n]
+  --         | (n, (MemWr (a,b,c,d))) <- partition MW]
 
 
 -- FIXME: Use nested tuples for the state, memory collections.
@@ -112,7 +137,6 @@ opVar :: Show t => t -> Exp
 opVar opc = seqVar $ show opc
 seqVar str = VarE $ mkName $ "seq" ++ str
 
-
 termExp :: T -> Exp
 
 -- Special cases
tom@panda:~/asm_tools$ 






The main change needed is to inline the "memUpdate" as NoBindS, and
provide an initializer.  

EDIT: Done. Was straightforward.




[Reply][About]
[<<][rtl][>>][..]