Skip to content

Commit 3fd4e78

Browse files
fingolfinfingolfin
committed
WIP: FoldLeft, FoldLeftX
1 parent f30c1e4 commit 3fd4e78

File tree

6 files changed

+245
-1
lines changed

6 files changed

+245
-1
lines changed

‎lib/coll.gd‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2402,6 +2402,27 @@ DeclareOperation( "AsSSortedListNonstored", [IsListOrCollection] );
24022402
DeclareGlobalFunction( "Elements" );
24032403

24042404

2405+
#############################################################################
2406+
##
2407+
## TODO: document FoldLeft
2408+
##
2409+
DeclareGlobalFunction( "FoldLeft" );
2410+
2411+
2412+
#############################################################################
2413+
##
2414+
## TODO: document FoldLeftOp
2415+
##
2416+
DeclareOperation( "FoldLeftOp", [ IsListOrCollection, IsFunction ] );
2417+
2418+
2419+
#############################################################################
2420+
##
2421+
## TODO: document FoldLeftX
2422+
##
2423+
DeclareGlobalFunction( "FoldLeftX" );
2424+
2425+
24052426
#############################################################################
24062427
##
24072428
#F Sum( <list>[, <init>] ) . . . . . . . . . . sum of the elements of a list

‎lib/coll.gi‎

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1798,6 +1798,103 @@ InstallGlobalFunction( ListX, function ( arg )
17981798
end );
17991799

18001800

1801+
#############################################################################
1802+
##
1803+
#F FoldLeft( <coll>, <func> )
1804+
#F FoldLeft( <coll>, <func>, <init> )
1805+
##
1806+
InstallGlobalFunction( FoldLeft,
1807+
function( arg )
1808+
local tnum, C, func, result, i, l;
1809+
l := Length( arg );
1810+
if l < 2 or l > 3 or not IsFunction(arg[2]) then
1811+
Error( "usage: FoldLeft( <C>, <func>[, <init>] )" );
1812+
fi;
1813+
tnum:= TNUM_OBJ( arg[1] );
1814+
# handle built-in lists directly, to avoid method dispatch overhead
1815+
if FIRST_LIST_TNUM <= tnum and tnum <= LAST_LIST_TNUM then
1816+
C:= arg[1];
1817+
func:= arg[2];
1818+
if l = 2 then
1819+
if IsEmpty( C ) then
1820+
Error("folding an empty collection without initial value is not supported");
1821+
else
1822+
result:= C[1];
1823+
for i in [ 2 .. Length( C ) ] do
1824+
result:= func( result, C[i] );
1825+
od;
1826+
fi;
1827+
else
1828+
result:= arg[3];
1829+
for i in C do
1830+
result:= func( result, i );
1831+
od;
1832+
fi;
1833+
return result;
1834+
else
1835+
return CallFuncList( FoldLeftOp, arg );
1836+
fi;
1837+
end );
1838+
1839+
1840+
#############################################################################
1841+
##
1842+
#M FoldLeftOp( <C>, <func> ) . . . . . . . for a list/collection, and a function
1843+
##
1844+
InstallMethod( FoldLeftOp,
1845+
"for a list/collection, and a function",
1846+
[ IsListOrCollection, IsFunction ],
1847+
function ( C, func )
1848+
local iter, result, x;
1849+
iter := Iterator( C );
1850+
if IsDoneIterator( iter ) then
1851+
Error("folding an empty collection without initial value is not supported");
1852+
fi;
1853+
result := NextIterator( iter );
1854+
for x in iter do
1855+
result := func( result, x );
1856+
od;
1857+
return result;
1858+
end );
1859+
1860+
1861+
#############################################################################
1862+
##
1863+
#M FoldLeftOp( <C>, <func>, <init> ) . for a list/coll., a func., and init. val.
1864+
##
1865+
InstallOtherMethod( FoldLeftOp,
1866+
"for a list/collection, and a function, and an initial value",
1867+
[ IsListOrCollection, IsFunction, IsObject ],
1868+
function ( C, func, init )
1869+
local result, x;
1870+
result := init;
1871+
for x in C do
1872+
result := func( result, x );
1873+
od;
1874+
return result;
1875+
end );
1876+
1877+
1878+
#############################################################################
1879+
##
1880+
#M FoldLeftX(<obj>,...)
1881+
##
1882+
InstallGlobalFunction( FoldLeftX, function ( gens, f, init, extra... )
1883+
local abortValue;
1884+
1885+
if Length(extra) > 0 then
1886+
abortValue := extra[1];
1887+
else
1888+
# assign a globally unique bag: here, we take a new empty
1889+
# string, which is guaranteed to be different from any
1890+
# other string object
1891+
abortValue := "";
1892+
fi;
1893+
1894+
return FOLD_LEFT_X(gens, f, init, abortValue);
1895+
end );
1896+
1897+
18011898
#############################################################################
18021899
##
18031900
#M SetX(<obj>,...)

