diff options
| author | Tom Smeding <t.j.smeding@uu.nl> | 2025-03-09 22:08:34 +0100 |
|---|---|---|
| committer | Tom Smeding <t.j.smeding@uu.nl> | 2025-03-09 22:08:34 +0100 |
| commit | 0527b33280fd8e59bfc0c7b2f031cd5acf4b18e2 (patch) | |
| tree | ca8abf528419a0919000e2e0bd30fb3b8d2bdf6b | |
| parent | c3b4f56760547940256afea8e692681dbbe21857 (diff) | |
Just allow non-array accumulator types
Not sure why I didn't allow this previously
| -rw-r--r-- | src/CHAD.hs | 21 |
1 files changed, 4 insertions, 17 deletions
diff --git a/src/CHAD.hs b/src/CHAD.hs index 3f76922..4675434 100644 --- a/src/CHAD.hs +++ b/src/CHAD.hs @@ -425,10 +425,10 @@ accumPromote pdty (descr `DPush` (t :: STy t, sto)) k = (SENo prosub) wf - -- Arrays with "merge" storage are promoted to an accumulator in envPro - STArr (arrn :: SNat arrn) (arrt :: STy arrt) -> + -- Values with "merge" storage are promoted to an accumulator in envPro + _ -> k (storepl `DPush` (t, SAccum)) - (STArr arrn arrt `SCons` envpro) + (t `SCons` envpro) (SEYes prosub) (\(shbinds :: SList _ shbinds) -> let shbindsC = slistMap (\_ -> Const ()) shbinds @@ -441,13 +441,9 @@ accumPromote pdty (descr `DPush` (t :: STy t, sto)) k = -- goal: | ARE EQUAL || -- D2 t : Append shbinds (TAccum n t3 : D2AcE (Select envPro stoRepl "accum")) :> TAccum n t3 : Append envPro (D2 t : Append shbinds (D2AcE (Select envPro sto1 "accum"))) WCopy (wf shbinds) - .> WPick @(TAccum (D2 (TArr arrn arrt))) @(D2 dt : shbinds) (Const () `SCons` shbindsC) + .> WPick @(TAccum (D2 t)) @(D2 dt : shbinds) (Const () `SCons` shbindsC) (WId @(D2AcE (Select env1 stoRepl "accum")))) - -- "merge" values must be an array or fully discrete, so reject everything else. (TODO: generalise this) - _ -> - error $ "Closure variable of 'build'-like thing contains a non-array non-discrete SMerge value: " ++ show t - -- Discrete values are left as-is, nothing to do SDiscr -> k (storepl `DPush` (t, SDiscr)) @@ -470,15 +466,6 @@ accumPromote pdty (descr `DPush` (t :: STy t, sto)) k = STBool -> True STAccum{} -> False - -- containsTArr :: STy t' -> Bool - -- containsTArr = \case - -- STNil -> False - -- STPair a b -> containsTArr a || containsTArr b - -- STEither a b -> containsTArr a || containsTArr b - -- STArr{} -> True - -- STScal{} -> False - -- STAccum{} -> error "An accumulator in merge storage?" - ---------------------------- RETURN TRIPLE FROM CHAD --------------------------- |