File: cache.gi

package info (click to toggle)
gap 4r10p0-7
  • links: PTS
  • area: main
  • in suites: buster
  • size: 47,392 kB
  • sloc: ansic: 118,475; xml: 54,089; sh: 4,112; perl: 1,654; makefile: 274
file content (69 lines) | stat: -rw-r--r-- 2,195 bytes parent folder | download
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
#############################################################################
##
#W  cache.gi                     GAP library                 Chris Jefferson
##
##
#Y  Copyright (C) 2017 University of St Andrews, Scotland
##
##  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);