Inching towards drev of build

3 files changed, 24 insertions, 16 deletions

diff --git a/src/AST/Count.hs b/src/AST/Count.hs
index 7e70a7d..289c1fb 100644
--- a/src/AST/Count.hs
+++ b/src/AST/Count.hs
@@ -76,17 +76,17 @@ scaleManyOccEnv :: OccEnv env -> OccEnv env
 scaleManyOccEnv OccEnd = OccEnd
 scaleManyOccEnv (OccPush e o) = OccPush (scaleManyOccEnv e) (scaleMany o)
 
+occEnvPop :: OccEnv (t : env) -> OccEnv env
+occEnvPop (OccPush o _) = o
+occEnvPop OccEnd = OccEnd
+
 occCountAll :: Expr x env t -> OccEnv env
-occCountAll = occCountGeneral onehotOccEnv unpush unpushN (<||>!) scaleManyOccEnv
+occCountAll = occCountGeneral onehotOccEnv occEnvPop occEnvPopN (<||>!) scaleManyOccEnv
   where
-    unpush :: OccEnv (t : env) -> OccEnv env
-    unpush (OccPush o _) = o
-    unpush OccEnd = OccEnd
-
-    unpushN :: SNat n -> OccEnv (ConsN n TIx env) -> OccEnv env
-    unpushN _ OccEnd = OccEnd
-    unpushN SZ e = e
-    unpushN (SS n) (OccPush e _) = unpushN n e
+    occEnvPopN :: SNat n -> OccEnv (ConsN n TIx env) -> OccEnv env
+    occEnvPopN _ OccEnd = OccEnd
+    occEnvPopN SZ e = e
+    occEnvPopN (SS n) (OccPush e _) = occEnvPopN n e
 
 occCountGeneral :: forall r env t x.
                    (forall env'. Monoid (r env'))
@@ -112,11 +112,12 @@ occCountGeneral onehot unpush unpushN alter many = go
       EBuild1 _ a b -> go a <> many (unpush (go b))
       EBuild _ es e -> foldMap go es <> many (unpushN (vecLength es) (go e))
       EFold1 _ a b -> many (unpush (unpush (go a))) <> go b
+      EUnit _ e -> go e
       EConst{} -> mempty
       EIdx0 _ e -> go e
       EIdx1 _ a b -> go a <> go b
       EIdx _ e es -> go e <> foldMap go es
       EOp _ _ e -> go e
       EWith a b -> go a <> unpush (go b)
-      EAccum a b e -> go a <> go b <> go e
+      EAccum1 a b e -> go a <> go b <> go e
       EError{} -> mempty
diff --git a/src/AST/Pretty.hs b/src/AST/Pretty.hs
index ba1b756..1dc9dd3 100644
--- a/src/AST/Pretty.hs
+++ b/src/AST/Pretty.hs
@@ -133,6 +133,10 @@ ppExpr' d val = \case
       showString ("fold1 (\\" ++ name1 ++ " " ++ name2 ++ " -> ") . a'
       . showString ") " . b'
 
+  EUnit _ e -> do
+    e' <- ppExpr' 11 val e
+    return $ showParen (d > 10) $ showString "unit " . e'
+
   EConst _ ty v -> return $ showString $ case ty of
     STI32 -> show v ; STI64 -> show v ; STF32 -> show v ; STF64 -> show v ; STBool -> show v
 
@@ -176,12 +180,12 @@ ppExpr' d val = \case
       showString "with " . e1' . showString (" (\\" ++ name ++ " -> ")
       . e2' . showString ")"
 
-  EAccum e1 e2 e3 -> do
+  EAccum1 e1 e2 e3 -> do
     e1' <- ppExpr' 11 val e1
     e2' <- ppExpr' 11 val e2
     e3' <- ppExpr' 11 val e3
     return $ showParen (d > 10) $
-      showString "accum " . e1' . showString " " . e2' . showString " " . e3'
+      showString "accum1 " . e1' . showString " " . e2' . showString " " . e3'
 
   EError _ s -> return $ showParen (d > 10) $ showString ("error " ++ show s)
 
diff --git a/src/AST/Weaken/Auto.hs b/src/AST/Weaken/Auto.hs
index 0bf5780..444c540 100644
--- a/src/AST/Weaken/Auto.hs
+++ b/src/AST/Weaken/Auto.hs
@@ -18,7 +18,7 @@
 {-# OPTIONS_GHC -Wno-partial-type-signatures #-}
 module AST.Weaken.Auto (
   autoWeak,
-  ($..), auto,
+  (&.), auto, auto1,
   Layout(..),
 ) where
 
@@ -56,9 +56,12 @@ instance (KnownSymbol name, name ~ name', segs ~ '[ '(name', ts)]) => IsLabel na
 auto :: KnownListSpine list => SList (Const ()) list
 auto = knownListSpine
 
-infixr $..
-($..) :: SSegments segs1 -> SSegments segs2 -> SSegments (Append segs1 segs2)
-($..) = ssegmentsAppend
+auto1 :: SList (Const ()) '[t]
+auto1 = Const () `SCons` SNil
+
+infixr &.
+(&.) :: SSegments segs1 -> SSegments segs2 -> SSegments (Append segs1 segs2)
+(&.) = ssegmentsAppend
   where
     ssegmentsAppend :: SSegments a -> SSegments b -> SSegments (Append a b)
     ssegmentsAppend SSegNil l2 = l2