1############################################################################# 2## 3## This file is part of GAP, a system for computational discrete algebra. 4## This file's authors include Thomas Breuer, Frank Celler, Martin Schönert. 5## 6## Copyright of GAP belongs to its developers, whose names are too numerous 7## to list here. Please refer to the COPYRIGHT file for details. 8## 9## SPDX-License-Identifier: GPL-2.0-or-later 10## 11## This file defines operations and such. Some functions have moved 12## to oper1.g so as to be compiled in the default kernel 13## 14 15 16INSTALL_METHOD := false; 17 18 19############################################################################# 20## 21#F INFO_DEBUG( <level>, ... ) 22## 23## <ManSection> 24## <Func Name="INFO_DEBUG" Arg='level, ...'/> 25## 26## <Description> 27## This will delegate to the proper info class <C>InfoDebug</C> 28## as soon as the info classes are available. 29## </Description> 30## </ManSection> 31## 32BIND_GLOBAL( "INFO_DEBUG", function( arg ) 33 Print( "#I " ); 34 CALL_FUNC_LIST( Print, arg{ [ 2 .. LEN_LIST( arg ) ] } ); 35end ); 36 37 38############################################################################# 39## 40#V CATS_AND_REPS 41## 42## <ManSection> 43## <Var Name="CATS_AND_REPS"/> 44## 45## <Description> 46## a list of filter numbers of categories and representations 47## </Description> 48## </ManSection> 49## 50BIND_GLOBAL( "CATS_AND_REPS", [] ); 51if IsHPCGAP then 52 ShareSpecialObj(CATS_AND_REPS); 53fi; 54 55 56############################################################################# 57## 58#V IMMEDIATES 59## 60## <ManSection> 61## <Var Name="IMMEDIATES"/> 62## 63## <Description> 64## is a list that contains at position <M>i</M> the description of all those 65## immediate methods for which <C>FILTERS</C><M>[i]</M> belongs to the 66## requirements. 67## <P/> 68## So each entry of <C>IMMEDIATES</C> is a zipped list, where 6 consecutive 69## positions are ..., and the position of the method itself in the list 70## <C>IMMEDIATE_METHODS</C>. 71## <P/> 72## Note: 73## 1. If a method requires two filters <M>F_1</M> and <M>F_2</M> such that 74## <M>F_1</M> implies <M>F_2</M>, 75## it will <E>not</E> be installed for <M>F_2</M>. 76## 2. If not all requirements are categories/representations then 77## the category/representation part of the requirements will be ignored; 78## <!-- and if only cats are required? Does this make sense?--> 79## <!-- and what about representations that may change?--> 80## in other words, the only information that may cause to run immediate 81## methods is acquired information. 82## </Description> 83## </ManSection> 84## 85if IsHPCGAP then 86 BIND_GLOBAL( "IMMEDIATES", AtomicList([]) ); 87else 88 BIND_GLOBAL( "IMMEDIATES", [] ); 89fi; 90 91 92############################################################################# 93## 94#V IMMEDIATE_METHODS 95## 96## <ManSection> 97## <Var Name="IMMEDIATE_METHODS"/> 98## 99## <Description> 100## is a list of functions that are installed as immediate methods. 101## </Description> 102## </ManSection> 103## 104if IsHPCGAP then 105 BIND_GLOBAL( "IMMEDIATE_METHODS", AtomicList([]) ); 106else 107 BIND_GLOBAL( "IMMEDIATE_METHODS", [] ); 108fi; 109 110 111############################################################################# 112## 113#V OPERATIONS 114## 115## <ManSection> 116## <Var Name="OPERATIONS"/> 117## 118## <Description> 119## is a list that stores all &GAP; operations at the odd positions, 120## and the corresponding list of requirements at the even positions. 121## More precisely, if the operation <C>OPERATIONS[<A>n</A>]</C> has been declared 122## by several calls of <C>DeclareOperation</C>, 123## with second arguments <A>req1</A>, <A>req2</A>, \ldots, 124## each being a list of filters, then <C>OPERATIONS[ <A>n</A>+1 ]</C> is the list 125## <C>[</C> <A>flags1</A>, <A>flags2</A>, <M>\ldots</M>, <C>]</C>, 126## where <A>flagsi</A> is the list of flags of the filters in <A>reqi</A>. 127## </Description> 128## </ManSection> 129## 130if IsHPCGAP then 131 OPERATIONS_REGION := ShareSpecialObj("OPERATIONS_REGION"); # FIXME: remove 132 BIND_GLOBAL( "OPERATIONS", MakeStrictWriteOnceAtomic( [] ) ); 133 BIND_GLOBAL( "OPER_FLAGS", MakeStrictWriteOnceAtomic( rec() ) ); 134else 135 BIND_GLOBAL( "OPERATIONS", [] ); 136 BIND_GLOBAL( "OPER_FLAGS", rec() ); 137fi; 138BIND_GLOBAL( "STORE_OPER_FLAGS", 139function(oper, flags) 140 local nr, info; 141 nr := MASTER_POINTER_NUMBER(oper); 142 if not IsBound(OPER_FLAGS.(nr)) then 143 # we need a back link to oper for the post-restore function 144 if IsHPCGAP then 145 OPER_FLAGS.(nr) := FixedAtomicList([oper, 146 MakeWriteOnceAtomic([]), MakeWriteOnceAtomic([])]); 147 else 148 OPER_FLAGS.(nr) := [oper, [], []]; 149 fi; 150 ADD_LIST(OPERATIONS, oper); 151 fi; 152 info := OPER_FLAGS.(nr); 153 ADD_LIST(info[2], MakeImmutable(flags)); 154 ADD_LIST(info[3], MakeImmutable([INPUT_FILENAME(), READEVALCOMMAND_LINENUMBER, INPUT_LINENUMBER()])); 155end); 156 157BIND_GLOBAL( "GET_OPER_FLAGS", function(oper) 158 local nr; 159 nr := MASTER_POINTER_NUMBER(oper); 160 if not IsBound(OPER_FLAGS.(nr)) then 161 return fail; 162 fi; 163 return OPER_FLAGS.(nr)[2]; 164end); 165BIND_GLOBAL( "GET_DECLARATION_LOCATIONS", function(oper) 166 local nr; 167 nr := MASTER_POINTER_NUMBER(oper); 168 if not IsBound(OPER_FLAGS.(nr)) then 169 return fail; 170 fi; 171 return OPER_FLAGS.(nr)[3]; 172end); 173 174# the object handles change after loading a workspace 175ADD_LIST(GAPInfo.PostRestoreFuncs, function() 176 local tmp, a; 177 tmp := []; 178 for a in REC_NAMES(OPER_FLAGS) do 179 ADD_LIST(tmp, OPER_FLAGS.(a)); 180 Unbind(OPER_FLAGS.(a)); 181 od; 182 for a in tmp do 183 OPER_FLAGS.(MASTER_POINTER_NUMBER(a[1])) := a; 184 od; 185end); 186 187############################################################################# 188## 189#V WRAPPER_OPERATIONS 190## 191## <ManSection> 192## <Var Name="WRAPPER_OPERATIONS"/> 193## 194## <Description> 195## is a list that stores all those &GAP; operations for which the default 196## method is to call a related operation if necessary, 197## and to store and look up the result using an attribute. 198## An example is <C>SylowSubgroup</C>, which calls <C>SylowSubgroupOp</C> if the 199## required Sylow subgroup is not yet stored in <C>ComputedSylowSubgroups</C>. 200## </Description> 201## </ManSection> 202## 203BIND_GLOBAL( "WRAPPER_OPERATIONS", [] ); 204if IsHPCGAP then 205 LockAndMigrateObj( WRAPPER_OPERATIONS, OPERATIONS_REGION); 206fi; 207 208 209############################################################################# 210## 211#F IsNoImmediateMethodsObject(<obj>) 212## 213## <ManSection> 214## <Func Name="IsNoImmediateMethodsObject" Arg='obj'/> 215## 216## <Description> 217## If this filter is set immediate methods will be ignored for <A>obj</A>. This 218## can be crucial for performance for objects like PCGS, of which many are 219## created, which are collections, but for which all those immediate 220## methods for <C>IsTrivial</C> et cetera do not really make sense. 221## </Description> 222## </ManSection> 223## 224BIND_GLOBAL("IsNoImmediateMethodsObject", 225 NewFilter("IsNoImmediateMethodsObject")); 226 227 228############################################################################# 229## 230#V IGNORE_IMMEDIATE_METHODS 231## 232## <ManSection> 233## <Var Name="IGNORE_IMMEDIATE_METHODS"/> 234## 235## <Description> 236## is usually <K>false</K>. 237## Only inside a call of <C>RunImmediateMethods</C> it is set to 238## <K>true</K>, 239## which causes that <C>RunImmediateMethods</C> does not suffer 240## from recursion. 241## </Description> 242## </ManSection> 243## 244IGNORE_IMMEDIATE_METHODS := false; 245 246 247############################################################################# 248## 249#F INSTALL_IMMEDIATE_METHOD( <oper>, <info>, <filter>, <rank>, <method> ) 250## 251## <ManSection> 252## <Func Name="INSTALL_IMMEDIATE_METHOD" Arg='oper, info, filter, rank, method'/> 253## 254## <Description> 255## </Description> 256## </ManSection> 257## 258BIND_CONSTANT("SIZE_IMMEDIATE_METHOD_ENTRY", 8); 259BIND_GLOBAL( "INSTALL_IMMEDIATE_METHOD", 260 function( oper, info, filter, rank, method ) 261 262 local flags, 263 relev, 264 i, 265 rflags, 266 wif, 267 ignore, 268 j, 269 k, 270 replace, 271 pos, 272 imm; 273 274 # Check whether <oper> really is an operation. 275 if not IS_OPERATION(oper) then 276 Error( "<oper> is not an operation" ); 277 fi; 278 279 # Check whether this in fact installs an implication. 280 if FLAGS_FILTER(oper) <> false 281 and (method = true or method = RETURN_TRUE) 282 then 283 Error( "use `InstallTrueMethod' for <oper>" ); 284 fi; 285 286 # Find the requirements. 287 flags := TRUES_FLAGS( FLAGS_FILTER( filter ) ); 288 if LEN_LIST( flags ) = 0 then 289 Error( "no immediate methods without requirements!" ); 290 elif FLAG1_FILTER( IS_MUTABLE_OBJ ) in flags then 291 Error( "no immediate methods for mutable objects!" ); 292 fi; 293 relev := []; 294 atomic FILTER_REGION do 295 296 for i in flags do 297 if not INFO_FILTERS[i] in FNUM_CATS_AND_REPS then 298 ADD_LIST( relev, i ); 299 fi; 300 od; 301 302 # All requirements are categories/representations. 303 # Install the method for one of them. 304 if LEN_LIST( relev ) = 0 then 305 relev:= [ flags[1] ]; 306 fi; 307 flags:= relev; 308 309 # Remove requirements that are implied by the remaining ones. 310 # (Note that it is possible to have implications from a filter 311 # to another one with a bigger number.) 312 relev := []; 313 rflags := []; 314 for i in flags do 315 316 # Get the implications of this filter. 317 wif:= WITH_IMPS_FLAGS( FLAGS_FILTER( FILTERS[i] ) ); 318 319 # If the filter is implied by one in `relev', ignore it. 320 # Otherwise add it to `relev', and remove all those that 321 # are implied by the new filter. 322 ignore:= false; 323 for j in [ 1 .. LEN_LIST( relev ) ] do 324 if IsBound( rflags[j] ) then 325 if IS_SUBSET_FLAGS( rflags[j], wif ) then 326 327 # `FILTERS[i]' is implied by one in `relev'. 328 ignore:= true; 329 break; 330 elif IS_SUBSET_FLAGS( wif, rflags[j] ) then 331 332 # `FILTERS[i]' implies one in `relev'. 333 Unbind( relev[j] ); 334 Unbind( rflags[j] ); 335 fi; 336 fi; 337 od; 338 if not ignore then 339 ADD_LIST( relev, i ); 340 ADD_LIST( rflags, wif ); 341 fi; 342 od; 343 344 # We install the method for the requirements in `relev'. 345 if IsHPCGAP then 346 # 'pos' is saved for modifying 'imm' below. 347 pos:=AddAtomicList( IMMEDIATE_METHODS, method ); 348 else 349 ADD_LIST( IMMEDIATE_METHODS, method ); 350 pos := LEN_LIST( IMMEDIATE_METHODS ); 351 fi; 352 353 for j in relev do 354 355 # adjust `IMM_FLAGS' 356 IMM_FLAGS:= SUB_FLAGS( IMM_FLAGS, FLAGS_FILTER( FILTERS[j] ) ); 357#T here it would be better to subtract a flag list 358#T with `true' exactly at position `j'! 359#T means: When an immed. method gets installed for a property then 360#T the property tester should remain in IMM_FLAGS. 361#T (This would make an if statement in `RunImmediateMethods' unnecessary!) 362 363 # Find the place to put the new method. 364 if not IsHPCGAP then 365 if IsBound( IMMEDIATES[j] ) then 366 imm := IMMEDIATES[j]; 367 else 368 imm := []; 369 IMMEDIATES[j] := imm; 370 fi; 371 else 372 if IsBound( IMMEDIATES[j] ) then 373 imm := SHALLOW_COPY_OBJ(IMMEDIATES[j]); 374 else 375 imm := []; 376 fi; 377 fi; 378 i := 0; 379 while i < LEN_LIST(imm) and rank < imm[i+5] do 380 i := i + SIZE_IMMEDIATE_METHOD_ENTRY; 381 od; 382 383 # Now is a good time to see if the method is already there 384 if REREADING then 385 replace := false; 386 k := i; 387 while k < LEN_LIST(imm) and rank = imm[k+5] do 388 if info = imm[k+7] and oper = imm[k+1] and 389 FLAGS_FILTER( filter ) = imm[k+4] then 390 replace := true; 391 i := k; 392 break; 393 fi; 394 k := k+SIZE_IMMEDIATE_METHOD_ENTRY; 395 od; 396 fi; 397 398 # push the other functions back 399 if not REREADING or not replace then 400 imm{[SIZE_IMMEDIATE_METHOD_ENTRY+i+1..SIZE_IMMEDIATE_METHOD_ENTRY+LEN_LIST(imm)]} := imm{[i+1..LEN_LIST(imm)]}; 401 fi; 402 403 # install the new method 404 imm[i+1] := oper; 405 imm[i+2] := SETTER_FILTER( oper ); 406 imm[i+3] := FLAGS_FILTER( TESTER_FILTER( oper ) ); 407 imm[i+4] := FLAGS_FILTER( filter ); 408 imm[i+5] := rank; 409 imm[i+6] := pos; 410 imm[i+7] := IMMUTABLE_COPY_OBJ(info); 411 if SIZE_IMMEDIATE_METHOD_ENTRY >= 8 then 412 imm[i+8] := MakeImmutable([INPUT_FILENAME(), READEVALCOMMAND_LINENUMBER, INPUT_LINENUMBER()]); 413 fi; 414 415 if IsHPCGAP then 416 IMMEDIATES[j]:=MakeImmutable(imm); 417 fi; 418 od; 419 od; 420 421end ); 422 423 424############################################################################# 425## 426#F InstallImmediateMethod( <opr>[, <info>], <filter>[, <rank>], <method> ) 427## 428## <#GAPDoc Label="InstallImmediateMethod"> 429## <ManSection> 430## <Func Name="InstallImmediateMethod" 431## Arg='opr[, info], filter, rank, method'/> 432## 433## <Description> 434## <Ref Func="InstallImmediateMethod"/> installs <A>method</A> as an 435## immediate method for <A>opr</A>, which must be an attribute or a 436## property, with requirement <A>filter</A> and rank <A>rank</A> 437## (the rank can be omitted, in which case 0 is used as rank). 438## The rank must be an integer value that measures the priority of 439## <A>method</A> among the immediate methods for <A>opr</A>. 440## If supplied, <A>info</A> should be a short but informative string 441## that describes the situation in which the method is called. 442## <P/> 443## An immediate method is called automatically as soon as the object lies 444## in <A>filter</A>, provided that the value is not yet known. 445## Afterwards the attribute setter is called in order to store the value, 446## unless the method exits via <Ref Func="TryNextMethod"/>. 447## <P/> 448## Note the difference to <Ref Func="InstallMethod"/> 449## that no family predicate occurs 450## because <A>opr</A> expects only one argument, 451## and that <A>filter</A> is not a list of requirements but the argument 452## requirement itself. 453## <P/> 454## Immediate methods are thought of as a possibility for objects to gain 455## useful knowledge. 456## They must not be used to force the storing of <Q>defining information</Q> 457## in an object. 458## In other words, &GAP; should work even if all immediate methods are 459## completely disabled. 460## Therefore, the call to <Ref Func="InstallImmediateMethod"/> installs 461## <A>method</A> also as an ordinary method for <A>opr</A> 462## with requirement <A>filter</A>. 463## <P/> 464## Note that in such a case &GAP; executes a computation for which 465## it was not explicitly asked by the user. 466## So one should install only those methods as immediate methods 467## that are <E>extremely cheap</E>. 468## To emphasize this, 469## immediate methods are also called <E>zero cost methods</E>. 470## The time for their execution should really be approximately zero. 471## <P/> 472## For example, the size of a permutation group can be computed very cheaply 473## if a stabilizer chain of the group is known. 474## So it is reasonable to install an immediate method for 475## <Ref Attr="Size"/> with requirement 476## <C>IsGroup and Tester( <A>stab</A> )</C>, 477## where <A>stab</A> is the attribute corresponding to the stabilizer chain. 478## <P/> 479## Another example would be the implementation of the conclusion that 480## every finite group of prime power order is nilpotent. 481## This could be done by installing an immediate method for the attribute 482## <Ref Prop="IsNilpotentGroup"/> with requirement 483## <C>IsGroup and Tester( Size )</C>. 484## This method would then check whether the size is a finite prime power, 485## return <K>true</K> in this case and otherwise call 486## <Ref Func="TryNextMethod"/>. 487## But this requires factoring of an integer, 488## which cannot be guaranteed to be very cheap, 489## so one should not install this method as an immediate method. 490## </Description> 491## </ManSection> 492## <#/GAPDoc> 493## 494BIND_GLOBAL( "InstallImmediateMethod", function( arg ) 495 local pos, opr, info, filter, rank, method; 496 497 pos := 1; 498 499 if pos <= LEN_LIST( arg ) and IS_OPERATION( arg[pos] ) then 500 opr := arg[pos]; 501 pos := pos + 1; 502 else 503 pos := -1; 504 fi; 505 506 if pos <= LEN_LIST( arg ) and IS_STRING( arg[pos] ) then 507 info := arg[pos]; 508 pos := pos + 1; 509 else 510 info := false; 511 fi; 512 513 if pos <= LEN_LIST( arg ) and IsFilter( arg[pos] ) then 514 filter := arg[pos]; 515 pos := pos + 1; 516 else 517 pos := -1; 518 fi; 519 520 if pos <= LEN_LIST( arg ) and IS_RAT( arg[pos] ) then 521 rank := arg[pos]; 522 pos := pos + 1; 523 else 524 rank := 0; 525 fi; 526 527 if pos <= LEN_LIST( arg ) and IS_FUNCTION( arg[pos] ) then 528 method := arg[pos]; 529 pos := pos + 1; 530 else 531 pos := -1; 532 fi; 533 534 if pos = LEN_LIST( arg ) + 1 then 535 INSTALL_IMMEDIATE_METHOD( opr, info, filter, rank, method ); 536 INSTALL_METHOD( [ opr, info, [ filter ], method ], false ); 537 else 538 Error("usage: InstallImmediateMethod( <opr>[, <info>], <filter>, <rank>, <method> )"); 539 fi; 540 541end ); 542 543 544############################################################################# 545## 546#F TraceImmediateMethods( <flag> ) 547## 548## <#GAPDoc Label="TraceImmediateMethods"> 549## <ManSection> 550## <Func Name="TraceImmediateMethods" Arg='[flag]'/> 551## <Func Name="UntraceImmediateMethods" Arg=''/> 552## 553## <Description> 554## <Ref Func="TraceImmediateMethods"/> enables tracing for all immediate methods 555## if <A>flag</A> is either <K>true</K>, or not present. 556## <Ref Func="UntraceImmediateMethods"/>, or <Ref Func="TraceImmediateMethods"/> 557## with <A>flag</A> equal <K>false</K> turns tracing off. 558## (There is no facility to trace <E>specific</E> immediate methods.) 559## <Log><![CDATA[ 560## gap> TraceImmediateMethods( ); 561## gap> g:= Group( (1,2,3), (1,2) );; 562## #I RunImmediateMethods 563## #I immediate: Size 564## #I immediate: IsCyclic 565## #I immediate: IsCommutative 566## #I immediate: IsTrivial 567## gap> Size( g ); 568## #I immediate: IsPerfectGroup 569## #I immediate: IsNonTrivial 570## #I immediate: Size 571## #I immediate: IsFreeAbelian 572## #I immediate: IsTorsionFree 573## #I immediate: IsNonTrivial 574## #I immediate: IsPerfectGroup 575## #I immediate: GeneralizedPcgs 576## #I immediate: IsEmpty 577## 6 578## gap> UntraceImmediateMethods( ); 579## gap> UntraceMethods( [ Size ] ); 580## ]]></Log> 581## <P/> 582## This example gives an explanation for the two calls of the 583## <Q>system getter</Q> for <Ref Attr="Size"/>. 584## Namely, there are immediate methods that access the known size 585## of the group. 586## Note that the group <C>g</C> was known to be finitely generated already 587## before the size was computed, 588## the calls of the immediate method for 589## <Ref Prop="IsFinitelyGeneratedGroup"/> after the call of 590## <Ref Attr="Size"/> have other arguments than <C>g</C>. 591## </Description> 592## </ManSection> 593## <#/GAPDoc> 594## 595TRACE_IMMEDIATE_METHODS := false; 596 597BIND_GLOBAL( "UntraceImmediateMethods", function () 598 TRACE_IMMEDIATE_METHODS := false; 599end ); 600 601BIND_GLOBAL( "TraceImmediateMethods", function( arg ) 602 if LENGTH(arg) = 0 then 603 TRACE_IMMEDIATE_METHODS := true; 604 return; 605 fi; 606 607 if LENGTH(arg) > 1 or not IS_BOOL(arg[1]) then 608 Error("Usage: TraceImmediateMethods( [bool] )"); 609 fi; 610 611 if arg[1] then 612 TRACE_IMMEDIATE_METHODS := true; 613 else 614 TRACE_IMMEDIATE_METHODS := false; 615 fi; 616end ); 617 618 619############################################################################# 620## 621#F NewOperation( <name>, <args-filts> ) 622## 623## <#GAPDoc Label="NewOperation"> 624## <ManSection> 625## <Func Name="NewOperation" Arg='name, args-filts'/> 626## 627## <Description> 628## <Ref Func="NewOperation"/> returns an operation <A>opr</A> with name 629## <A>name</A>. 630## The list <A>args-filts</A> describes requirements about the arguments 631## of <A>opr</A>, namely the number of arguments must be equal to the length 632## of <A>args-filts</A>, and the <M>i</M>-th argument must lie in the filter 633## <A>args-filts</A><M>[i]</M>. 634## <P/> 635## Each method that is installed for <A>opr</A> via 636## <Ref Func="InstallMethod"/> must require that the <M>i</M>-th argument 637## lies in the filter <A>args-filts</A><M>[i]</M>. 638## <P/> 639## One can install methods for other argument tuples via 640## <Ref Func="InstallOtherMethod"/>, 641## this way it is also possible to install methods for a different number 642## of arguments than the length of <A>args-filts</A>. 643## </Description> 644## </ManSection> 645## <#/GAPDoc> 646## 647BIND_GLOBAL( "NewOperation", function ( name, filters ) 648 local oper, filt, filter; 649 650 if GAPInfo.MaxNrArgsMethod < LEN_LIST( filters ) then 651 Error( "methods can have at most ", GAPInfo.MaxNrArgsMethod, 652 " arguments" ); 653 fi; 654 oper := NEW_OPERATION( name ); 655 filt := []; 656 for filter in filters do 657 if not IS_OPERATION( filter ) then 658 Error( "<filter> must be an operation" ); 659 fi; 660 ADD_LIST( filt, FLAGS_FILTER( filter ) ); 661 od; 662 STORE_OPER_FLAGS(oper, filt); 663 return oper; 664end ); 665 666 667############################################################################# 668## 669#F NewConstructor( <name>, <filters> ) 670## 671## <#GAPDoc Label="NewConstructor"> 672## <ManSection> 673## <Func Name="NewConstructor" Arg='name, args-filts'/> 674## 675## <Description> 676## <Ref Func="NewConstructor"/> returns a constructor <A>cons</A> with name 677## <A>name</A>. 678## The list <A>args-filts</A> describes requirements about the arguments 679## of <A>cons</A>. Namely the number of arguments must be equal to the length 680## of <A>args-filts</A>, and the <M>i</M>-th argument 681## must lie in the filter <A>args-filts</A><M>[i]</M> for <M>i \neq 1</M>. 682## A constructor expects the first argument to be a <E>filter</E> instead 683## of an object and it must be a subset of the filter 684## <A>args-filts</A><M>[1]</M>. 685## <P/> 686## Each method that is installed for <A>cons</A> via 687## <Ref Func="InstallMethod"/> must require that 688## the <M>i</M>-th argument lies in the filter <A>args-filts</A><M>[i]</M> 689## for <M>i \neq 1</M>. 690## Its first argument is a filter and must be a subset of the filter 691## <A>args-filts</A><M>[1]</M>. 692## <P/> 693## One can install methods for other argument tuples via 694## <Ref Func="InstallOtherMethod"/>, 695## this way it is also possible to install methods for a different number 696## of arguments than the length of <A>args-filts</A>. 697## <P/> 698## Note that the method selection for constructors works slightly differently 699## than for usual operations. 700## As stated above, applicabilty to the first argument in an argument tuple 701## is tested by determining whether the argument-filter is a <E>subset</E> of 702## <A>args-filts</A><M>[1]</M>. 703## <P/> 704## The rank of a method installed for a constructor is determined solely by 705## <A>args-filts</A><M>[1]</M> of the method. 706## Instead of taking the sum of the ranks of filters involved in its 707## <A>args-filts</A><M>[1]</M>, the sum of <M>-1</M> times these values 708## is taken. 709## The result is added to the number <A>val</A> used in the call of 710## <Ref Func="InstallMethod"/>. 711## <P/> 712## This has the following effects on the method selection for constructors. 713## If <A>cons</A> is called with an argument tuple whose first argument is 714## the filter <A>filt</A>, any method whose first argument is 715## <E>more</E> specific than <A>filt</A> is applicable 716## (if its other <A>args-filts</A> also match). 717## Then the method with the <Q>most general</Q> filter <A>args-filts</A><M>[1]</M> 718## is chosen, since the rank is computed by taking <M>-1</M> times the ranks 719## of the involved filters. 720## Thus, a constructor is chosen which returns an object in <A>filt</A> using 721## as few extra filters as possible, which presumably is both more flexible 722## to use and easier to construct. 723## <P/> 724## The following example showcases this behaviour. 725## Note that the argument <A>filter</A> is only used for method dispatch. 726## <Log><![CDATA[ 727## DeclareFilter( "IsMyObj" ); 728## DeclareFilter( "IsMyFilter" ); 729## DeclareFilter( "IsMyOtherFilter" ); 730## BindGlobal( "MyFamily", NewFamily( "MyFamily" ) ); 731## 732## DeclareConstructor( "NewMyObj", [ IsMyObj ] ); 733## 734## InstallMethod( NewMyObj, 735## [ IsMyObj ], 736## function( filter ) 737## local type; 738## Print("General constructor\n"); 739## type := NewType( MyFamily, IsMyObj ); 740## return Objectify( type, [] ); 741## end ); 742## InstallMethod( NewMyObj, 743## [ IsMyObj and IsMyFilter and IsMyOtherFilter ], 744## function( filter ) 745## local type; 746## Print("Special constructor\n"); 747## type := NewType( MyFamily, IsMyObj and IsMyFilter and IsMyOtherFilter ); 748## return Objectify( type, [] ); 749## end ); 750## ]]></Log> 751## If only IsMyObj is given, both methods are applicable and the general 752## constructor is called. 753## If also IsMyFilter is given, only the special constructor is applicable. 754## <Log><![CDATA[ 755## gap> a := NewMyObj( IsMyObj );; 756## General constructor 757## gap> IsMyOtherFilter(a); 758## false 759## gap> b := NewMyObj( IsMyObj and IsMyFilter );; 760## Special constructor 761## gap> IsMyOtherFilter(b); 762## true 763## gap> c := NewMyObj( IsMyObj and IsMyFilter and IsMyOtherFilter );; 764## Special constructor 765## gap> IsMyOtherFilter(c); 766## true 767## ]]></Log> 768## </Description> 769## </ManSection> 770## <#/GAPDoc> 771## 772BIND_GLOBAL( "NewConstructor", function ( name, filters ) 773 local oper, filt, filter; 774 775 if LEN_LIST( filters ) = 0 then 776 Error( "constructors must have at least one argument" ); 777 fi; 778 if GAPInfo.MaxNrArgsMethod < LEN_LIST( filters ) then 779 Error( "methods can have at most ", GAPInfo.MaxNrArgsMethod, 780 " arguments" ); 781 fi; 782 oper := NEW_CONSTRUCTOR( name ); 783 filt := []; 784 for filter in filters do 785 if not IS_OPERATION( filter ) then 786 Error( "<filter> must be an operation" ); 787 fi; 788 ADD_LIST( filt, FLAGS_FILTER( filter ) ); 789 od; 790 STORE_OPER_FLAGS(oper, filt); 791 return oper; 792end ); 793 794 795############################################################################# 796## 797#F DeclareOperation( <name>, <filters> ) 798## 799## <#GAPDoc Label="DeclareOperation"> 800## <ManSection> 801## <Func Name="DeclareOperation" Arg='name, filters'/> 802## 803## <Description> 804## does the same as <Ref Func="NewOperation"/> and 805## additionally makes the variable <A>name</A> read-only. 806## </Description> 807## </ManSection> 808## <#/GAPDoc> 809## 810BIND_GLOBAL( "DeclareOperation", function ( name, filters ) 811 local gvar, pos, req, filt, filter; 812 813 if GAPInfo.MaxNrArgsMethod < LEN_LIST( filters ) then 814 Error( "methods can have at most ", GAPInfo.MaxNrArgsMethod, 815 " arguments" ); 816 elif ISB_GVAR( name ) then 817 818 gvar:= VALUE_GLOBAL( name ); 819 820 # Check that the variable is in fact an operation. 821 if not IS_OPERATION( gvar ) then 822 Error( "variable `", name, "' is not bound to an operation" ); 823 fi; 824 825 # The operation has already been declared. 826 # If it was created as attribute or property, 827 # and if the new declaration is unary 828 # then ask for re-declaration as attribute or property. 829 # (Note that the values computed for objects matching the new 830 # requirements will be stored.) 831 if LEN_LIST( filters ) = 1 and FLAG2_FILTER( gvar ) <> 0 then 832 833 # `gvar' is an attribute (tester) or property (tester). 834 pos:= POS_LIST_DEFAULT( FILTERS, gvar, 0 ); 835 if pos = fail then 836 837 # `gvar' is an attribute. 838 Error( "operation `", name, 839 "' was created as an attribute, use `DeclareAttribute'" ); 840 841 elif INFO_FILTERS[ pos ] in FNUM_TPRS 842 or INFO_FILTERS[ pos ] in FNUM_ATTS then 843 844 # `gvar' is an attribute tester or property tester. 845 Error( "operation `", name, 846 "' is an attribute tester or property tester" ); 847 848 else 849 850 # `gvar' is a property. 851 Error( "operation `", name, 852 "' was created as a property, use `DeclareProperty'" ); 853 854 fi; 855 856 fi; 857 858 # Add the new requirements if they differ from known ones. 859 filt := []; 860 for filter in filters do 861 if not IS_OPERATION( filter ) then 862 Error( "<filter> must be an operation" ); 863 fi; 864 ADD_LIST( filt, FLAGS_FILTER( filter ) ); 865 od; 866 867 req := GET_OPER_FLAGS(gvar); 868 if IsHPCGAP then 869 req := FromAtomicList(req); # so that we can search in it 870 fi; 871 if filt in req then 872 if not REREADING then 873 INFO_DEBUG( 1, "equal requirements in multiple declarations ", 874 "for operation `", name, "'\n" ); 875 fi; 876 else 877 STORE_OPER_FLAGS( gvar, filt ); 878 fi; 879 880 else 881 882 # The operation is new. 883 BIND_GLOBAL( name, NewOperation( name, filters ) ); 884 885 fi; 886end ); 887 888 889############################################################################# 890## 891#F DeclareOperationKernel( <name>, <filters>, <kernel-oper> ) 892## 893## <ManSection> 894## <Func Name="DeclareOperationKernel" Arg='name, filters, kernel-oper'/> 895## 896## <Description> 897## This function must not be used to re-declare an operation 898## that has already been declared. 899## </Description> 900## </ManSection> 901## 902BIND_GLOBAL( "DeclareOperationKernel", function ( name, filters, oper ) 903 local filt, filter; 904 905 if GAPInfo.MaxNrArgsMethod < LEN_LIST( filters ) then 906 Error( "methods can have at most ", GAPInfo.MaxNrArgsMethod, 907 " arguments" ); 908 fi; 909 910 # This will yield an error if `name' is already bound. 911 BIND_GLOBAL( name, oper ); 912 SET_NAME_FUNC( oper, name ); 913 914 filt := []; 915 for filter in filters do 916 if not IS_OPERATION( filter ) then 917 Error( "<filter> must be an operation" ); 918 fi; 919 ADD_LIST( filt, FLAGS_FILTER( filter ) ); 920 od; 921 922 STORE_OPER_FLAGS(oper, filt); 923end ); 924 925 926############################################################################# 927## 928#F DeclareConstructor( <name>, <filters> ) 929## 930## <#GAPDoc Label="DeclareConstructor"> 931## <ManSection> 932## <Func Name="DeclareConstructor" Arg='name, filters'/> 933## 934## <Description> 935## does the same as <Ref Func="NewConstructor"/> and 936## additionally makes the variable <A>name</A> read-only. 937## <P/> 938## Note that for operations which are constructors special rules with respect 939## to applicability and rank of the corresponding methods apply 940## (see section <Ref Func="NewConstructor"/>). 941## </Description> 942## </ManSection> 943## <#/GAPDoc> 944## 945BIND_GLOBAL( "DeclareConstructor", function ( name, filters ) 946 947 local gvar, req, filt, filter; 948 949 if LEN_LIST( filters ) = 0 then 950 Error( "constructors must have at least one argument" ); 951 elif GAPInfo.MaxNrArgsMethod < LEN_LIST( filters ) then 952 Error( "methods can have at most ", GAPInfo.MaxNrArgsMethod, 953 " arguments" ); 954 elif ISB_GVAR( name ) then 955 956 gvar:= VALUE_GLOBAL( name ); 957 958 # Check that the variable is in fact an operation. 959 if not IS_OPERATION( gvar ) then 960 Error( "variable `", name, "' is not bound to an operation" ); 961 fi; 962 963 # The constructor has already been declared. 964 # If it was not created as a constructor 965 # then ask for re-declaration as an ordinary operation. 966 if not IS_CONSTRUCTOR(gvar) then 967 Error( "operation `", name, "' was not created as a constructor" ); 968 fi; 969 970 # Add the new requirements. 971 filt := []; 972 for filter in filters do 973 if not IS_OPERATION( filter ) then 974 Error( "<filter> must be an operation" ); 975 fi; 976 ADD_LIST( filt, FLAGS_FILTER( filter ) ); 977 od; 978 979 STORE_OPER_FLAGS( gvar, filt ); 980 981 else 982 983 # The operation is new. 984 BIND_GLOBAL( name, NewConstructor( name, filters ) ); 985 986 fi; 987end ); 988 989 990############################################################################# 991## 992#F DeclareConstructorKernel( <name>, <filter>, <kernel-oper> ) 993## 994## <ManSection> 995## <Func Name="DeclareConstructorKernel" Arg='name, filter, kernel-oper'/> 996## 997## <Description> 998## This function must not be used to re-declare a constructor 999## that has already been declared. 1000## </Description> 1001## </ManSection> 1002## 1003BIND_GLOBAL( "DeclareConstructorKernel", function ( name, filters, oper ) 1004 local filt, filter; 1005 1006 if GAPInfo.MaxNrArgsMethod < LEN_LIST( filters ) then 1007 Error( "methods can have at most ", GAPInfo.MaxNrArgsMethod, 1008 " arguments" ); 1009 fi; 1010 1011 # This will yield an error if `name' is already bound. 1012 BIND_GLOBAL( name, oper ); 1013 SET_NAME_FUNC( oper, name ); 1014 1015 filt := []; 1016 for filter in filters do 1017 if not IS_OPERATION( filter ) then 1018 Error( "<filter> must be an operation" ); 1019 fi; 1020 ADD_LIST( filt, FLAGS_FILTER( filter ) ); 1021 od; 1022 1023 STORE_OPER_FLAGS(oper, filt); 1024end ); 1025 1026 1027############################################################################# 1028## 1029#F InstallAttributeFunction( <func> ) . . . run function for each attribute 1030## 1031## <ManSection> 1032## <Func Name="InstallAttributeFunction" Arg='func'/> 1033## 1034## <Description> 1035## <C>InstallAttributeFunction</C> installs <A>func</A>, so that 1036## <C><A>func</A>( <A>name</A>, <A>filter</A>, <A>getter</A>, <A>setter</A>, <A>tester</A>, <A>mutflag</A> )</C> 1037## is called for each attribute. 1038## </Description> 1039## </ManSection> 1040## 1041if IsHPCGAP then 1042 BIND_GLOBAL( "ATTRIBUTES", MakeStrictWriteOnceAtomic( [] ) ); 1043 BIND_GLOBAL( "ATTR_FUNCS", MakeStrictWriteOnceAtomic( [] ) ); 1044else 1045 BIND_GLOBAL( "ATTRIBUTES", [] ); 1046 BIND_GLOBAL( "ATTR_FUNCS", [] ); 1047fi; 1048 1049BIND_GLOBAL( "InstallAttributeFunction", function ( func ) 1050 local attr; 1051 for attr in ATTRIBUTES do 1052 func( attr[1], attr[2], attr[3], attr[4], attr[5], attr[6] ); 1053 od; 1054 ADD_LIST( ATTR_FUNCS, func ); 1055end ); 1056 1057BIND_GLOBAL( "RUN_ATTR_FUNCS", 1058 function ( filter, getter, setter, tester, mutflag ) 1059 local name, func; 1060 name:= NAME_FUNC( getter ); 1061 for func in ATTR_FUNCS do 1062 func( name, filter, getter, setter, tester, mutflag ); 1063 od; 1064 ADD_LIST( ATTRIBUTES, 1065 MakeImmutable( [ name, filter, getter, setter, tester, mutflag ] ) ); 1066end ); 1067 1068 1069############################################################################# 1070## 1071BIND_GLOBAL( "BIND_SETTER_TESTER", 1072function( name, setter, tester) 1073 local nname; 1074 nname:= "Set"; APPEND_LIST_INTR( nname, name ); 1075 BIND_GLOBAL( nname, setter ); 1076 nname:= "Has"; APPEND_LIST_INTR( nname, name ); 1077 BIND_GLOBAL( nname, tester ); 1078end ); 1079 1080 1081############################################################################# 1082## 1083#F DeclareAttributeKernel( <name>, <filter>, <getter> ) . . . new attribute 1084## 1085## <ManSection> 1086## <Func Name="DeclareAttributeKernel" Arg='name, filter, getter'/> 1087## 1088## <Description> 1089## This function must not be used to re-declare an attribute 1090## that has already been declared. 1091## </Description> 1092## </ManSection> 1093## 1094BIND_GLOBAL( "DeclareAttributeKernel", function ( name, filter, getter ) 1095 local setter, tester; 1096 1097 # This will yield an error if `name' is already bound. 1098 BIND_GLOBAL( name, getter ); 1099 SET_NAME_FUNC( getter, name ); 1100 1101 # construct setter and tester 1102 setter := SETTER_FILTER( getter ); 1103 tester := TESTER_FILTER( getter ); 1104 1105 # add getter, setter and tester to the list of operations 1106 STORE_OPER_FLAGS(getter, [ FLAGS_FILTER(filter) ]); 1107 STORE_OPER_FLAGS(setter, [ FLAGS_FILTER(filter), FLAGS_FILTER(IS_OBJECT) ]); 1108 STORE_OPER_FLAGS(tester, [ FLAGS_FILTER(filter) ]); 1109 1110 # store the information about the filter 1111 REGISTER_FILTER( tester, FLAG2_FILTER( tester ), 1, FNUM_ATTR_KERN ); 1112 1113 # clear the cache because <filter> is something old 1114 if not GAPInfo.CommandLineOptions.N then 1115 InstallHiddenTrueMethod( filter, tester ); 1116 fi; 1117 CLEAR_HIDDEN_IMP_CACHE( tester ); 1118 1119 # run the attribute functions 1120 RUN_ATTR_FUNCS( filter, getter, setter, tester, false ); 1121 1122 1123 # and make the remaining assignments 1124 BIND_SETTER_TESTER( name, setter, tester ); 1125 1126end ); 1127 1128 1129############################################################################# 1130## 1131#F NewAttribute( <name>, <filter>[, <mutable>][, <rank>] ) . . new attribute 1132## 1133## <#GAPDoc Label="NewAttribute"> 1134## <ManSection> 1135## <Func Name="NewAttribute" Arg='name, filter[, "mutable"][, rank]'/> 1136## 1137## <Description> 1138## <Ref Func="NewAttribute"/> returns a new attribute getter with name 1139## <A>name</A> that is applicable to objects with the property 1140## <A>filter</A>. 1141## <P/> 1142## Contrary to the situation with categories and representations, 1143## the tester of the new attribute does <E>not</E> imply <A>filter</A>. 1144## This is exactly because of the possibility to install methods 1145## that do not require <A>filter</A>. 1146## <P/> 1147## For example, the attribute <Ref Attr="Size"/> was created 1148## with second argument a list or a collection, 1149## but there is also a method for <Ref Attr="Size"/> that is 1150## applicable to a character table, 1151## which is neither a list nor a collection. 1152## <P/> 1153## For the optional third and fourth arguments, there are the following 1154## possibilities. 1155## <List> 1156## <Item> The integer argument <A>rank</A> causes the attribute tester to have 1157## this incremental rank (see <Ref Sect="Filters"/>), 1158## </Item> 1159## <Item> If the argument <A>mutable</A> is the string <C>"mutable"</C> or 1160## the boolean <C>true</C>, then the values of the attribute are mutable. 1161## </Item> 1162## <Item> If the argument <A>mutable</A> is the boolean <C>false</C>, then 1163## the values of the attribute are immutable. 1164## </Item> 1165## </List> 1166## <P/> 1167## When a value of such mutable attribute is set 1168## then this value itself is stored, not an immutable copy of it, 1169## and it is the user's responsibility to set an object that is mutable. 1170## This is useful for an attribute whose value is some partial information 1171## that may be completed later. 1172## For example, there is an attribute <C>ComputedSylowSubgroups</C> 1173## for the list holding those Sylow subgroups of a group that have been 1174## computed already by the function 1175## <Ref Oper="SylowSubgroup"/>, 1176## and this list is mutable because one may want to enter groups into it 1177## as they are computed. 1178## <!-- in the current implementation, one can overwrite values of mutable--> 1179## <!-- attributes; is this really intended?--> 1180## <!-- if yes then it should be documented!--> 1181## <P/> 1182## If no argument for <A>rank</A> is given, then the rank of the tester is 1. 1183## <P/> 1184## Each method for the new attribute that does <E>not</E> require 1185## its argument to lie in <A>filter</A> must be installed using 1186## <Ref Func="InstallOtherMethod"/>. 1187## </Description> 1188## </ManSection> 1189## <#/GAPDoc> 1190## 1191BIND_GLOBAL( "OPER_SetupAttribute", function(getter, flags, mutflag, filter, rank, name) 1192 local setter, tester, nname; 1193 1194 # add setter and tester to the list of operations 1195 setter := SETTER_FILTER( getter ); 1196 tester := TESTER_FILTER( getter ); 1197 1198 STORE_OPER_FLAGS(setter, [ flags, FLAGS_FILTER( IS_OBJECT ) ]); 1199 STORE_OPER_FLAGS(tester, [ flags ]); 1200 1201 # store information about the filter 1202 REGISTER_FILTER( tester, FLAG2_FILTER( tester ), rank, FNUM_ATTR ); 1203 1204 # the <tester> is newly made, therefore the cache cannot contain a flag 1205 # list involving <tester> 1206 if not GAPInfo.CommandLineOptions.N then 1207 InstallHiddenTrueMethod( filter, tester ); 1208 fi; 1209 # CLEAR_HIDDEN_IMP_CACHE(); 1210 1211 # run the attribute functions 1212 RUN_ATTR_FUNCS( filter, getter, setter, tester, mutflag ); 1213 1214end); 1215 1216# construct getter, setter and tester 1217BIND_GLOBAL( "NewAttribute", function ( name, filter, args... ) 1218 local flags, mutflag, getter, rank; 1219 1220 if not IS_STRING( name ) then 1221 Error( "<name> must be a string"); 1222 fi; 1223 1224 if not IsFilter( filter ) then 1225 Error( "<filter> must be a filter" ); 1226 fi; 1227 1228 rank := 1; 1229 mutflag := false; 1230 if LEN_LIST(args) = 0 then 1231 # this is fine, but does nothing 1232 elif LEN_LIST(args) = 1 and args[1] in [ "mutable", true, false ] then 1233 mutflag := args[1] in [ "mutable", true]; 1234 elif LEN_LIST(args) = 1 and IS_INT(args[1]) then 1235 rank := args[1]; 1236 elif LEN_LIST(args) = 2 1237 and args[1] in [ "mutable", true, false ] 1238 and IS_INT(args[2]) then 1239 mutflag := args[1] in [ "mutable", true ]; 1240 rank := args[2]; 1241 else 1242 Error("Usage: NewAttribute( <name>, <filter>[, <mutable>][, <rank>] )"); 1243 fi; 1244 1245 flags:= FLAGS_FILTER( filter ); 1246 1247 # construct a new attribute 1248 if mutflag then 1249 getter := NEW_MUTABLE_ATTRIBUTE( name ); 1250 else 1251 getter := NEW_ATTRIBUTE( name ); 1252 fi; 1253 STORE_OPER_FLAGS(getter, [ flags ]); 1254 1255 OPER_SetupAttribute(getter, flags, mutflag, filter, rank, name); 1256 1257 # And return the getter 1258 return getter; 1259end ); 1260 1261 1262############################################################################# 1263## 1264#F DeclareAttribute( <name>, <filter>[, "mutable"][, <rank>] ) new attribute 1265## 1266## <#GAPDoc Label="DeclareAttribute"> 1267## <ManSection> 1268## <Func Name="DeclareAttribute" Arg='name, filter[, "mutable"][, rank]'/> 1269## 1270## <Description> 1271## does the same as <Ref Func="NewAttribute"/>, 1272## additionally makes the variable <A>name</A> read-only 1273## and also binds read-only global variables with names 1274## <C>Has<A>name</A></C> and <C>Set<A>name</A></C> 1275## for the tester and setter of the attribute (see Section 1276## <Ref Sect="Setter and Tester for Attributes"/>). 1277## </Description> 1278## </ManSection> 1279## <#/GAPDoc> 1280## 1281 1282BIND_GLOBAL( "ConvertToAttribute", 1283function(name, op, filter, rank, mutable) 1284 local req, reqs, flags; 1285 # `op' is not an attribute (tester) and not a property (tester), 1286 # or `op' is a filter; in any case, `op' is not an attribute. 1287 1288 # if `op' has no one argument declarations we can turn it into 1289 # an attribute 1290 req := GET_OPER_FLAGS(op); 1291 for reqs in req do 1292 if LENGTH(reqs) = 1 then 1293 Error( "operation `", name, "' has been declared as a one ", 1294 "argument Operation and cannot also be an Attribute"); 1295 fi; 1296 od; 1297 1298 flags := FLAGS_FILTER(filter); 1299 STORE_OPER_FLAGS( op, [ flags ] ); 1300 1301 # kernel magic for the conversion 1302 if mutable then 1303 OPER_TO_MUTABLE_ATTRIBUTE(op); 1304 else 1305 OPER_TO_ATTRIBUTE(op); 1306 fi; 1307 1308 OPER_SetupAttribute(op, flags, mutable, filter, rank, name); 1309 1310 # and make the remaining assignments 1311 BIND_SETTER_TESTER( name, SETTER_FILTER(op), TESTER_FILTER(op) ); 1312end); 1313 1314BIND_GLOBAL( "DeclareAttribute", function ( name, filter, args... ) 1315 local gvar, req, reqs, setter, tester, 1316 attr, mutflag, flags, rank; 1317 1318 if not IS_STRING( name ) then 1319 Error( "<name> must be a string"); 1320 fi; 1321 1322 if not IsFilter( filter ) then 1323 Error( "<filter> must be a filter" ); 1324 fi; 1325 1326 rank := 1; 1327 mutflag := false; 1328 if LEN_LIST(args) = 0 then 1329 # this is fine, but does nothing 1330 elif LEN_LIST(args) = 1 and args[1] in [ "mutable", true, false ] then 1331 mutflag := args[1] in [ "mutable", true]; 1332 elif LEN_LIST(args) = 1 and IS_INT(args[1]) then 1333 rank := args[1]; 1334 elif LEN_LIST(args) = 2 1335 and args[1] in [ "mutable", true, false ] 1336 and IS_INT(args[2]) then 1337 mutflag := args[1] in [ "mutable", true ]; 1338 rank := args[2]; 1339 else 1340 Error("Usage: DeclareAttribute( <name>, <filter>[, <mutable>][, <rank>] )"); 1341 fi; 1342 1343 if ISB_GVAR( name ) then 1344 # The variable exists already. 1345 gvar := VALUE_GLOBAL( name ); 1346 1347 # Check that the variable is in fact bound to an operation. 1348 if not IS_OPERATION( gvar ) then 1349 Error( "variable `", name, "' is not bound to an operation" ); 1350 fi; 1351 1352 # Check whether the variable is in fact bound to an attribute, i.e., 1353 # it has an associated tester (whose id is in FLAG2_FILTER) but is not 1354 # a filter itself (to exclude properties, and also and-filters for which 1355 # FLAG2_FILTER also is non-zero). 1356 if FLAG2_FILTER( gvar ) <> 0 and not IsFilter(gvar) then 1357 # gvar is already an attribute, extend it by the new filter 1358 STORE_OPER_FLAGS( gvar, [ FLAGS_FILTER( filter ) ] ); 1359 1360 # also set the extended range for the setter 1361 req := GET_OPER_FLAGS( Setter(gvar) ); 1362 STORE_OPER_FLAGS( Setter(gvar), [ FLAGS_FILTER( filter), req[1][2] ] ); 1363 else 1364 # gvar is a an existing non-attribute operation, try to convert it 1365 # into an attribute 1366 ConvertToAttribute(name, gvar, filter, rank, mutflag); 1367 fi; 1368 else 1369 # The attribute is new. 1370 attr := NewAttribute(name, filter, mutflag, rank); 1371 BIND_GLOBAL( name, attr ); 1372 1373 # and make the remaining assignments 1374 BIND_SETTER_TESTER( name, SETTER_FILTER(attr), TESTER_FILTER(attr) ); 1375 fi; 1376end ); 1377 1378 1379############################################################################# 1380## 1381#V LENGTH_SETTER_METHODS_2 1382## 1383## <ManSection> 1384## <Var Name="LENGTH_SETTER_METHODS_2"/> 1385## 1386## <Description> 1387## is the current length of <C>METHODS_OPERATION( <A>attr</A>, 2 )</C> 1388## for an attribute <A>attr</A> for which no individual setter methods 1389## are installed. 1390## (This is used for <C>ObjectifyWithAttributes</C>.) 1391## </Description> 1392## </ManSection> 1393## 1394LENGTH_SETTER_METHODS_2 := 0; 1395 1396 1397############################################################################# 1398## 1399#F DeclarePropertyKernel( <name>, <filter>, <getter> ) . . . . new property 1400## 1401## <ManSection> 1402## <Func Name="DeclarePropertyKernel" Arg='name, filter, getter'/> 1403## 1404## <Description> 1405## This function must not be used to re-declare a property 1406## that has already been declared. 1407## </Description> 1408## </ManSection> 1409## 1410BIND_GLOBAL( "DeclarePropertyKernel", function ( name, filter, getter ) 1411 local setter, tester; 1412 1413 # This will yield an error if `name' is already bound. 1414 BIND_GLOBAL( name, getter ); 1415 SET_NAME_FUNC( getter, name ); 1416 1417 # construct setter and tester 1418 setter := SETTER_FILTER( getter ); 1419 tester := TESTER_FILTER( getter ); 1420 1421 # add getter, setter and tester to the list of operations 1422 STORE_OPER_FLAGS(getter, [ FLAGS_FILTER(filter) ]); 1423 STORE_OPER_FLAGS(setter, [ FLAGS_FILTER(filter), FLAGS_FILTER(IS_BOOL) ]); 1424 STORE_OPER_FLAGS(tester, [ FLAGS_FILTER(filter) ]); 1425 1426 # store information about the filters 1427 REGISTER_FILTER( getter, FLAG1_FILTER( getter ), 1, FNUM_PROP_KERN ); 1428 REGISTER_FILTER( tester, FLAG2_FILTER( tester ), 1, FNUM_TPR_KERN ); 1429 1430 # clear the cache because <filter> is something old 1431 if not GAPInfo.CommandLineOptions.N then 1432 InstallHiddenTrueMethod( tester, getter ); 1433 CLEAR_HIDDEN_IMP_CACHE( getter ); 1434 InstallHiddenTrueMethod( filter, tester ); 1435 CLEAR_HIDDEN_IMP_CACHE( tester ); 1436 fi; 1437 1438 # run the attribute functions 1439 RUN_ATTR_FUNCS( filter, getter, setter, tester, false ); 1440 1441 1442 # and make the remaining assignments 1443 BIND_SETTER_TESTER( name, setter, tester ); 1444end ); 1445 1446 1447############################################################################# 1448## 1449#F NewProperty( <name>, <filter>[, <rank>] ) . . . . . . . . . new property 1450## 1451## <#GAPDoc Label="NewProperty"> 1452## <ManSection> 1453## <Func Name="NewProperty" Arg='name, filter[, rank]'/> 1454## 1455## <Description> 1456## <Ref Func="NewProperty"/> returns a new property <A>prop</A> with name 1457## <A>name</A> (see also <Ref Sect="Properties"/>). 1458## The filter <A>filter</A> describes the involved filters of <A>prop</A>. 1459## As in the case of attributes, 1460## <A>filter</A> is not implied by <A>prop</A>. 1461## <P/> 1462## The optional third argument <A>rank</A> denotes the incremental rank 1463## (see <Ref Sect="Filters"/>) of the property 1464## <A>prop</A> itself, i.e. <E>not</E> of its tester; 1465## the default value is 1. 1466## </Description> 1467## </ManSection> 1468## <#/GAPDoc> 1469## 1470BIND_GLOBAL( "NewProperty", function ( arg ) 1471 local name, filter, rank, flags, getter, setter, tester; 1472 1473 name := arg[1]; 1474 filter := arg[2]; 1475 if LEN_LIST( arg ) = 3 and IS_INT( arg[3] ) then 1476 rank := arg[3]; 1477 else 1478 rank := 1; 1479 fi; 1480 1481 if not IS_OPERATION( filter ) then 1482 Error( "<filter> must be an operation" ); 1483 fi; 1484 flags:= FLAGS_FILTER( filter ); 1485 1486 # construct getter, setter and tester 1487 getter := NEW_PROPERTY( name ); 1488 setter := SETTER_FILTER( getter ); 1489 tester := TESTER_FILTER( getter ); 1490 1491 # add getter, setter and tester to the list of operations 1492 STORE_OPER_FLAGS(getter, [ flags ]); 1493 STORE_OPER_FLAGS(setter, [ flags, FLAGS_FILTER(IS_BOOL) ]); 1494 STORE_OPER_FLAGS(tester, [ flags ]); 1495 1496 # store information about the filters 1497 REGISTER_FILTER( getter, FLAG1_FILTER( getter ), rank, FNUM_PROP ); 1498 REGISTER_FILTER( tester, FLAG2_FILTER( tester ), 1, FNUM_TPR ); 1499 1500 # the <tester> and <getter> are newly made, therefore the cache cannot 1501 # contain a flag list involving <tester> or <getter> 1502 if not GAPInfo.CommandLineOptions.N then 1503 InstallHiddenTrueMethod( tester, getter ); 1504 InstallHiddenTrueMethod( filter, tester ); 1505 fi; 1506 # CLEAR_HIDDEN_IMP_CACHE(); 1507 1508 # run the attribute functions 1509 RUN_ATTR_FUNCS( filter, getter, setter, tester, false ); 1510 1511 1512 # and return the getter 1513 return getter; 1514end ); 1515 1516 1517############################################################################# 1518## 1519#F DeclareProperty( <name>, <filter> [,<rank>] ) . . . . . . . new property 1520## 1521## <#GAPDoc Label="DeclareProperty"> 1522## <ManSection> 1523## <Func Name="DeclareProperty" Arg='name, filter [,rank]'/> 1524## 1525## <Description> 1526## does the same as <Ref Func="NewProperty"/>, 1527## additionally makes the variable <A>name</A> read-only 1528## and also binds read-only global variables with names 1529## <C>Has<A>name</A></C> and <C>Set<A>name</A></C> 1530## for the tester and setter of the property (see Section 1531## <Ref Sect="Setter and Tester for Attributes"/>). 1532## </Description> 1533## </ManSection> 1534## <#/GAPDoc> 1535## 1536BIND_GLOBAL( "DeclareProperty", function ( arg ) 1537 1538 local prop, name, gvar, req, filter; 1539 1540 name:= arg[1]; 1541 1542 if ISB_GVAR( name ) then 1543 1544 gvar:= VALUE_GLOBAL( name ); 1545 1546 # Check that the variable is in fact an operation. 1547 if not IS_OPERATION( gvar ) then 1548 Error( "variable `", name, "' is not bound to an operation" ); 1549 fi; 1550 1551 # The property has already been declared. 1552 # If it was not created as a property 1553 # then ask for re-declaration as an ordinary operation. 1554 # (Note that the values computed for objects matching the new 1555 # requirements cannot be stored.) 1556 if FLAG1_FILTER( gvar ) = 0 or FLAG2_FILTER( gvar ) = 0 then 1557 1558 # `gvar' is not a property (tester). 1559 Error( "operation `", name, "' was not created as a property,", 1560 " use `DeclareOperation'" ); 1561 1562 fi; 1563 1564 # Add the new requirements. 1565 filter:= arg[2]; 1566 if not IS_OPERATION( filter ) then 1567 Error( "<filter> must be an operation" ); 1568 fi; 1569 1570 STORE_OPER_FLAGS( gvar, [ FLAGS_FILTER( filter ) ] ); 1571 1572 else 1573 1574 # The property is new. 1575 prop:= CALL_FUNC_LIST( NewProperty, arg ); 1576 BIND_GLOBAL( name, prop ); 1577 BIND_SETTER_TESTER( name, SETTER_FILTER( prop ), TESTER_FILTER( prop ) ); 1578 1579 fi; 1580end ); 1581 1582 1583 1584############################################################################# 1585## 1586#F InstallAtExit( <func> ) . . . . . . . . . . function to call when exiting 1587## 1588BIND_GLOBAL( "InstallAtExit", function( func ) 1589 local f; 1590 if not IS_FUNCTION(func) then 1591 Error( "<func> must be a function" ); 1592 fi; 1593 if CHECK_INSTALL_METHOD then 1594 if not NARG_FUNC(func) in [ -1, 0 ] then 1595 Error( "<func> must accept zero arguments" ); 1596 fi; 1597 fi; 1598 # Return if function has already been installed 1599 # Use this long form to support both List and AtomicList 1600 for f in GAPInfo.AtExitFuncs do 1601 if f = func then 1602 return; 1603 fi; 1604 od; 1605 ADD_LIST( GAPInfo.AtExitFuncs, func ); 1606end ); 1607 1608 1609############################################################################# 1610## 1611#O ViewObj( <obj> ) . . . . . . . . . . . . . . . . . . . . view an object 1612## 1613## <ManSection> 1614## <Oper Name="ViewObj" Arg='obj'/> 1615## 1616## <Description> 1617## <Ref Oper="ViewObj"/> prints information about the object <A>obj</A>. 1618## This information is thought to be short and human readable, 1619## in particular <E>not</E> necessarily detailed enough for defining <A>obj</A>, 1620## an in general <E>not</E> &GAP; readable. 1621## <P/> 1622## More detailed information can be obtained by <Ref Func="PrintObj"/> 1623## </Description> 1624## </ManSection> 1625## 1626DeclareOperationKernel( "ViewObj", [ IS_OBJECT ], VIEW_OBJ ); 1627 1628 1629############################################################################# 1630## 1631#O ViewString( <obj> ) . . . . . . . . . . . . . . . . . . . view an object 1632## 1633## <#GAPDoc Label="ViewString"> 1634## <ManSection> 1635## <Oper Name="ViewString" Arg='obj'/> 1636## 1637## <Description> 1638## <Ref Oper="ViewString"/> returns a string which would be displayed 1639## by <Ref Oper="ViewObj"/> for an 1640## object. Note that no method for <Ref Oper="ViewString"/> may 1641## delegate to any of 1642## the operations <Ref Oper="Display"/>, <Ref Oper="ViewObj"/>, 1643## <Ref Oper="DisplayString"/> or <Ref Oper="PrintObj"/> to avoid 1644## circular delegations. 1645## </Description> 1646## </ManSection> 1647## <#/GAPDoc> 1648## 1649DeclareOperation( "ViewString", [ IS_OBJECT ]); 1650 1651 1652############################################################################# 1653## 1654#F View( <obj1>, <obj2>... ) . . . . . . . . . . . . . . . . . view objects 1655## 1656## <#GAPDoc Label="View"> 1657## <ManSection> 1658## <Func Name="View" Arg='obj1, obj2...'/> 1659## 1660## <Description> 1661## <Ref Func="View"/> shows the objects <A>obj1</A>, <A>obj2</A>... etc. 1662## <E>in a short form</E> on the standard output by calling the 1663## <Ref Oper="ViewObj"/> operation on each of them. 1664## <Ref Func="View"/> is called in the read-eval-print loop, 1665## thus the output looks exactly like the representation of the 1666## objects shown by the main loop. 1667## Note that no space or newline is printed between the objects. 1668## </Description> 1669## </ManSection> 1670## <#/GAPDoc> 1671## 1672BIND_GLOBAL( "View", function( arg ) 1673 local obj; 1674 1675 for obj in arg do 1676 ViewObj(obj); 1677 od; 1678end ); 1679 1680 1681############################################################################# 1682## 1683#F TraceMethods( <oprs> ) 1684## 1685## <#GAPDoc Label="TraceMethods"> 1686## <ManSection> 1687## <Func Name="TraceMethods" Arg='opr1, opr2, ...' Label ="for operations"/> 1688## <Func Name="TraceMethods" Arg='oprs' Label ="for a list of operations"/> 1689## 1690## <Description> 1691## After the call of <C>TraceMethods</C>, whenever a method of one of 1692## the operations <A>opr1</A>, <A>opr2</A>, ... is called, the 1693## information string used in the installation of the method is printed. 1694## The second form has the same effect for each operation from the list 1695## <A>oprs</A> of operations. 1696## </Description> 1697## </ManSection> 1698## <#/GAPDoc> 1699## 1700BIND_GLOBAL( "TraceMethods", function( arg ) 1701 local fun; 1702 if LEN_LIST( arg ) = 0 then 1703 Error("`TraceMethods' require at least one argument"); 1704 fi; 1705 if IS_LIST(arg[1]) then 1706 arg := arg[1]; 1707 fi; 1708 for fun in arg do 1709 TRACE_METHODS(fun); 1710 od; 1711 1712end ); 1713 1714############################################################################# 1715## 1716#F TraceAllMethods( ) 1717## 1718## <#GAPDoc Label="TraceAllMethods"> 1719## <ManSection> 1720## <Func Name="TraceAllMethods" Arg=""/> 1721## 1722## <Description> 1723## Invokes <C>TraceMethods</C> for all operations. 1724## </Description> 1725## </ManSection> 1726## <#/GAPDoc> 1727## 1728BIND_GLOBAL( "TraceAllMethods", function( arg ) 1729 local fun; 1730 TraceMethods(OPERATIONS); 1731end ); 1732 1733 1734############################################################################# 1735## 1736#F UntraceMethods( <oprs>) 1737## 1738## <#GAPDoc Label="UntraceMethods"> 1739## <ManSection> 1740## <Func Name="UntraceMethods" Arg='opr1, opr2, ...' Label ="for operations"/> 1741## <Func Name="UntraceMethods" Arg='oprs' Label ="for a list of operations"/> 1742## 1743## <Description> 1744## turns the tracing off for all operations <A>opr1</A>, <A>opr2</A>, ... or 1745## in the second form, for all operations in the list <A>oprs</A>. 1746## <Log><![CDATA[ 1747## gap> TraceMethods( [ Size ] ); 1748## gap> g:= Group( (1,2,3), (1,2) );; 1749## gap> Size( g ); 1750## #I Size: for a permutation group at /gap5/lib/grpperm.gi:487 1751## #I Setter(Size): system setter 1752## #I Size: system getter 1753## #I Size: system getter 1754## 6 1755## gap> UntraceMethods( [ Size ] ); 1756## ]]></Log> 1757## </Description> 1758## </ManSection> 1759## <#/GAPDoc> 1760## 1761BIND_GLOBAL( "UntraceMethods", function( arg ) 1762 local fun; 1763 if LEN_LIST( arg ) = 0 then 1764 Error("`UntraceMethods' require at least one argument"); 1765 fi; 1766 if IS_LIST(arg[1]) then 1767 arg := arg[1]; 1768 fi; 1769 for fun in arg do 1770 UNTRACE_METHODS(fun); 1771 od; 1772 1773end ); 1774 1775 1776############################################################################# 1777## 1778#F UntraceAllMethods( <oprs>) 1779## 1780## <#GAPDoc Label="UntraceAllMethods"> 1781## <ManSection> 1782## <Func Name="UntraceAllMethods" Arg=""/> 1783## 1784## <Description> 1785## Equivalent to calling <C>UntraceMethods</C> for all operations. 1786## </Description> 1787## </ManSection> 1788## <#/GAPDoc> 1789## 1790BIND_GLOBAL( "UntraceAllMethods", function( arg ) 1791 local fun; 1792 UntraceMethods(OPERATIONS); 1793end ); 1794 1795############################################################################# 1796## 1797#F DeclareGlobalFunction( <name> ) . . . . . . create a new global function 1798#F InstallGlobalFunction( <oper>, <func> ) 1799## 1800## <#GAPDoc Label="DeclareGlobalFunction"> 1801## <ManSection> 1802## <Func Name="DeclareGlobalFunction" Arg='name'/> 1803## <Func Name="InstallGlobalFunction" Arg='oper, func'/> 1804## 1805## <Description> 1806## <Ref Func="DeclareGlobalFunction"/> 1807## &GAP; functions that are not operations and that are intended to be 1808## called by users should be notified to &GAP; in the declaration part 1809## of the respective package 1810## (see Section <Ref Sect="Declaration and Implementation Part"/>) 1811## via <Ref Func="DeclareGlobalFunction"/>, which returns a function that 1812## serves as a place holder for the function that will be installed later, 1813## and that will print an error message if it is called. 1814## See also <Ref Func="DeclareSynonym"/>. 1815## <P/> 1816## A global function declared with <Ref Func="DeclareGlobalFunction"/> 1817## can be given its value <A>func</A> via 1818## <Ref Func="InstallGlobalFunction"/>; 1819## <A>gvar</A> is the global variable (or a string denoting its name) 1820## named with the <A>name</A> argument of the call to 1821## <Ref Func="DeclareGlobalFunction"/>. 1822## For example, a declaration like 1823## <P/> 1824## <Log><![CDATA[ 1825## DeclareGlobalFunction( "SumOfTwoCubes" ); 1826## ]]></Log> 1827## <P/> 1828## in the <Q>declaration part</Q> 1829## (see Section <Ref Sect="Declaration and Implementation Part"/>) 1830## might have a corresponding <Q>implementation part</Q> of: 1831## <P/> 1832## <Log><![CDATA[ 1833## InstallGlobalFunction( SumOfTwoCubes, function(x, y) return x^3 + y^3; end); 1834## ]]></Log> 1835## <P/> 1836## <!-- Commented out by AK after the withdrowal of completion files: 1837## <E>Note:</E> <A>func</A> must be a function which has <E>not</E> been 1838## declared with <Ref Func="DeclareGlobalFunction"/> itself. 1839## Otherwise completion files 1840## (see <Ref Sect="Completion Files"/>) get confused! --> 1841## </Description> 1842## </ManSection> 1843## <#/GAPDoc> 1844## 1845## Global functions of the &GAP; library must be distinguished from other 1846## global variables (see <C>variable.g</C>) because of the completion 1847## mechanism. 1848## 1849if IsHPCGAP then 1850 BIND_GLOBAL( "GLOBAL_FUNCTION_NAMES", ShareSpecialObj([], "GLOBAL_FUNCTION_NAMES") ); 1851else 1852 BIND_GLOBAL( "GLOBAL_FUNCTION_NAMES", [] ); 1853fi; 1854 1855BIND_GLOBAL( "DeclareGlobalFunction", function( arg ) 1856 local name; 1857 1858 name := arg[1]; 1859 atomic GLOBAL_FUNCTION_NAMES do 1860 ADD_SET( GLOBAL_FUNCTION_NAMES, IMMUTABLE_COPY_OBJ(name) ); 1861 od; 1862 BIND_GLOBAL( name, NEW_GLOBAL_FUNCTION( name ) ); 1863end ); 1864 1865BIND_GLOBAL( "InstallGlobalFunction", function( arg ) 1866 local oper, info, func; 1867 1868 if LEN_LIST(arg) = 3 then 1869 oper := arg[1]; 1870 info := arg[2]; 1871 func := arg[3]; 1872 else 1873 oper := arg[1]; 1874 func := arg[2]; 1875 fi; 1876 if IS_STRING( oper ) then 1877 if not ISBOUND_GLOBAL(oper) then 1878 Error("global function `", oper, "' is not declared yet"); 1879 fi; 1880 oper:= VALUE_GLOBAL( oper ); 1881 fi; 1882 atomic readonly GLOBAL_FUNCTION_NAMES do 1883 if NAME_FUNC(func) in GLOBAL_FUNCTION_NAMES then 1884 Error("you cannot install a global function for another global ", 1885 "function,\nuse `DeclareSynonym' instead!"); 1886 fi; 1887 INSTALL_GLOBAL_FUNCTION( oper, func ); 1888 od; 1889end ); 1890 1891if not IsHPCGAP then 1892 1893BIND_GLOBAL( "FLUSH_ALL_METHOD_CACHES", function() 1894 local oper,j; 1895 for oper in OPERATIONS do 1896 for j in [1..6] do 1897 CHANGED_METHODS_OPERATION(oper,j); 1898 od; 1899 od; 1900end); 1901 1902fi; 1903 1904if BASE_SIZE_METHODS_OPER_ENTRY <> 6 then 1905 Error("MethodsOperation must be updated for new BASE_SIZE_METHODS_OPER_ENTRY"); 1906fi; 1907 1908# TODO: document this?! 1909BIND_GLOBAL("MethodsOperation", function(oper, nargs) 1910 local meths, len, result, i, m; 1911 1912 meths := METHODS_OPERATION(oper, nargs); 1913 if meths = fail then 1914 return fail; 1915 fi; 1916 len := BASE_SIZE_METHODS_OPER_ENTRY + nargs; 1917 result := []; 1918 for i in [0, len .. LENGTH(meths) - len] do 1919 m := rec( 1920 famPred := meths[i + 1], 1921 argFilt := meths{[i + 2 .. i + nargs + 1]}, 1922 func := meths[i + nargs + 2], 1923 rank := meths[i + nargs + 3], 1924 info := meths[i + nargs + 4], 1925 rankbase := meths[i + nargs + 6], 1926 ); 1927 ADD_LIST(result, m); 1928 if IsBound(meths[i + nargs + 5]) then 1929 m.location := meths[i + nargs + 5]; 1930 fi; 1931 od; 1932 return result; 1933end ); 1934 1935 1936############################################################################# 1937## 1938#F CHECK_ALL_METHOD_RANKS 1939## 1940## Debugging helper which checks that all methods are sorted correctly 1941## 1942BIND_GLOBAL( "CHECK_ALL_METHOD_RANKS", function() 1943 local oper, n, meths, i, result; 1944 1945 result := true; 1946 for oper in OPERATIONS do 1947 for n in [0..6] do 1948 meths := MethodsOperation(oper, n); 1949 for i in [2..LENGTH(meths)] do 1950 if meths[i-1].rank < meths[i].rank then 1951 Print("Error, wrong method ordering for '", oper, "' on ", n, " arguments:\n"); 1952 Print(" ", i-1, ": ", meths[i-1].rank, " ", meths[i-1].info, "\n"); 1953 Print(" ", i , ": ", meths[i].rank, " ", meths[i].info, "\n"); 1954 result := false; 1955 fi; 1956 od; 1957 od; 1958 od; 1959 return result; 1960end ); 1961 1962############################################################################# 1963## 1964#F RECALCULATE_ALL_METHOD_RANKS() . . reorder methods after new implications 1965## 1966## Installing new implications (including hidden implications) can change the 1967## rank of existing filters, and so of existing methods for operations. 1968## 1969## This function recalculates all such ranks and adjusts the method ordering 1970## where needed. If the ordering changes, the relevant caches are flushed. 1971## 1972## If PRINT_REORDERED_METHODS is true, it prints some diagnostics (this is a 1973## bit too low-level for Info). 1974## 1975## 1976 1977 1978# 1979# We had to install a placeholder for this in filter.g 1980# 1981Unbind(RECALCULATE_ALL_METHOD_RANKS); 1982 1983PRINT_REORDERED_METHODS := false; 1984 1985BIND_GLOBAL( "RECALCULATE_ALL_METHOD_RANKS", function() 1986 local oper, n, changed, meths, nmethods, i, base, rank, j, req, 1987 req2, k, l, entrysize; 1988 1989 for oper in OPERATIONS do 1990 for n in [0..6] do 1991 changed := false; 1992 meths := METHODS_OPERATION(oper, n); 1993 entrysize := BASE_SIZE_METHODS_OPER_ENTRY+n; 1994 nmethods := LENGTH(meths)/entrysize; 1995 for i in [1..nmethods] do 1996 base := (i-1)*entrysize; 1997 # data for this method is meths{[base+1..base+entrysize]} 1998 rank := meths[base+6+n]; 1999 if IS_FUNCTION(rank) then 2000 rank := rank(); 2001 fi; 2002 2003 # adjust the base rank by the rank of the argument filters 2004 if IS_CONSTRUCTOR(oper) then 2005 Assert(2, n > 0); 2006 rank := rank - RankFilter(meths[base+1+1]); 2007 else 2008 for j in [1..n] do 2009 req := meths[base+1+j]; 2010 rank := rank + RankFilter(req); 2011 od; 2012 fi; 2013 2014 # check if new rank differs from old rank 2015 if rank <> meths[base+n+3] then 2016 if IsHPCGAP and not changed then 2017 meths := SHALLOW_COPY_OBJ(meths); 2018 fi; 2019 changed := true; 2020 meths[base+n+3] := rank; 2021 fi; 2022 2023 # determine how far back we need to adjust the rank 2024 k := i; 2025 while k > 1 and meths[(k-2)*entrysize+n+3] < rank do 2026 k := k-1; 2027 od; 2028 2029 # do nothing if the preceding methods don't have lower rank 2030 if i = k then 2031 continue; 2032 fi; 2033 2034 if PRINT_REORDERED_METHODS then 2035 Print(NAME_FUNC(oper), " ", n," args. Moving method ",i, 2036 " with rank ", rank, 2037 " to position ",k, 2038 " (",meths[base+n+4], 2039 " from ",meths[base+n+5][1],":", meths[base+n+5][2], 2040 ")\n"); 2041 fi; 2042 # extract the current method 2043 l := meths{[base+1..base+entrysize]}; 2044 # move all preceding methods of lower rank 2045 COPY_LIST_ENTRIES(meths, 1 + (k-1)*entrysize, 1, 2046 meths, 1 + k*entrysize, 1, 2047 (i-k)*entrysize); 2048 # insert the current method at its new position 2049 meths{[1 + (k-1)*entrysize..k*entrysize]} := l; 2050 od; 2051 if changed then 2052 if IsHPCGAP then 2053 SET_METHODS_OPERATION(oper,n,MakeReadOnlySingleObj(meths)); 2054 else 2055 CHANGED_METHODS_OPERATION(oper,n); 2056 fi; 2057 fi; 2058 od; 2059 od; 2060 2061 Assert(2, CHECK_ALL_METHOD_RANKS()); 2062end ); 2063