diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2025-04-27 23:34:59 +0200 |
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2025-04-27 23:34:59 +0200 |
| commit | b1664532eaebdf0409ab6d93fc0ba2ef8dfbf372 (patch) | |
| tree | a40c16fd082bbe4183e7b4194b8cea1408cec379 /src/Interpreter/Rep.hs | |
| parent | c750f8f9f1275d49ff74297e6648e1bfc1c6d918 (diff) | |
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.
Diffstat (limited to 'src/Interpreter/Rep.hs')
| -rw-r--r-- | src/Interpreter/Rep.hs | 11 |
1 files changed, 8 insertions, 3 deletions
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 $ "<accumulator for " ++ ppSTy 0 t ++ ">" +showValue _ (STAccum t) _ = showString $ "<accumulator for " ++ ppSMTy 0 t ++ ">" +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) ++ "]" |