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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Steve Linton.
##
## 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 contains the implementations of the functions and operations
## relating to functions and function-calling which are not so basic
## that they need to be in function.g
##
InstallMethod( ViewString, "for a function", [IsFunction and IsInternalRep],
function(func)
local locks, nams, narg, i, isvarg, result;
result := "";
isvarg := false;
locks := LOCKS_FUNC(func);
if locks <> fail then
Append(result, "atomic ");
fi;
Append(result, "function( ");
nams := NAMS_FUNC(func);
narg := NARG_FUNC(func);
if narg < 0 then
isvarg := true;
narg := -narg;
fi;
if narg <> 0 then
if nams = fail then
Append(result, STRINGIFY("<",narg," unnamed arguments>"));
else
if locks <> fail then
if locks[1] = '\001' then
Append(result, "readonly ");
elif locks[1] = '\002' then
Append(result, "readwrite ");
fi;
fi;
Append(result, nams[1]);
for i in [2..narg] do
if locks <> fail then
if locks[i] = '\001' then
Append(result, "readonly ");
elif locks[i] = '\002' then
Append(result, "readwrite ");
fi;
fi;
Append(result, STRINGIFY(", ",nams[i]));
od;
fi;
if isvarg then
Append(result, "...");
fi;
fi;
Append(result, " ) ... end");
return result;
end);
InstallMethod(Display, "for a function", [IsFunction and IsInternalRep],
function(fun)
local loc;
loc := FilenameFunc(fun);
if loc <> fail and loc <> "stream" and loc <> "*stdin*" and loc <> "*errin*" then
loc := LocationFunc(fun);
if loc <> fail then
Print("# ", loc, "\n");
fi;
fi;
Print(fun, "\n");
end);
InstallMethod(DisplayString, "for a function, using string stream", [IsFunction and IsInternalRep],
function(fun)
local s, stream;
s := "";
stream := OutputTextString(s, true);
PrintTo(stream, fun);
CloseStream(stream);
Add(s, '\n');
return MakeImmutable(s);
end);
InstallMethod(String, "for a function, with whitespace reduced", [IsFunction and IsInternalRep],
function(fun)
local s, stream;
s := "";
stream := OutputTextString(s, true);
SetPrintFormattingStatus(stream, false);
PrintTo(stream, fun);
CloseStream(stream);
return ReplacedString(s, "\n", " ");
end);
BIND_GLOBAL( "VIEW_STRING_OPERATION",
function ( op )
return STRINGIFY("<", TypeOfOperation(op),
" \"", NAME_FUNC(op), "\">");
end);
BIND_GLOBAL( "PRINT_OPERATION",
function ( op )
Print(VIEW_STRING_OPERATION(op));
end);
InstallMethod( ViewObj,
"for an operation",
[ IsOperation ],
PRINT_OPERATION );
InstallMethod( ViewString,
"for an operation",
[ IsOperation ],
function(op)
return VIEW_STRING_OPERATION(op);
end);
InstallMethod( SetNameFunction, [IsFunction and IsInternalRep, IS_STRING], SET_NAME_FUNC );
BIND_GLOBAL( "BindingsOfClosure",
function(f)
local x, r, i;
x := ENVI_FUNC(f);
if x = fail then return fail; fi;
r := rec();
while x <> GetBottomLVars() do
x := ContentsLVars(x);
if x = false then break; fi;
for i in [1..Length(x.names)] do
# respect the lookup order
if not IsBound(r.(x.names[i])) then
r.(x.names[i]) := x.values[i];
fi;
od;
x := ENVI_FUNC(x.func);
od;
return r;
end);
|
