"Fossies" - the Fresh Open Source Software Archive 
As a special service "Fossies" has tried to format the requested text file into HTML format (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
1
2 _CallFunction := function(fun,args)
3
4 if _Size_list(args)=0 then
5 return fun();
6 fi;
7 if _Size_list(args)=1 then
8 return fun(args[1]);
9 fi;
10 if _Size_list(args)=2 then
11 return fun(args[1],args[2]);
12 fi;
13 if _Size_list(args)=3 then
14 return fun(args[1],args[2],args[3]);
15 fi;
16 if _Size_list(args)=4 then
17 return fun(args[1],args[2],args[3],args[4]);
18 fi;
19 if _Size_list(args)=5 then
20 return fun(args[1],args[2],args[3],args[4],args[5]);
21 fi;
22 if _Size_list(args)=6 then
23 return fun(args[1],args[2],args[3],args[4],args[5],args[6]);
24 fi;
25 if _Size_list(args)=7 then
26 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7]);
27 fi;
28 if _Size_list(args)=8 then
29 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8]);
30 fi;
31 if _Size_list(args)=9 then
32 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8],args[9]);
33 fi;
34 if _Size_list(args)=10 then
35 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8],args[9],args[10]);
36 fi;
37 if _Size_list(args)=11 then
38 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8],args[9],args[10],args[11]);
39 fi;
40 if _Size_list(args)=12 then
41 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8],args[9],args[10],args[11],args[12]);
42 fi;
43 if _Size_list(args)=13 then
44 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8],args[9],args[10],args[11],args[12],args[13]);
45 fi;
46 if _Size_list(args)=14 then
47 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8],args[9],args[10],args[11],args[12],args[13],args[14]);
48 fi;
49 if _Size_list(args)=15 then
50 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8],args[9],args[10],args[11],args[12],args[13],args[14],args[15]);
51 fi;
52 if _Size_list(args)=16 then
53 return fun(args[1],args[2],args[3],args[4],args[5],args[6],args[7],args[8],args[9],args[10],args[11],args[12],args[13],args[14],args[15],args[16]);
54 fi;
55 Error("too many arguments in call of method.");
56 end;
57
58
59
60 QPrint:=
61 function(atom)
62 if IsString(atom) then
63 return "\""+atom+"\"";
64 else
65 return Replace(Replace(SPrint(atom),"\n"," "),";$","");
66 fi;
67 end;
68
69
70 if not(IsBound(method)) then
71 NewType("method",0);
72 fi;
73
74 _DisplayMethod:=
75 hash->DisplayDocSig(RetrieveDocumentation(hash));
76 _DisplayMethodFuns:=
77 function(funs)
78 local hashdry;
79 hashdry:=Dry([]);
80 Mapc(
81 function(fun)
82 local hash,i;
83 hash:=_GetEntry_rec_string(fun,"hash",rec(Fail:=[]));
84 if Is(Type(hash),list) then
85 Mapc(i->DryAdd_(hashdry,i),hash);
86 else
87 DryAdd_(hashdry,hash);
88 fi;
89 end,
90 funs);
91 Mapc(_DisplayMethod,hashdry);
92 end;
93 _PrintMethod:=
94 function(meth)
95 local name;
96 name:=_GetEntry_rec_string(meth,"name",rec(Fail:=""));
97 Print("Method `",name,"', installed signatures:\n\n");
98 _DisplayMethodFuns(_GetEntry_rec_string(meth,"funs",rec(Fail:=[])));
99 end;
100
101 _EvalMethod:=
102 function(name,wrapper)
103 return
104 function(arg)
105 local art,oamatch,oahere,wrmatch,ret,args,wrrec,optargs,optargrec,defvals,i,lim,
106 _min_of_art_or,_min_of_art\-1_or;
107
108 _min_of_art_or:=
109 function(i)
110 if _Size_list(art)<_Size_list(_GetEntry_rec_string(i,"sin",rec(Fail:=[]))) then
111 return _Size_list(i.("sin"));
112 else
113 return _Size_list(art);
114 fi;
115 end;
116
117 _min_of_art\-1_or:=
118 function(i)
119 if _Size_list(art)-1<_Size_list(_GetEntry_rec_string(i,"sin",rec(Fail:=[]))) then
120 return _Size_list(i.("sin"));
121 else
122 return _Size_list(art)-1;
123 fi;
124 end;
125
126 ## first of all examine the arguments
127 art:=ShallowCopy(arg);
128 _Apply__func_list(Type,art);
129 ret:=VOID;
130 oahere:=FALSE;
131
132 if _Size_list(arg)=0 then
133 wrrec:=_First_list_func(wrapper,i->_Size_list(i.("sin"))=0,rec(Fail:=FAILURE));
134 wrmatch:=IsSuccess(wrrec);
135 else
136 wrrec:=
137 _First_list_func(wrapper,
138 i->_ForAll_func_list(
139 j->Is(_GetEntry_list_eor(art,j,rec(Fail:=void)),
140 _GetEntry_list_eor(
141 _GetEntry_rec_string(i,"sin",rec(Fail:=[])),
142 j,rec(Fail:=void))),
143 [1.._min_of_art_or(i)]),rec(Fail:=FAILURE));
144 wrmatch:=IsSuccess(wrrec);
145 fi;
146
147 ## last argument could be an optarg record
148 if not(wrmatch) and Type(Last(arg))=record then
149 wrrec:=
150 _First_list_func(wrapper,
151 i->_ForAll_func_list(
152 j->Is(_GetEntry_list_eor(Butlast(art),j,rec(Fail:=void)),
153 _GetEntry_list_eor(
154 _GetEntry_rec_string(i,"sin",rec(Fail:=[])),
155 j,rec(Fail:=void))),
156 [1.._min_of_art\-1_or(i)]),rec(Fail:=FAILURE));
157 wrmatch:=IsSuccess(wrrec);
158 oahere := wrmatch;
159 fi;
160
161 ## what's this case? :o
162 if not(wrmatch) then
163 wrrec:=_First_list_func(wrapper,i->i.("sin")[1]=unknown,rec(Fail:=FAILURE));
164 #wrmatch:=IsSuccess(FAILURE);
165 ## with this the fallthrough to formerly known functions works
166 wrmatch:=IsSuccess(wrrec);
167 fi;
168
169 if wrmatch then
170 optargs:=wrrec.("opt");
171 defvals:=wrrec.("DefaultValues");
172 if _Size_list(Flat(optargs))>0 then
173 oamatch:=1;
174 else
175 oamatch:=0;
176 fi;
177 if _Size_list(arg)<_Size_list(wrrec.sin)+oamatch then
178 ## apparently the optarg was omitted
179 if (_Size_list(RecFields(defvals)) > 0) then
180 ret := _CallFunction(wrrec,_Add_list_any(arg,defvals));
181 else
182 ret := _CallFunction(wrrec,arg);
183 fi;
184 elif oamatch>0 then
185 ## the last arg should contain optargs
186 optargrec:=Last(arg);
187 if Type(optargrec)=record then
188 arg:=_Add_list_any(Butlast(arg),MergeRecords(defvals,optargrec));
189 fi;
190 ret := _CallFunction(wrrec,arg);
191 else
192 ret := _CallFunction(wrrec,arg);
193 fi;
194
195 ## now handle the case when the function in wrrec does not support
196 ## optargs but this wrapper should handle them
197 if oahere and ret=FAILURE then
198 ret := _GetEntry_rec_string(Last(arg),"Fail",rec(Fail:=ret));
199 fi;
200
201 return ret;
202
203 else
204 Print("`"+name+"' called with ",art,", but only applicable as:\n\n");
205 _DisplayMethodFuns(wrapper);
206 Print("\n");
207 return VOID;
208 fi;
209 end;
210 end;
211
212 _Wrapper:=
213 function(name,wrapper)
214 return
215 rec(
216 base:=_EvalMethod(name,wrapper),
217 funs:=wrapper,
218 type:=method,
219 name:=name,
220 operations:=
221 rec(
222 Print:=_PrintMethod));
223 end;
224
225
226 #############################################################################
227 ##
228 #F InstallMethod( <record>, <func> )
229 ##
230 ## now behold this cruft of bootstrapping :)
231 _InstallMethod_rec_func_rec:=
232 function(docrec, func,optargs)
233 local drname,wr,wrrec,sin,opt,DefaultValues,WrapFormerFuns,pos,f,hash,former,typ,
234 ## Profile
235 stime,etime;
236
237 stime:=UTime();
238 ## check if we are installing a function
239 if not(IsBound(docrec.("kind"))) then
240 docrec.kind:="FUNCTION";
241 fi;
242 if not(IsBound(docrec.("sou"))) then
243 docrec.sou:=[[any]];
244 fi;
245 if not(docrec.kind="FUNCTION") then
246 return Error("InstallMethod may only be used to install functions.");
247 fi;
248
249 _BlowUpDocumentationHash(docrec);
250 f :=MergeDocumentation(docrec,rec(Fail:=FALSE,Success:=TRUE,Add:=TRUE));
251 if not(f) then
252 Print("MergeDocumentation failed.\nProceeding nervously ...\n");
253 fi;
254
255 ## check if we requested not to initialise former functions
256 WrapFormerFuns := _GetEntry_rec_string(optargs,"WrapFormerFuns",rec(Fail:=TRUE));
257
258 drname := docrec.name;
259 hash := docrec.hash;
260 if EvalString("IsBound(" + drname + ")") then
261 ## now check if the bound object is already a wrapper
262 typ:=Name(EvalString("Type(" +drname+")"));
263 if typ="method" then
264 wr := EvalString(drname+".funs");
265 elif typ="func" and WrapFormerFuns then
266 former := EvalString("Copy("+drname+")");
267 wr := VOID;
268 elif typ="func" and not(WrapFormerFuns) then
269 wr := VOID;
270 else
271 Unbind(drname);
272 wr := VOID;
273 fi;
274 else
275 wr := VOID;
276 typ := VOID;
277 fi;
278 f:=Copy(func);
279 if IsBound(docrec.sin) then
280 sin:=_FlattenSin(docrec.sin);
281 else
282 return Error("sin is mandatory");
283 fi;
284 ## now check if sin has `unknown' types in it
285 if _ForAny_func_list(i->i=unknown,sin) then
286 return Error("Must not use type `unknown' in sin.");
287 fi;
288
289 ## check if there's an optional arg
290 opt := _GetEntry_rec_string(docrec,"opt",rec(Fail:=[]));
291
292 ## now check the defaultvals
293 DefaultValues := _GetEntry_rec_string(optargs,"DefaultValues",rec(Fail:=rec()));
294
295 if wr=VOID then
296 ## create a new wrapper
297 wr:=[];
298 _Add__list_any(wr,rec(base:=f,sin:=sin,hash:=hash,opt:=opt,DefaultValues:=DefaultValues));
299 if typ="func" and WrapFormerFuns then
300 ## then, wrap former funs to some kinda fallback
301 ## Type is unknown since we do not know the signature
302 _Add__list_any(wr,rec(base:=former,sin:=[unknown],hash:=_Apply_func_list(j->j.hash,_Filtered_func_list(i->not(i.hash=hash),DocFindNamesCS(drname))),
303 opt:=opt,DefaultValues:=DefaultValues));
304 fi;
305 Bind(drname,_Wrapper(drname,wr));
306 else
307 ## we already have a wrapper
308 ## thus install the fun given
309 wrrec:=rec(base:=f,sin:=sin,hash:=hash,opt:=opt,DefaultValues:=DefaultValues);
310 opt:=optargs.Position;
311 if opt<0 then
312 opt:=_Size_list(wr)+opt;
313 fi;
314 if _Size_list(wrrec.("sin"))>0 then
315 if wrrec.("sin")[1]=nof(any) then
316 _Add__list_any(wr,wrrec);
317 else
318 Insert_(wr,wrrec,optargs.Position);
319 fi;
320 else
321 Insert_(wr,wrrec,optargs.Position);
322 fi;
323 Bind(drname,_Wrapper(drname,wr));
324 fi;
325 etime := UTime();
326 ##Print("\n",docrec.name,": ",etime-stime);
327 end;
328 _InstallMethod_rec_func:=
329 function(docrec, func)
330 _InstallMethod_rec_func_rec(docrec,func,rec(Position:=1));
331 end;
332 _InstallMethod_rec_func_rec(
333 rec(
334 kind:="FUNCTION",
335 name:="InstallMethod",
336 sin:=[[record,"docrec"],[func,"body"]],
337 opt:=[[elt-ord^rat,"Position","Default: 1, negative numbers are ..."]],
338 sou:=[[]],
339 short:="Install the function `body' to be executed when called with "+
340 "arguments as specified by `docrec'.sin.\n"+
341 "Note: `docrec' has to be a fully qualified documentation record, "+
342 "`MergeDocumentation' is called automatically.",
343 see:=[DocHash("MergeDocumentation(record)")]), _InstallMethod_rec_func_rec,
344 rec(DefaultValues:=rec(Position:=1)));