1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Chris Jefferson.
##
## Copyright of GAP belongs to its developers, whose names are too numerous
## to list here. Please refer to the COPYRIGHT file for details.
##
## SPDX-License-Identifier: GPL-2.0-or-later
##
## This file defines various types of caching data structures
##
## Note that this file is read very early in GAP's startup, so we cannot
## make MemoizePosIntFunction a method and use method dispatch, or other
## bits of nice GAP functionality.
##
InstallGlobalFunction(MemoizePosIntFunction,
function(func, extra...)
local boundvals, original, uniqueobj, options, r;
# This is an object which cannot exist anywhere else
uniqueobj := "";
options := rec(
defaults := [],
flush := true,
errorHandler := function(x)
ErrorNoReturn("<val> must be a positive integer");
end);
if LEN_LIST(extra) > 0 then
for r in REC_NAMES(extra[1]) do
if IsBound(options.(r)) then
options.(r) := extra[1].(r);
else
ErrorNoReturn("Invalid option: ", r);
fi;
od;
fi;
original := AtomicList(options.defaults);
boundvals := MakeWriteOnceAtomic(AtomicList(original));
if options.flush then
InstallMethod(FlushCaches, [],
function()
boundvals := MakeWriteOnceAtomic(AtomicList(original));
TryNextMethod();
end);
fi;
return function(val)
local v, boundcpy;
if not IsPosInt(val) then
return options.errorHandler(val);
fi;
# Make a copy of the reference to boundvals, in case the cache
# is flushed, which will causes boundvals to be bound to a new list.
boundcpy := boundvals;
v := GetWithDefault(boundcpy, val, uniqueobj);
if IsIdenticalObj(v, uniqueobj) then
# As the list is WriteOnceAtomic, if two threads call
# func(val) at the same time they will still return the
# same value (the first assigned to the list).
boundcpy[val] := func(val);
v := boundcpy[val];
fi;
return v;
end;
end);
InstallGlobalFunction(GET_FROM_SORTED_CACHE,
function(cache, key, maker)
local pos, val;
# Check whether this has been stored already.
atomic readonly cache do
pos:= POSITION_SORTED_LIST( cache[1], key );
if pos <= Length( cache[1] ) and cache[1][pos] = key then
return cache[2][ pos ];
fi;
od;
# Compute new value.
val := maker();
# Store the value. Need to recompute pos as the maker function may have
# changed the cache, eg. by recursively calling itself (resp. its "parent
# function", the one containing the call to GET_FROM_SORTED_CACHE)
atomic readwrite cache do
pos:= POSITION_SORTED_LIST( cache[1], key );
if pos <= Length( cache[1] ) and cache[1][pos] = key then
# oops, something else computed the value in the meantime;
# so use that instead
val:= cache[2][ pos ];
else
Add( cache[1], Immutable( key ), pos );
Add( cache[2], val, pos );
fi;
od;
# Return the value.
return val;
end);
|
