diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2025-11-27 21:30:17 +0100 |
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2025-11-27 21:30:17 +0100 |
| commit | 20f7d7be13cd7869b338f98d1ab3fd33e8bbfb3e (patch) | |
| tree | a21c90034a02cdeb7240563dbbab355e49622d0a /src/CHAD/Drev.hs | |
| parent | ae634c056b500a568b2d89b7f8e225404a2c0c62 (diff) | |
WIP user-specified custom typesuser-types
The big roadblock encountered is that accumulation wants addition of
monoids to be elementwise float addition; this fundamentally clashes
with the concept of a user type with a custom zero and plus.
Diffstat (limited to 'src/CHAD/Drev.hs')
| -rw-r--r-- | src/CHAD/Drev.hs | 6 |
1 files changed, 6 insertions, 0 deletions
diff --git a/src/CHAD/Drev.hs b/src/CHAD/Drev.hs index bfa964b..6dc586c 100644 --- a/src/CHAD/Drev.hs +++ b/src/CHAD/Drev.hs @@ -392,6 +392,7 @@ expandSparse (STArr _ t) (SpArr s) epr e = expandSparse (STScal STF32) SpScal _ e = e expandSparse (STScal STF64) SpScal _ e = e expandSparse (STAccum{}) _ _ _ = error "accumulators not allowed in source program" +expandSparse _ SpUser _ e = e subenvPlus :: SBool req1 -> SBool req2 -> SList SMTy env @@ -601,6 +602,7 @@ accumPromote pdty (descr `DPush` (t :: STy t, vid, sto)) k = case sto of STF64 -> False STBool -> True STAccum{} -> False + STUser{} -> False ---------------------------- RETURN TRIPLE FROM CHAD --------------------------- @@ -1378,11 +1380,15 @@ drev des accumMap sd = \case EFold1InnerD1{} -> err_targetlang "EFold1InnerD1" EFold1InnerD2{} -> err_targetlang "EFold1InnerD2" + EUser _ t@STUser{} _ -> err_user ("EUser " ++ show (typeOfProxy t)) + EUnUser _ e | t@STUser{} <- typeOf e -> err_user ("EUnUser " ++ show (typeOfProxy t)) + where err_accum = error "Accumulator operations unsupported in the source program" err_monoid = error "Monoid operations unsupported in the source program" err_unsupported s = error $ "CHAD: unsupported " ++ s err_targetlang s = error $ "CHAD: Target language operation " ++ s ++ " not supported in source program" + err_user s = error $ "CHAD: operations on user types must always be provided a custom derivative with ECustom, encountered " ++ s contribTupTy :: Descr env sto -> SubenvS (D2E (Select env sto "merge")) contribs -> STy (Tup contribs) contribTupTy des' sub = tTup (slistMap fromSMTy (subList (d2eM (select SMerge des')) sub)) |