From b1664532eaebdf0409ab6d93fc0ba2ef8dfbf372 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Sun, 27 Apr 2025 23:34:59 +0200 Subject: WIP revamp accumulators again: explicit monoid types No more D2 in accumulators! Paving the way for configurable sparsity of products and arrays. The idea is to make separate monoid types for a "product cotangent" and an "array cotangent" that can be lowered to either a sparse monoid or a non-sparse monoid. Downsides of this approach: lots of API duplication. --- src/Interpreter/Rep.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'src/Interpreter/Rep.hs') diff --git a/src/Interpreter/Rep.hs b/src/Interpreter/Rep.hs index be2a4cc..9056901 100644 --- a/src/Interpreter/Rep.hs +++ b/src/Interpreter/Rep.hs @@ -22,6 +22,7 @@ type family Rep t where Rep (TArr n t) = Array n (Rep t) Rep (TScal sty) = ScalRep sty Rep (TAccum t) = RepAc t + Rep (TLEither a b) = Maybe (Either (Rep a) (Rep b)) -- Mutable, represents D2 of t. Has an O(1) zero. type family RepAc t where @@ -32,6 +33,7 @@ type family RepAc t where RepAc (TArr n t) = IORef (Maybe (Array n (RepAc t))) RepAc (TScal sty) = RepAcScal sty RepAc (TAccum t) = TypeError (Text "RepAcSparse: Nested accumulators") + RepAc (TLEither a b) = IORef (Maybe (Either (RepAc a) (RepAc b))) type family RepAcScal t where RepAcScal TI32 = () @@ -57,8 +59,8 @@ vUnpair (Value (x, y)) = (Value x, Value y) showValue :: Int -> STy t -> Rep t -> ShowS showValue _ STNil () = showString "()" showValue _ (STPair a b) (x, y) = showString "(" . showValue 0 a x . showString "," . showValue 0 b y . showString ")" -showValue d (STEither a _) (Left x) = showParen (d > 10) $ showString "Left " . showValue 11 a x -showValue d (STEither _ b) (Right y) = showParen (d > 10) $ showString "Right " . showValue 11 b y +showValue d (STEither a _) (Left x) = showParen (d > 10) $ showString "Inl " . showValue 11 a x +showValue d (STEither _ b) (Right y) = showParen (d > 10) $ showString "Inr " . showValue 11 b y showValue _ (STMaybe _) Nothing = showString "Nothing" showValue d (STMaybe t) (Just x) = showParen (d > 10) $ showString "Just " . showValue 11 t x showValue d (STArr _ t) arr = showParen (d > 10) $ @@ -72,7 +74,10 @@ showValue _ (STScal sty) x = case sty of STI32 -> shows x STI64 -> shows x STBool -> shows x -showValue _ (STAccum t) _ = showString $ "" +showValue _ (STAccum t) _ = showString $ "" +showValue _ (STLEither _ _) Nothing = showString "LNil" +showValue d (STLEither a _) (Just (Left x)) = showParen (d > 10) $ showString "LInl " . showValue 11 a x +showValue d (STLEither _ b) (Just (Right y)) = showParen (d > 10) $ showString "LInr " . showValue 11 b y showEnv :: SList STy env -> SList Value env -> String showEnv = \env vals -> "[" ++ intercalate ", " (showEntries env vals) ++ "]" -- cgit v1.2.3-70-g09d2