‎src/listfunc.c‎

Lines changed: 110 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,10 @@
2424
#include "permutat.h"
2525
#include "plist.h"
2626
#include "pperm.h"
27+
#include "precord.h"
28+
#include "records.h"
2729
#include "set.h"
30+
#include "stats.h"
2831
#include "stringobj.h"
2932
#include "sysfiles.h"
3033
#include "trans.h"
@@ -1523,6 +1526,112 @@ static Obj FuncLIST_WITH_IDENTICAL_ENTRIES(Obj self, Obj n, Obj obj)
15231526
return list;
15241527
}
15251528

1529+
1530+
static Obj FastCallFuncList(Obj func, Obj list)
1531+
{
1532+
switch (LEN_PLIST(list)) {
1533+
case 0:
1534+
return CALL_0ARGS(func);
1535+
case 1:
1536+
return CALL_1ARGS(func, ELM_PLIST(list, 1));
1537+
case 2:
1538+
return CALL_2ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2));
1539+
case 3:
1540+
return CALL_3ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
1541+
ELM_PLIST(list, 3));
1542+
case 4:
1543+
return CALL_4ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
1544+
ELM_PLIST(list, 3), ELM_PLIST(list, 4));
1545+
case 5:
1546+
return CALL_5ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
1547+
ELM_PLIST(list, 3), ELM_PLIST(list, 4),
1548+
ELM_PLIST(list, 5));
1549+
case 6:
1550+
return CALL_6ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
1551+
ELM_PLIST(list, 3), ELM_PLIST(list, 4),
1552+
ELM_PLIST(list, 5), ELM_PLIST(list, 6));
1553+
default:
1554+
return CALL_XARGS(func, list);
1555+
}
1556+
}
1557+
1558+
// TODO: document this a bit
1559+
static int FoldLeftXHelp(Obj gens,
1560+
Obj foldFunc,
1561+
Obj * acc,
1562+
Obj abortValue,
1563+
Obj args,
1564+
int genIndex,
1565+
int valIndex)
1566+
{
1567+
while (genIndex <= LEN_PLIST(gens)) {
1568+
Obj gen = ELM_PLIST(gens, genIndex);
1569+
if (IS_FUNC(gen))
1570+
gen = FastCallFuncList(gen, args);
1571+
if (gen == True)
1572+
genIndex++;
1573+
else if (gen == False)
1574+
return 0;
1575+
else if (IS_LIST(gen)) {
1576+
const int len = LEN_LIST(gen);
1577+
for (int i = 1; i <= len; i++) {
1578+
Obj elm = ELM_LIST(gen, i);
1579+
AssPlist(args, valIndex, elm);
1580+
if (FoldLeftXHelp(gens, foldFunc, acc, abortValue, args,
1581+
genIndex + 1, valIndex + 1))
1582+
return 1;
1583+
}
1584+
UNB_LIST(args, valIndex);
1585+
return 0;
1586+
}
1587+
else {
1588+
// get the iterator
1589+
Obj iter = CALL_1ARGS(ITERATOR, gen);
1590+
1591+
Obj nfun, dfun;
1592+
if (IS_PREC_OR_COMOBJ(iter) &&
1593+
CALL_1ARGS(STD_ITER, iter) == True) {
1594+
// this can avoid method selection overhead on iterator
1595+
dfun = ElmPRec(iter, RNamName("IsDoneIterator"));
1596+
nfun = ElmPRec(iter, RNamName("NextIterator"));
1597+
}
1598+
else {
1599+
dfun = IS_DONE_ITER;
1600+
nfun = NEXT_ITER;
1601+
}
1602+
1603+
// loop over the iterator
1604+
while (CALL_1ARGS(dfun, iter) == False) {
1605+
1606+
// get the element and assign it to the variable
1607+
Obj elm = CALL_1ARGS(nfun, iter);
1608+
1609+
AssPlist(args, valIndex, elm);
1610+
if (FoldLeftXHelp(gens, foldFunc, acc, abortValue, args,
1611+
genIndex + 1, valIndex + 1))
1612+
return 1;
1613+
}
1614+
UNB_LIST(args, valIndex);
1615+
return 0;
1616+
}
1617+
}
1618+
*acc = CALL_2ARGS(foldFunc, *acc, args);
1619+
return abortValue == *acc;
1620+
}
1621+
1622+
// TODO: document this a bit
1623+
Obj FuncFOLD_LEFT_X(Obj self, Obj gens, Obj foldFunc, Obj init, Obj abortValue)
1624+
{
1625+
if (!IS_PLIST(gens))
1626+
return Fail;
1627+
if (!IS_FUNC(foldFunc))
1628+
return Fail;
1629+
1630+
Obj args = NEW_PLIST(T_PLIST, LEN_PLIST(gens));
1631+
FoldLeftXHelp(gens, foldFunc, &init, abortValue, args, 1, 1);
1632+
return init;
1633+
}
1634+
15261635
/****************************************************************************
15271636
**
15281637
*F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
@@ -1574,6 +1683,7 @@ static StructGVarFunc GVarFuncs [] = {
15741683
GVAR_FUNC(COPY_LIST_ENTRIES, -1, "srclist,srcstart,srcinc,dstlist,dststart,dstinc,number"),
15751684
GVAR_FUNC(STRONGLY_CONNECTED_COMPONENTS_DIGRAPH, 1, "digraph"),
15761685
GVAR_FUNC(LIST_WITH_IDENTICAL_ENTRIES, 2, "n, obj"),
1686+
GVAR_FUNC(FOLD_LEFT_X, 4, "gens, foldFunc, init, abortValue"),
15771687
{ 0, 0, 0, 0, 0 }
15781688

15791689
};

‎src/stats.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -337,7 +337,7 @@ static UInt ExecIfElifElse(Stat stat)
337337
Obj ITERATOR;
338338
Obj IS_DONE_ITER;
339339
Obj NEXT_ITER;
340-
static Obj STD_ITER;
340+
Obj STD_ITER;
341341

342342
static ALWAYS_INLINE UInt ExecForHelper(Stat stat, UInt nr)
343343
{

‎src/stats.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -148,6 +148,7 @@ void ClearError(void);
148148
extern Obj ITERATOR;
149149
extern Obj IS_DONE_ITER;
150150
extern Obj NEXT_ITER;
151+
extern Obj STD_ITER;
151152

152153

153154
/****************************************************************************

‎tst/testinstall/coll.tst‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -315,6 +315,21 @@ gap> List(iter);
315315
gap> List(iter, x -> x+1);
316316
[ 43 ]
317317
318+
#############################################################################
319+
#
320+
# FoldLeft
321+
#
322+
gap> FoldLeft([1..10], \*) = Factorial(10);
323+
true
324+
gap> FoldLeft([1..10], \+) = Sum([1..10]);
325+
true
326+
gap> FoldLeft([1..10], \+, 5) = Sum([1..10], 5);
327+
true
328+
gap> FoldLeft([1..3], \-);
329+
-4
330+
gap> FoldLeft([1..3], \-, 0);
331+
-6
332+
318333
#############################################################################
319334
#
320335
# List

0 commit comments

Comments
 (0)