diff options
author | Tom Smeding <tom@tomsmeding.com> | 2025-06-18 00:00:11 +0200 |
---|---|---|
committer | Tom Smeding <tom@tomsmeding.com> | 2025-06-18 00:00:11 +0200 |
commit | d1b2e2c3a3cdaf49ff5e4bae6fe9b0612c3779c2 (patch) | |
tree | 38577e02839ac18244aa46b833da8957cbe9789e /src/AST/Accum.hs | |
parent | 2b1a40b5933b8b0dceaae744e5b70cb604822c9d (diff) |
Tests pass, should check if output is sensible
Diffstat (limited to 'src/AST/Accum.hs')
-rw-r--r-- | src/AST/Accum.hs | 58 |
1 files changed, 36 insertions, 22 deletions
diff --git a/src/AST/Accum.hs b/src/AST/Accum.hs index 158b4d9..619c2b1 100644 --- a/src/AST/Accum.hs +++ b/src/AST/Accum.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeData #-} {-# LANGUAGE TypeFamilies #-} @@ -33,35 +34,38 @@ data SAcPrj (p :: AcPrj) (a :: Ty) (b :: Ty) where -- SAPArrSlice :: SNat m -> SAcPrj (APArrSlice m) (TArr n t) (TArr (n - m) t) deriving instance Show (SAcPrj p a b) -type data StillDense = AI_D | AI_S -data SStillDense dense where - SAI_D :: SStillDense AI_D - SAI_S :: SStillDense AI_S -deriving instance Show (SStillDense dense) +type data AIDense = AID | AIS -type family AcIdx dense p t where - AcIdx dense APHere t = TNil - AcIdx AI_D (APFst p) (TPair a b) = AcIdx AI_D p a - AcIdx AI_D (APSnd p) (TPair a b) = AcIdx AI_D p b - AcIdx AI_S (APFst p) (TPair a b) = TPair (AcIdx AI_S p a) (ZeroInfo b) - AcIdx AI_S (APSnd p) (TPair a b) = TPair (ZeroInfo a) (AcIdx AI_S p b) - AcIdx dense (APLeft p) (TLEither a b) = AcIdx AI_S p a - AcIdx dense (APRight p) (TLEither a b) = AcIdx AI_S p b - AcIdx dense (APJust p) (TMaybe a) = AcIdx AI_S p a - AcIdx AI_D (APArrIdx p) (TArr n a) = TPair (Tup (Replicate n TIx)) (AcIdx AI_D p a) - AcIdx AI_S (APArrIdx p) (TArr n a) = - -- ((index, shapes info), recursive info) +data SAIDense d where + SAID :: SAIDense AID + SAIS :: SAIDense AIS +deriving instance Show (SAIDense d) + +type family AcIdx d p t where + AcIdx d APHere t = TNil + AcIdx AID (APFst p) (TPair a b) = AcIdx AID p a + AcIdx AID (APSnd p) (TPair a b) = AcIdx AID p b + AcIdx AIS (APFst p) (TPair a b) = TPair (AcIdx AIS p a) (ZeroInfo b) + AcIdx AIS (APSnd p) (TPair a b) = TPair (ZeroInfo a) (AcIdx AIS p b) + AcIdx d (APLeft p) (TLEither a b) = AcIdx d p a + AcIdx d (APRight p) (TLEither a b) = AcIdx d p b + AcIdx d (APJust p) (TMaybe a) = AcIdx d p a + AcIdx AID (APArrIdx p) (TArr n a) = + -- (index, recursive info) + TPair (Tup (Replicate n TIx)) (AcIdx AID p a) + AcIdx AIS (APArrIdx p) (TArr n a) = + -- ((index, shape info), recursive info) TPair (TPair (Tup (Replicate n TIx)) (ZeroInfo (TArr n a))) - (AcIdx AI_S p a) - -- AcIdx AI_D (APArrSlice m) (TArr n a) = + (AcIdx AIS p a) + -- AcIdx AID (APArrSlice m) (TArr n a) = -- -- index -- Tup (Replicate m TIx) - -- AcIdx AI_S (APArrSlice m) (TArr n a) = + -- AcIdx AIS (APArrSlice m) (TArr n a) = -- -- (index, array shape) -- TPair (Tup (Replicate m TIx)) (Tup (Replicate n TIx)) -type AcIdxD p t = AcIdx AI_D p t -type AcIdxS p t = AcIdx AI_S p t +type AcIdxD p t = AcIdx AID p t +type AcIdxS p t = AcIdx AIS p t acPrjTy :: SAcPrj p a b -> SMTy a -> SMTy b acPrjTy SAPHere t = t @@ -88,6 +92,16 @@ tZeroInfo (SMTMaybe _) = STNil tZeroInfo (SMTArr n t) = STArr n (tZeroInfo t) tZeroInfo (SMTScal _) = STNil +-- | Info needed to create a zero-valued deep accumulator for a monoid type. +-- Should be constructable from a D1. +type family DeepZeroInfo t where + DeepZeroInfo TNil = TNil + DeepZeroInfo (TPair a b) = TPair (DeepZeroInfo a) (DeepZeroInfo b) + DeepZeroInfo (TLEither a b) = TLEither (DeepZeroInfo a) (DeepZeroInfo b) + DeepZeroInfo (TMaybe a) = TMaybe (DeepZeroInfo a) + DeepZeroInfo (TArr n a) = TArr n (DeepZeroInfo a) + DeepZeroInfo (TScal t) = TNil + -- -- | Additional info needed for accumulation. This is empty unless there is -- -- sparsity in the monoid. -- type family AccumInfo t where |