Compile: Don't toList the Bag in 'scope'

1 files changed, 24 insertions, 24 deletions

diff --git a/src/Compile.hs b/src/Compile.hs
index a3b4be1..302c750 100644
--- a/src/Compile.hs
+++ b/src/Compile.hs
@@ -289,12 +289,12 @@ genName = genName' "x"
 emit :: Stmt -> CompM ()
 emit stmt = modify $ \s -> s { csStmts = csStmts s <> pure stmt }
 
-scope :: CompM a -> CompM (a, [Stmt])
+scope :: CompM a -> CompM (a, Bag Stmt)
 scope m = do
   stmts <- state $ \s -> (csStmts s, s { csStmts = mempty })
   res <- m
   innerStmts <- state $ \s -> (csStmts s, s { csStmts = stmts })
-  return (res, toList innerStmts)
+  return (res, innerStmts)
 
 emitStruct :: STy t -> CompM String
 emitStruct ty = do
@@ -546,8 +546,8 @@ compile' env = \case
     retvar <- genName
     emit $ SVarDeclUninit (repSTy (typeOf a)) retvar
     emit $ SIf e1
-             (BList stmts2 <> pure (SAsg retvar e2))
-             (BList stmts3 <> pure (SAsg retvar e3))
+             (stmts2 <> pure (SAsg retvar e2))
+             (stmts3 <> pure (SAsg retvar e3))
     return (CELit retvar)
 
   ECase _ e a b -> do
