"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 _DocDebug:=TRUE;
3
4 _GenerateDocSinAtom1:=
5 function(sinelt)
6 if IsList(sinelt) then
7 if IsBound(sinelt[1]) then
8 return(SPrint(sinelt[1]));
9 else
10 return "";
11 fi;
12 else
13 return(SPrint(sinelt));
14 fi;
15 end;
16 _GenerateDocSinAtom2:=
17 function(sinelt)
18 local gatm,atype,aname,aexpl,amiscrec,adefval;
19 gatm:=_GenerateDocSinAtom1(sinelt);
20
21 CheckArgs(sinelt,["atype","aname","aexpl","amiscrec"],[]);
22 atype:=__ARGREC.("atype");
23 aname:=__ARGREC.("aname");
24 aexpl:=__ARGREC.("aexpl");
25 amiscrec:=__ARGREC.("amiscrec");
26 adefval:=_GetEntry_rec_string(amiscrec,"Default",__FAILUREREC);
27
28 ## okay, we might have FAILURE as value, so ...
29 if not(IsSuccess(adefval)) and
30 _GetEntry_rec_string(amiscrec,"Default",rec(Fail:=SUCCESS))=SUCCESS then
31 Unbind(adefval);
32 fi;
33
34 if IsBound(adefval) then
35 return("<"+gatm+">"+" "+SPrint(aname)+": defaults to "+SPrint(adefval)+" ("+SPrint(aexpl)+")");
36 elif IsSuccess(aexpl) then
37 return("<"+gatm+">"+" "+SPrint(aname)+" ("+SPrint(aexpl)+")");
38 elif IsSuccess(aname) then
39 return("<"+gatm+">"+" "+SPrint(aname));
40 else
41 if gatm="" then
42 return "";
43 else
44 return("<"+gatm+">");
45 fi;
46 fi;
47 end;
48
49 _FlattenSin:=
50 function(sin)
51 local boundp1;
52 boundp1:=
53 function(atom)
54 if IsBound(atom[1]) then
55 return atom[1];
56 else
57 return void;
58 fi;
59 end;
60 return _Filtered_func_list(i->not(i=void),_Apply_func_list(boundp1,sin));
61 end;
62
63
64
65 ___GenerateDocSinSou:=
66 field->
67 (format_fun->
68 (separator->
69 (function(docrec)
70 local buf,i,gsinsou;
71 buf:="";
72 if IsBound(docrec.(field)) then
73 for i in [1.._Size_list(docrec.(field))-1] do
74 gsinsou:=format_fun(docrec.(field)[i]);
75 buf:=buf+gsinsou+separator;
76 od;
77 if _Size_list(docrec.(field))>0 then
78 gsinsou:=format_fun(docrec.(field)[_Size_list(docrec.(field))]);
79 buf:=buf+gsinsou;
80 fi;
81 return buf;
82 else
83 return "";
84 fi;
85 end)));
86
87 __GenerateDocSin:=___GenerateDocSinSou("sin");
88 _GenerateDocSin:=__GenerateDocSin(_GenerateDocSinAtom2)(", ");
89
90
91 _GenerateDocName:=docrec->docrec.name;
92
93
94 __GenerateDocSig:=
95 format_fun->
96 (separator->
97 function(docrec)
98 local gnam,gsin,opt;
99 gnam:=_GenerateDocName(docrec);
100 if docrec.kind="FUNCTION" then
101 gsin:=__GenerateDocSin(format_fun)(separator)(docrec);
102 if IsBound(docrec.opt) then
103 if gsin="" then
104 opt:="[optargs]";
105 else
106 opt:=" [, optargs]";
107 fi;
108 else
109 opt:="";
110 fi;
111 return(gnam+"("+gsin+opt+")");
112 elif docrec.kind="OPERATION" then
113 if IsBound(docrec.sin) then
114 gsin:=__GenerateDocSin(format_fun)(separator)(docrec);
115 return(_Mapconcat_func_list_string(i->format_fun(i),Butlast(docrec.sin)," ")+
116 " "+gnam+" "+format_fun(Last(docrec.sin)));
117 fi;
118 else
119 return(gnam);
120 fi;
121 end);
122 _GenerateDocSig:=__GenerateDocSig(_GenerateDocSinAtom2)(", ");
123
124 _GenerateDocSigH:=
125 function(docrec)
126 local gnam,gsin,opt;
127 gnam:=_GenerateDocName(docrec);
128 if IsBound(docrec.sin) then
129 gsin:=__GenerateDocSin(_GenerateDocSinAtom1)(",")(docrec);
130 return(gnam+"("+gsin+")");
131 else
132 return(gnam);
133 fi;
134 end;
135
136
137 __GenerateDocSou:=___GenerateDocSinSou("sou");
138 __GenerateDocSog:=
139 format_fun->
140 (prestring->
141 (separator->
142 function(docrec)
143 local gsin;
144 gsin:=__GenerateDocSou(format_fun)(separator)(docrec);
145 if gsin="" then
146 return "";
147 else
148 return(prestring+gsin);
149 fi;
150 end));
151 _GenerateDocSog:=__GenerateDocSog(_GenerateDocSinAtom2)(" -> ")(", ");
152 _GenerateDocSogH:=__GenerateDocSog(_GenerateDocSinAtom1)("")(",");
153
154
155 ___GenerateDocHash:=
156 docsig->Hex(Digest(docsig,"SHA1")){[1..6]};
157 __GenerateDocHash:=
158 docrec->___GenerateDocHash(_GenerateDocSigH(docrec));
159 _GenerateDocHash:=
160 function(docrec)
161 local dhash;
162 dhash:=__GenerateDocHash(docrec);
163 return(dhash);
164 end;
165 DocGenHashByString:=___GenerateDocHash;
166 DocGenHashByRecord:=__GenerateDocHash;
167 DocHash:=___GenerateDocHash;
168
169 ___GenerateDocSoghash:=
170 docsog->Hex(Digest(docsog,"SHA1")){[1..6]};
171 __GenerateDocSoghash:=
172 docrec->___GenerateDocSoghash(_GenerateDocSogH(docrec));
173 _GenerateDocSoghash:=
174 function(docrec)
175 local dhash;
176 dhash:=__GenerateDocSoghash(docrec);
177 return(dhash);
178 end;
179
180
181
182 ###
183 ### AUX FUNS
184 ###
185
186 IsUnique:=
187 function(dry,elt)
188 return not(elt in dry);
189 end;
190
191 IsDryByPredicate:=
192 function(dry,predfun)
193 return
194 function(predarg)
195 local D,status;
196 for D in dry do
197 if predfun(D)=predarg then
198 return false;
199 fi;
200 od;
201 return true;
202 end;
203 end;
204
205 _DryViolatingByPredicate_dry_func_rec:=
206 function(dry,predfun,optarg)
207 return
208 function(predarg)
209 local D,status;
210 for D in dry do
211 if predfun(D)=predarg then
212 return D;
213 fi;
214 od;
215 return _GetFailEntry(optarg);
216 end;
217 end;
218
219 ## add elt iff predfun(d)<>predarg for all d in dry
220 DryAddByPredicate:=
221 function(dry,predfun)
222 return
223 function(predarg,elt)
224 if IsDryByPredicate(dry,predfun)(predarg) then
225 DryAdd_(dry,elt);
226 fi;
227 end;
228 end;
229
230 DryReplaceByPredicate:=
231 function(dry,predfun)
232 return
233 function(predarg,elt)
234 local viol;
235 viol:=_DryViolatingByPredicate_dry_func_rec(dry,predfun,rec())(predarg);
236 if not(viol)=FAILURE and IsRec(viol) and not(viol=elt) and _DocDebug
237 and not(viol.name=elt.name) then
238 Print("## Hash Clash: #",viol.hash,": ");
239 #if IsBound(viol.kind) then Print(viol.kind+" "); fi;
240 if IsBound(viol.name) then Print(viol.name+" "); fi;
241 Print(" vs. ");
242 #if IsBound(elt.kind) then Print(elt.kind+" "); fi;
243 if IsBound(elt.name) then Print(elt.name+" "); fi;
244 Print("\n");
245 fi;
246 DryReplaceOrAdd_(dry,viol,elt);
247 end;
248 end;
249
250
251
252 ###
253 ### MAIN FUNS
254 ###
255
256 #############################################################################
257 ##
258 #F __DocumentationKinds
259 ##
260 __DocumentationKinds:=
261 ["FUNCTION", "CONSTANT", "TYPE", "STATEMENT", "KEYWORD", "OPERATION"];
262 __DocumentationMandatoryFieldsPerKind:=
263 [rec(
264 kind:="FUNCTION",
265 fields:=["kind","name","sin"]),
266 rec(
267 kind:="OPERATION",
268 fields:=["kind","name","sin"]),
269 rec(
270 kind:="CONSTANT",
271 fields:=["kind","name"]),
272 rec(
273 kind:="TYPE",
274 fields:=["kind","name"]),
275 rec(
276 kind:="STATEMENT",
277 fields:=["kind","name"]),
278 rec(
279 kind:="KEYWORD",
280 fields:=["kind","name"])];
281 __DocumentationOptionalFields:=
282 [["opt"],
283 ["short"],
284 ["ex"],
285 ["see"]];
286
287
288 _CheckDocSigAtom:=
289 function(sinatom)
290 if IsList(sinatom) then
291 if IsBound(sinatom[1]) then
292 if sinatom[1]=unknown then
293 return false;
294 fi;
295 fi;
296 else
297 if sinatom=unknown then
298 return false;
299 fi;
300 fi;
301 return true;
302 end;
303
304 _CheckDocSig:=
305 function(sig)
306 local s,status;
307 status:=true;
308 for s in sig do
309 status:=status and _CheckDocSigAtom(s);
310 od;
311 return status;
312 end;
313
314 __DocumentationTranslation:=
315 Alist(["$NAME","name"]);
316
317 #############################################################################
318 ##
319 #F CheckDocumentation( <record> )
320 ##
321 CheckDocumentation:=
322 function(docrec)
323 local status,i,err,kind,mandfields;
324
325 status:=true;
326
327 ## first check the kind
328 if IsBound(docrec.("kind")) then
329 kind:=docrec.("kind");
330 if Type(kind) <> string then
331 err := "Kind must be a string!";
332 Print(err,"\n");
333 return false;
334 fi;
335 else
336 err:="Kind is mandatory!";
337 Print(err,"\n");
338 return false;
339 fi;
340
341 ## now lookup the mandatory fields for this kind
342 mandfields:=_First_func_list(i->i.("kind")=kind,__DocumentationMandatoryFieldsPerKind,rec(Fail:=false));
343 if mandfields=false then
344 err:=("Unknown kind.");
345 Print(err,"\n");
346 return false;
347 else
348 mandfields:=mandfields.("fields");
349 fi;
350
351 ## first of all mandatory fields
352 for i in mandfields do
353 if not(IsBound(docrec.(i))) then
354 err:=("Rec field `"+i+"' is mandatory! :(");
355 Print(err,"\n");
356 status:=false;
357 fi;
358 od;
359
360 ## FUNCTIONs must not carry an unknown type
361 if IsBound(docrec.sin) then
362 status:=status and _CheckDocSig(docrec.sin);
363 fi;
364 if IsBound(docrec.sou) then
365 status:=status and _CheckDocSig(docrec.sou);
366 fi;
367
368 ## now go for translation
369 ## This seems evil, so doing at runtime is more promising
370 _MapAlist_func_alist(
371 function(key,val)
372 local qkey,tmp;
373 qkey:=Replace(key,"\\$","\\$");
374 tmp:=_GetEntry_rec_string(docrec,"short",rec(Fail:=FAILURE));
375 if IsSuccess(tmp) then
376 docrec.short:=Replace(tmp,qkey,
377 _GetEntry_rec_string(docrec,val,rec(Fail:="")));
378 fi;
379 end, __DocumentationTranslation);
380 _MapAlist_func_alist(
381 function(key,val)
382 local qkey,tmp;
383 qkey:=Replace(key,"\\$","\\$");
384 tmp:=_GetEntry_rec_string(docrec,"ex",rec(Fail:=""));
385 if IsSuccess(tmp) then
386 docrec.ex:=
387 _Apply_func_list(i->Replace(i,qkey,
388 _GetEntry_rec_string(docrec,val,rec(Fail:=""))),tmp);
389 fi;
390 end, __DocumentationTranslation);
391
392
393 ## now optional fields
394 #if IsBound(docrec.see) then
395 #fi;
396
397 return(true and status);
398 end;
399
400
401 #############################################################################
402 ##
403 #F BlowUpDocumentation( <record> )
404 ##
405 _BlowUpDocumentationHash:=
406 function(docrec)
407 if not(IsBound(docrec.hash)) then
408 docrec.hash:=_GenerateDocHash(docrec);
409 fi;
410 return(docrec);
411 end;
412 BlowUpDocumentation:=
413 function(docrec)
414 _BlowUpDocumentationHash(docrec);
415
416 ##blow up no matter what
417 docrec.sig:=_GenerateDocSig(docrec);
418 docrec.sog:=_GenerateDocSog(docrec);
419
420 ##blow up maybe
421 if not(IsBound(docrec.docsrc)) and IsBound(__CURRENT_LIB) then
422 docrec.docsrc:=__CURRENT_LIB;
423 fi;
424
425 ##blow up for debugging purposes
426 if _DocDebug then
427 if IsBound(docrec.sin) then
428 docrec.sinflat:=_FlattenSin(docrec.sin);
429 fi;
430 if IsBound(docrec.sou) then
431 docrec.souflat:=_FlattenSin(docrec.sou);
432 fi;
433
434 if not(IsBound(docrec.soghash)) then
435 docrec.soghash:=_GenerateDocSoghash(docrec);
436 fi;
437 if not(IsBound(docrec.sig4hash)) then
438 docrec.sig4hash:=_GenerateDocSigH(docrec);
439 fi;
440 fi;
441 return(docrec);
442 end;
443
444
445 #############################################################################
446 ##
447 #F RemoveDocumentation( <record> )
448 ##
449 RemoveDocumentation:=
450 function(docrec)
451 RemAssoc_(__DOC,docrec.hash);
452 end;
453
454
455 #############################################################################
456 ##
457 #F AddDocumentation( <record> )
458 ##
459 DocAddOnDryHash:=DryAddByPredicate(__DOC,i->i.hash);
460 ## rec(DefaultValues:=MergeRecords(__FAILUREREC,rec(ForceAdd:=FALSE,Success:=TRUE)))
461 InstallDocumentation:=
462 function(arg)
463 local docrec,optarg;
464
465 CheckArgs(arg,["docrec","optarg"],[,rec(Fail:=FAILURE,Success:=TRUE,ForceAdd:=FALSE)]);
466 docrec:=__ARGREC.("docrec");
467 optarg:=__ARGREC.("optarg");
468
469 if _USE_DOC_DUMP_P then
470 return _GetSuccessEntry(optarg);
471 fi;
472
473 if _GetEntry_rec_string(optarg,"ForceAdd",rec(Fail:=FALSE)) then
474 if CheckDocumentation(docrec) then
475 BlowUpDocumentation(docrec);
476 _PutAssoc__alist_any_any(__DOC,docrec.hash,docrec);
477 return true;
478 else
479 return _GetFailEntry(optarg);
480 fi;
481 else
482 if CheckDocumentation(docrec) then
483 BlowUpDocumentation(docrec);
484 if _Position_alist_any(__DOC,docrec.hash)=FAILURE then
485 _AddAssoc__alist_any_any(__DOC,docrec.hash,docrec);
486 return _GetSuccessEntry(optarg);
487 else
488 return _GetFailEntry(optarg);
489 fi;
490 else
491 return _GetFailEntry(optarg);
492 fi;
493 fi;
494 end;
495
496 MergeRecords2:=
497 function(target,source)
498 local rf,mergerec;
499 mergerec:=ShallowCopy(target);
500 if IsRec(source) and IsRec(mergerec) then
501 for rf in RecFields(source) do
502 mergerec.(rf):=source.(rf);
503 od;
504 return mergerec;
505 fi;
506 end;
507
508 MergeRecords:=
509 function(arg)
510 local rf,mergeprod;
511
512 if IsBound(arg[1]) and IsList(arg[1]) then
513 arg:=arg[1];
514 fi;
515
516 if _Size_list(arg)=1 then
517 return arg[1];
518 elif _Size_list(arg)>1 then
519 mergeprod:=MergeRecords2(MergeRecords(Butlast(arg)),Last(arg));
520 return mergeprod;
521 else
522 return VOID;
523 fi;
524 end;
525 AddDocumentation:=InstallDocumentation;
526
527 #############################################################################
528 ##
529 #F MergeDocumentation( <record> )
530 ##
531
532 MergeDocumentation:=
533 function(arg)
534 local hash,oldrec,newrec,docrec,optarg;
535
536 CheckArgs(arg,["docrec","optarg"],[,rec(Fail:=FAILURE,Success:=TRUE,Add:=FALSE)]);
537 docrec:=__ARGREC.("docrec");
538 optarg:=__ARGREC.("optarg");
539
540 if _USE_DOC_DUMP_P then
541 return _GetSuccessEntry(optarg);
542 fi;
543
544 if IsBound(docrec.hash) then
545 hash := _GetEntry_rec_string(docrec,"hash",rec(Fail:=""));
546 elif IsBound(docrec.sig4hash) then
547 hash := DocHash(docrec.sig4hash);
548 elif CheckDocumentation(docrec) then
549 MergeDocumentation(BlowUpDocumentation(docrec),optarg);
550 return _GetEntry_rec_string(optarg,"Success",rec(Fail:=FAILURE));
551 else
552 Print("## Cannot merge. "+
553 "Too few information given in order to merge sensibly.");
554 return _GetFailEntry(optarg);
555 fi;
556 oldrec:=Assoc(__DOC,hash);
557 if oldrec=FAILURE then
558 if _GetEntry_rec_string(optarg,"Add",rec(Fail:=FALSE)) then
559 InstallDocumentation(docrec,optarg);
560 else
561 ##no, this probably means the respective
562 ##doc entry is not in the dry anymore
563 return _GetFailEntry(optarg);
564 fi;
565 else
566 newrec:=MergeRecords(oldrec,docrec);
567 _PutAssoc__alist_any_any(__DOC,hash,BlowUpDocumentation(newrec));
568 fi;
569 return _GetEntry_rec_string(optarg,"Success",rec(Fail:=TRUE));
570 end;
571
572 #Print("InstallDocumentation profile: ");
573 #UTime();
574 #for i in [1..1000] do
575 # _AddDocumentation_rec(rec(kind:="FUNCTION",name:="TEST",sin:=[[record],[elt-alg^boo]],sou:=[[]]),rec());
576 #od;
577 #UTime();
578 #
579 #Print("MergeDocumentation profile: ");
580 #UTime();
581 #for i in [1..1000] do
582 # _MergeDocumentation_rec(rec(kind:="FUNCTION",name:="TEST",sin:=[[record],[elt-alg^boo]],sou:=[[]]),rec());
583 #od;
584 #UTime();