From 534241d59a44193f80e31ae3a8341580d9cb57f3 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 30 Jun 2026 18:43:43 -0700 Subject: [PATCH] Add Functor/Traversable/Foldable instances for UAList (#984) --- src/Libraries/Base3-Misc/UnitAppendList.bsv | 52 ++++++++++++++++----- 1 file changed, 41 insertions(+), 11 deletions(-) diff --git a/src/Libraries/Base3-Misc/UnitAppendList.bsv b/src/Libraries/Base3-Misc/UnitAppendList.bsv index 63895f452..b7ca36b0e 100644 --- a/src/Libraries/Base3-Misc/UnitAppendList.bsv +++ b/src/Libraries/Base3-Misc/UnitAppendList.bsv @@ -1,5 +1,8 @@ package UnitAppendList; +import Foldable::*; +import Traversable::*; + typedef union tagged { void NoItems; a One; @@ -22,18 +25,19 @@ endfunction: flatten0 function List#(a) flatten(UAList#(a) c) = flatten0(c, Nil); +// Append two lists, treating NoItems as the identity so the result never +// contains a redundant empty branch. +function UAList#(a) uaAppend(UAList#(a) c1, UAList#(a) c2) = + c1 matches tagged NoItems ? c2 : + c2 matches tagged NoItems ? c1 : + tagged Append tuple2(c1, c2); + + function UAList#(b) uaMap(function b f(a x), UAList#(a) c); case (c) matches tagged NoItems: return tagged NoItems; tagged One .x: return tagged One (f(x)); - tagged Append {.c1,.c2}: - begin - let r1 = uaMap(f, c1); - let r2 = uaMap(f, c2); - return (r1 matches tagged NoItems ? r2 : - r2 matches tagged NoItems ? r1 : - tagged Append tuple2(r1, r2)); - end + tagged Append {.c1,.c2}: return uaAppend(uaMap(f, c1), uaMap(f, c2)); endcase endfunction: uaMap @@ -50,11 +54,37 @@ module uaMapM#(function module#(b) f(a x), UAList#(a) c)(UAList#(b)); begin let r1 <- uaMapM(f, c1); let r2 <- uaMapM(f, c2); - return (r1 matches tagged NoItems ? r2 : - r2 matches tagged NoItems ? r1 : - tagged Append tuple2(r1, r2)); + return uaAppend(r1, r2); end endcase endmodule: uaMapM + +instance Functor#(UAList); + function fmap = uaMap; +endinstance + +instance Foldable#(UAList); + function b foldr(function b f(a x, b z), b z, UAList#(a) c); + case (c) matches + tagged NoItems: return z; + tagged One .x: return f(x, z); + tagged Append {.c1,.c2}: return foldr(f, foldr(f, z, c2), c1); + endcase + endfunction + function toList = flatten; +endinstance + +instance Traversable#(UAList); + function f#(UAList#(b)) traverse(function f#(b) func(a x), UAList#(a) c) + provisos (Applicative#(f)); + case (c) matches + tagged NoItems: return \pure (tagged NoItems); + tagged One .x: return fmap(One, func(x)); + tagged Append {.c1,.c2}: + return liftA2(uaAppend, traverse(func, c1), traverse(func, c2)); + endcase + endfunction +endinstance + endpackage