@@ -563,11 +563,11 @@ compile' env = \case
     emit $ SVarDeclUninit (repSTy (typeOf a)) retvar
     emit $ SBlock (pure (SVarDecl True (repSTy (typeOf e)) var e1)
                 <> pure (SIf (CEBinop (CEProj (CELit var) "tag") "==" (CELit "0"))
-                           (BList stmts2
-                            <> BList stmtsRel1
+                           (stmts2
+                            <> stmtsRel1
                             <> pure (SAsg retvar e2))
-                           (BList stmts3
-                            <> BList stmtsRel2
+                           (stmts3
+                            <> stmtsRel2
                             <> pure (SAsg retvar e3))))
     return (CELit retvar)
 
@@ -591,10 +591,10 @@ compile' env = \case
     emit $ SVarDeclUninit (repSTy (typeOf a)) retvar
     emit $ SBlock (pure (SVarDecl True (repSTy (typeOf e)) var e1)
                 <> pure (SIf (CEBinop (CEProj (CELit var) "tag") "==" (CELit "0"))
-                           (BList stmts2
+                           (stmts2
                             <> pure (SAsg retvar e2))
-                           (BList stmts3
-                            <> BList stmtsRel
+                           (stmts3
+                            <> stmtsRel
                             <> pure (SAsg retvar e3))))
     return (CELit retvar)
 
@@ -628,7 +628,7 @@ compile' env = \case
                  | (ivar, dimidx) <- zip ivars [0::Int ..]]
            (pure (SVarDecl True (repSTy (typeOf esh)) idxargname
                            (shapeTupFromLitVars n ivars))
-            <> BList funstmts
+            <> funstmts
             <> pure (SAsg (arrname ++ ".buf->xs[" ++ linivar ++ "++]") funretval))
 
     return (CELit arrname)
@@ -661,14 +661,14 @@ compile' env = \case
 
     emit $ SLoop (repSTy tIx) ivar (CELit "0") (CELit shszname) $
              pure (SVarDecl False (repSTy t) accvar (CELit x0name))
-             <> BList x0incrStmts  -- we're copying x0 here
+             <> x0incrStmts  -- we're copying x0 here
              <> pure (SLoop (repSTy tIx) jvar (CELit "0") (CELit lenname) $
                         -- The combination function will consume the array element
                         -- and the accumulator. The accumulator is replaced by
                         -- what comes out of the function anyway, so that's
                         -- fine, but we do need to increment the array element.
-                        BList arreltIncrStmts
-                        <> BList funStmts
+                        arreltIncrStmts
+                        <> funStmts
                         <> pure (SAsg accvar funres))
              <> pure (SAsg (resname ++ ".buf->xs[" ++ ivar ++ "]") (CELit accvar))
 
@@ -837,19 +837,19 @@ compile' env = \case
           ((), stmts2) <- scope $ add t2 (d++".r") (s++".r")
           emit $ SAsg (d++".tag") (CELit (s++".tag"))
           emit $ SIf (CEBinop (CELit (s++".tag")) "==" (CELit "0"))
-                     (BList stmts1) (BList stmts2)
+                     stmts1 stmts2
         add (STMaybe t1) d s = do
           ((), stmts1) <- scope $ add t1 (d++".j") (s++".j")
           emit $ SAsg (d++".tag") (CELit (s++".tag"))
           emit $ SIf (CEBinop (CELit (s++".tag")) "==" (CELit "1"))
-                     (BList stmts1) mempty
+                     stmts1 mempty
         add (STArr n t1) d s = do
           shsizename <- genName' "acshsz"
           emit $ SVarDecl True "size_t" shsizename (compileShapeSize n (s++".a.b"))
           ivar <- genName' "i"
           ((), stmts1) <- scope $ add t1 (d++".buf->xs["++ivar++"]") (s++".buf->xs["++ivar++"]")
           emit $ SLoop (repSTy tIx) ivar (CELit "0") (CELit shsizename) $
-                   BList stmts1
+                   stmts1
         add (STScal sty) d s = case sty of
           STI32 -> emit $ SVerbatim $ d ++ " += " ++ s ++ ";"
           STI64 -> emit $ SVerbatim $ d ++ " += " ++ s ++ ";"
@@ -947,7 +947,7 @@ incrementVar' inc path (ATArray (Some n) (Some eltty)) =
           emit $ SIf (CELit ("--" ++ path ++ ".buf->refc == 0"))
                    (BList [SVarDecl True "size_t" shszvar (compileArrShapeSize n path)
                           ,SLoop "size_t" ivar (CELit "0") (CELit shszvar) $
-                             BList eltDecrStmts
+                             eltDecrStmts
                           ,SVerbatim $ "free(" ++ path ++ ".buf);"])
                    mempty
 incrementVar' _ _ ATNoop = pure ()
@@ -955,7 +955,7 @@ incrementVar' inc path (ATProj field t) = incrementVar' inc (path ++ "." ++ fiel
 incrementVar' inc path (ATCondTag t1 t2) = do
   ((), stmts1) <- scope $ incrementVar' inc path t1
   ((), stmts2) <- scope $ incrementVar' inc path t2
-  emit $ SIf (CEBinop (CELit (path ++ ".tag")) "==" (CELit "0")) (BList stmts1) (BList stmts2)
+  emit $ SIf (CEBinop (CELit (path ++ ".tag")) "==" (CELit "0")) stmts1 stmts2
 incrementVar' inc path (ATBoth t1 t2) = incrementVar' inc path t1 >> incrementVar' inc path t2
 
 toLinearIdx :: SNat n -> String -> String -> CExpr
@@ -1140,10 +1140,10 @@ copyForWriting topty var = case topty of
         name <- genName
         emit $ SVarDeclUninit (repSTy topty) name
         emit $ SIf (CEBinop (CELit var) "==" (CELit "0"))
-                 (BList stmts1
+                 (stmts1
                   <> pure (SAsg name (CEStruct (repSTy topty)
                                         [("tag", CELit "0"), ("l", fromMaybe (CELit (var++".l")) e1)])))
-                 (BList stmts2
+                 (stmts2
                   <> pure (SAsg name (CEStruct (repSTy topty)
                                         [("tag", CELit "1"), ("r", fromMaybe (CELit (var++".r")) e2)])))
         return (Just (CELit name))
@@ -1157,7 +1157,7 @@ copyForWriting topty var = case topty of
         emit $ SVarDeclUninit (repSTy topty) name
         emit $ SIf (CEBinop (CELit var) "==" (CELit "0"))
                  (pure (SAsg name (CEStruct (repSTy topty) [("tag", CELit "0")])))
-                 (BList stmts1
+                 (stmts1
                   <> pure (SAsg name (CEStruct (repSTy topty) [("tag", CELit "1"), ("j", e1')])))
         return (Just (CELit name))
 
@@ -1215,7 +1215,7 @@ copyForWriting topty var = case topty of
                   Nothing -> error "copyForWriting: arrays cannot be copied as-is, bug"
 
     emit $ SLoop (repSTy tIx) ivar (CELit "0") (CELit shszname) $
-             BList cpystmts
+             cpystmts
              <> pure (SAsg (dstvar ++ "[" ++ ivar ++ "]") cpye')
 
     return (Just (CELit name))