From c1ed4b977b27df096fef5f8edbdd31b025199521 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= Date: Tue, 23 Aug 2022 17:48:11 +0200 Subject: [PATCH] Fix for punionWith argument-flipping, issue #556 --- Plutarch/Api/V1/AssocMap.hs | 56 ++++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/Plutarch/Api/V1/AssocMap.hs b/Plutarch/Api/V1/AssocMap.hs index c291927b9..2571c04f1 100644 --- a/Plutarch/Api/V1/AssocMap.hs +++ b/Plutarch/Api/V1/AssocMap.hs @@ -357,7 +357,7 @@ punionWith = phoistAcyclic $ data MapUnionCarrier k v s = MapUnionCarrier { merge :: Term s (PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v) - , mergeInsert :: Term s (PBuiltinPair (PAsData k) (PAsData v) :--> PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v) + , mergeInsert :: Term s (PBuiltinPair (PAsData k) (PAsData v) :--> PBuiltinPair (PAsData k) (PAsData v) :--> PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v) } deriving stock (Generic) deriving anyclass (PlutusType) @@ -371,33 +371,37 @@ mapUnionCarrier = phoistAcyclic $ plam \combine self -> MapUnionCarrier { merge = plam $ \xs ys -> pmatch xs $ \case PNil -> ys - PCons x xs' -> mergeInsert # x # xs' # ys - , mergeInsert = plam $ \x xs ys -> - pmatch ys $ \case - PNil -> pcons # x # xs - PCons y1 ys' -> - plet y1 $ \y -> - plet (pfstBuiltin # x) $ \xk -> - plet (pfstBuiltin # y) $ \yk -> - pif - (xk #== yk) - ( pcons - # (ppairDataBuiltin # xk #$ combine # (psndBuiltin # x) # (psndBuiltin # y)) - #$ merge - # xs - # ys' - ) - ( pif - (pfromData xk #< pfromData yk) - ( pcons - # x - # (mergeInsert # y # ys' # xs) + PCons x xs' -> pmatch ys $ \case + PNil -> xs + PCons y ys' -> mergeInsert # x # y # xs' # ys' + , mergeInsert = plam $ \x y xs ys -> + plet (pfstBuiltin # x) $ \xk -> + plet (pfstBuiltin # y) $ \yk -> + pif + (xk #== yk) + ( pcons + # (ppairDataBuiltin # xk #$ combine # (psndBuiltin # x) # (psndBuiltin # y)) + #$ merge + # xs + # ys + ) + ( pif + (pfromData xk #< pfromData yk) + ( pcons + # x + # ( pmatch xs $ \case + PNil -> pcons # y # ys + PCons x' xs' -> mergeInsert # x' # y # xs' # ys ) - ( pcons - # y - # (mergeInsert # x # xs # ys') + ) + ( pcons + # y + # ( pmatch ys $ \case + PNil -> pcons # x # xs + PCons y' ys' -> mergeInsert # x # y' # xs # ys' ) - ) + ) + ) } mapUnion :: forall k v s. (POrd k, PIsData k) => Term s ((PAsData v :--> PAsData v :--> PAsData v) :--> MapUnionCarrier k v)