Quelle precord.c Sprache: C

/****************************************************************************
**
**  This file is part of GAP, a system for computational discrete algebra.
**
**  Copyright of GAP belongs to its developers, whose names are too numerous
**  to list here. Please refer to the COPYRIGHT file for details.
**
**  SPDX-License-Identifier: GPL-2.0-or-later
**
**  This file contains the functions for plain records.
**
**  A plain record  with <n>  components is stored  as  a bag  with 2*<n>+2
**  entries.  The odd entries are the record  names of the components and the
**  even entries are the corresponding values.
**  The first pointer in the bag is reserved for the pointer to the type
**  object if the record becomes a component object. The second slot
**  in the bag is the number <n> of components as a C int.
**  Normally, the rnams are sorted such that we can do a binary lookup.
**  However, we allow for lazy sorting. This is done as follows: New
**  components are always appended (record bags grow by a factor of 5/4
**  if needed as plists do), already sorted rnams are stored by storing
**  their negative value to indicate sortedness. The new entries will have
**  positive rnams and can thus be distinguished. Every read access will
**  clean up the mess by sorting the new part and then merging the two
**  sorted areas. After that, all rnams are negative indicating sortedness.
**
*/

#include "precord.h"

#include "ariths.h"
#include "bool.h"
#include "error.h"
#include "funcs.h"
#include "gaputils.h"
#include "io.h"
#include "modules.h"
#include "opers.h"
#include "plist.h"
#include "records.h"
#include "saveload.h"
#include "stringobj.h"

#ifdef HPCGAP
#include "hpc/aobjects.h"
#include "hpc/guards.h"
#include "hpc/traverse.h"
#endif

#include <stdlib.h>     // for qsort

/****************************************************************************
**
*F * * * * * * * * * standard functions for plain records * * * * * * * * * *
*/

/****************************************************************************
**
*F  TypePRec( <rec> ) . . . . . . . . . . . . . . . .  type of a plain record
**
**  'TypePRec' returns the type of the plain record <rec>.
**
**  'TypePRec' is the function in 'TypeObjFuncs' for plain records.
*/
static Obj TYPE_PREC_MUTABLE;
static Obj TYPE_PREC_IMMUTABLE;

static Obj TypePRec(Obj prec)
{
    return IS_MUTABLE_OBJ(prec) ? TYPE_PREC_MUTABLE : TYPE_PREC_IMMUTABLE;
}

/****************************************************************************
**
*F  NEW_PREC( <len> ) . . . . . . . . . . . . . . . . make a new plain record
**
**  'NEW_PREC' returns a new plain record with room for <len> components,
**  already set to length len.
*/
Obj NEW_PREC(UInt len)
{
    Obj o = NewBag( T_PREC, (len) * 2*sizeof(Obj) + 2*sizeof(Obj) );
    SET_LEN_PREC(o,0);
    return o;
}

/****************************************************************************
**
*F  GrowPRec( <rec>, <len> ) . . . .  make sure <rec> can hold <len> components
**
**  Returns 0 if nothing changed and 1 if enlarged.
*/
static Int GrowPRec(Obj rec, UInt need)
{
    UInt                newsize, want, good;

    // check if big enough
    want = (2*need+2)*sizeof(Obj);
    if (SIZE_OBJ(rec) >= want)
        return 0;

    // find out how large the bag should become at least
    good = ((5 * LEN_PREC(rec) + 3)/4 + 1) * 2 * sizeof(Obj) + 2;

    // but maybe we need more
    newsize = (want < good) ? good : want;

    // resize the plain list
    ResizeBag( rec, newsize );

    return 1;
}

#ifdef USE_THREADSAFE_COPYING
#ifndef WARD_ENABLED

void TraversePRecord(TraversalState * traversal, Obj obj)
{
    UInt i, len = LEN_PREC(obj);
    for (i = 1; i <= len; i++)
        QueueForTraversal(traversal, (Obj)GET_ELM_PREC(obj, i));
}

void CopyPRecord(TraversalState * traversal, Obj copy, Obj original)
{
    UInt i, len = LEN_PREC(original);
    for (i = 1; i <= len; i++)
        SET_ELM_PREC(copy, i, ReplaceByCopy(traversal, GET_ELM_PREC(original, i)));
}

#endif // WARD_ENABLED
#else

/****************************************************************************
**
*F  CopyPRec( <rec> ) . . . . . . . . . . . . . . . . . . copy a plain record
*F  CleanPRec( <rec> )  . . . . . . . . . . . . . . . clean up a plain record
**
**  'CopyPRec' returns a structural (deep) copy  of the record <rec>, i.e., a
**  recursive copy that preserves the structure.
**
**  If <rec>  has not yet  been  copied, it makes a   copy, leaves a  forward
**  pointer to the copy in  the first entry   of the record, where the  first
**  record name usually resides,  and copies all the  entries.  If the record
**  has already been copied, it returns the value of the forwarding pointer.
**
**  'CopyPRec' is the function in 'CopyObjFuncs' for records.
**
**  'CleanPRec' removes the  mark and the forwarding  pointer from the record
**  <rec>.
**
**  'CleanPRec' is the function in 'CleanObjFuncs' for records.
*/
static Obj CopyPRec(Obj rec, Int mut)
{
    Obj                 copy;           // copy, result
    Obj                 tmp;            // temporary variable

    // immutable input is handled by COPY_OBJ
    GAP_ASSERT(IS_MUTABLE_OBJ(rec));

    // make a copy
    copy = NewBag(T_PREC, SIZE_OBJ(rec));
    if (!mut)
        MakeImmutableNoRecurse(copy);
    memcpy(ADDR_OBJ(copy), CONST_ADDR_OBJ(rec), SIZE_OBJ(rec));

    // leave a forwarding pointer
    PrepareCopy(rec, copy);

    // copy the subvalues; since we used memcpy above, we don't need to worry
    // about copying the length or RNAMs; and by working solely inside the
    // copy, we avoid triggering tnum assertions in GET_ELM_PREC and
    // SET_ELM_PREC
    const UInt len = LEN_PREC(copy);
    for (UInt i = 1; i <= len; i++) {
        tmp = COPY_OBJ(GET_ELM_PREC(copy, i), mut);
        SET_ELM_PREC(copy, i, tmp);
        CHANGED_BAG(copy);
    }

    // return the copy
    return copy;
}

static void CleanPRec(Obj rec)
{
    UInt                i;              // loop variable

    // clean the subvalues
    for ( i = 1; i <= LEN_PREC(rec); i++ ) {
        CLEAN_OBJ( GET_ELM_PREC( rec, i ) );
    }
}

#endif //!defined(USE_THREADSAFE_COPYING)

/****************************************************************************
**
*F  MakeImmutablePRec( <rec> )
*/

static void MakeImmutablePRec(Obj rec)
{
    // change the tnum first, to avoid infinite recursion for objects that
    // contain themselves
    MakeImmutableNoRecurse(rec);

    // FIXME HPC-GAP: there is a potential race here: <rec> becomes public
    // the moment we change its type, but it's not ready for public access
    // until the following code completed.

    UInt len = LEN_PREC(rec);
    for (UInt i = 1; i <= len; i++)
        MakeImmutable(GET_ELM_PREC(rec, i));

    // Sort the record at this point. This can never hurt, unless the record
    // will never be accessed again anyway. But for HPC-GAP it is essential so
    // that immutable records are actually binary unchanging.
    SortPRecRNam(rec);
}

/****************************************************************************
* FindPRec( <rec>, <rnam>, <pos>, <cleanup> )
*   . . . . . . . . . . . . . . . . . find a component name by binary search
*
* Searches rnam in rec, sets pos to the position where it is found (return
* value 1) or where it should be inserted if it is not found (return val 0).
* If cleanup is nonzero, a dirty record is automatically cleaned up.
* If cleanup is 0, this does not happen.
*/
UInt PositionPRec(Obj rec, UInt rnam, int cleanup)
{
    // This only assumes that the rnam values in the record are sorted!
    UInt low = 1;
    UInt high = LEN_PREC(rec);
    if (high > 0 && GET_RNAM_PREC(rec, high) > 0) {
        // DIRTY! Not everything sorted!
#ifdef HPCGAP
        // FIXME: Need to sort records before making them
        // readonly or sharing them. This can be done in
        // the traversal routines (in principle).
        if (cleanup && CheckExclusiveWriteAccess(rec)) {
#else
        if (cleanup) {
#endif
            SortPRecRNam(rec);
        } else {
            // We are not allowed to cleanup, so we live with it, we
            // first try to find rnam in the mess at the end, then
            // fall back to binary search:
            UInt i = high;
            while (i >= 1) {
                Int rnam2 = GET_RNAM_PREC(rec, i);
                if (rnam == rnam2) {
                    GAP_ASSERT(i != 0);
                    return i;
                }
                if (rnam2 < 0) { // reached the sorted area!
                    high = i;  // will be incremented by 1
                    break;
                }
                i--;
            }
            if (i == 0) return 0;
            // Here, high is the number of the sorted entries.
        }
    }
    high++;
    Int rnam2 = 0;
    // Negate rnam, as the sorted part of the record is stored negated
    rnam = -rnam;
    while (low < high) {
        UInt i = (low + high) / 2; // we always have low <= i < high
        rnam2 = GET_RNAM_PREC(rec, i);
        if (rnam2 > rnam) {
            low = i + 1;
        }
        else if (rnam2 < rnam) {
            high = i;
        }
        else {
            return i;
        }
    }

    return 0;
}

/****************************************************************************
**
*F  IsbPRec( <rec>, <rnam> )  . . . . test for an element from a plain record
**
**  'IsbPRec' returns 1 if the record <rec> has a component with  the  record
**  name <rnam>, and 0 otherwise.
*/
BOOL IsbPRec(Obj rec, UInt rnam)
{
    return PositionPRec(rec, rnam, 1) != 0;
}

/****************************************************************************
**
*F  ElmPRec( <rec>, <rnam> )  . . . . . select an element from a plain record
**
**  'ElmPRec' returns the element, i.e., the value of the component, with the
**  record name <rnam> in  the plain record <rec>.   An error is signalled if
**  <rec> has no component with record name <rnam>.
*/
Obj ElmPRec (
    Obj                 rec,
    UInt                rnam )
{
    UInt i = PositionPRec(rec, rnam, 1);
    if (i)
        return GET_ELM_PREC( rec, i );

    ErrorMayQuit("Record Element: '.%g' must have an assigned value",
                 (Int)NAME_RNAM(rnam), 0);
}

/****************************************************************************
**
*F  UnbPRec( <rec>, <rnam> )  . unbind a record component from a plain record
**
**  'UnbPRec'  removes the record component  with the record name <rnam> from
**  the record <rec>.
*/
void UnbPRec (
    Obj                 rec,
    UInt                rnam )
{
    UInt                len;            // length of <rec>

    // Accept T_PREC and T_COMOBJ, reject T_PREC+IMMUTABLE
    if (TNUM_OBJ(rec) == T_PREC+IMMUTABLE) {
        ErrorMayQuit("Record Unbind: must be a mutable record", 0, 0);
    }

    UInt i = PositionPRec(rec, rnam, 1);

    if (i) {
        // otherwise move everything forward
        len = LEN_PREC( rec );
        for ( ; i < len; i++ ) {
            SET_RNAM_PREC( rec, i, GET_RNAM_PREC( rec, i+1 ) );
            SET_ELM_PREC(  rec, i, GET_ELM_PREC(  rec, i+1 ) );
        }
        SET_RNAM_PREC( rec, len, 0 );
        SET_ELM_PREC( rec, len, 0 );

        // resize the record
        SET_LEN_PREC(rec,LEN_PREC(rec)-1);
    }
    else
        // do nothing if no such component exists
        return;
}

/****************************************************************************
**
*F  AssPRec( <rec>, <rnam>, <val> ) . . . . . . . .  assign to a plain record
**
**  'AssPRec' assigns the value <val> to the record component with the record
**  name <rnam> in the plain record <rec>.
*/
void AssPRec (
    Obj                 rec,
    UInt                rnam,
    Obj                 val )
{
    UInt                len;            // length of <rec>

    // Accept T_PREC and T_COMOBJ, reject T_PREC+IMMUTABLE
    if (TNUM_OBJ(rec) == T_PREC+IMMUTABLE) {
        ErrorMayQuit("Record Assignment: must be a mutable record", 0,
                     0);
    }

    // get the length of the record
    len = LEN_PREC( rec );

    if (len % 1000 == 0) {   // A hack to occasionally do some cleanup!
        SortPRecRNam(rec);
    }

    UInt i = PositionPRec(rec, rnam, 0);

    if (!i) {
        // No cleanup allowed here to allow for multiple assignments!
        // extend the record if no such component exists
        len++;
        GrowPRec(rec, len);
        i = len;
        SET_RNAM_PREC( rec, i, rnam );
        SET_LEN_PREC(rec,len);
    }
    // assign the value to the component
    SET_ELM_PREC( rec, i, val );
    CHANGED_BAG( rec );
}

/****************************************************************************
**
*F  PrintPRec( <rec> )  . . . . . . . . . . . . . . . . . . .  print a record
**
**  'PrintRec' prints the plain record <rec>.
*/
static void PrintPRec(Obj rec)
{
    DoOperation1Args( PrintObjOper, rec );
}

/****************************************************************************
**
*F  SortPRecRNam(<rec>) . . . . . . . . . . . .  sort the Rnams of the record
**
**  This is needed after the components of a record have been assigned
**  in not necessarily sorted order in the kernel. It is automatically
**  called on the first read access if necessary. See the top of "precord.c"
**  for a comment on lazy sorting.
*/
static int PrecComparer(const void *a, const void *b)
{
    const UInt *aa = (const UInt *) a;
    const UInt *bb = (const UInt *) b;
    if (*aa < *bb) return -1;
    else if (*aa == *bb) return 0;
    else return 1;
}

void SortPRecRNam(Obj rec)
{
    UInt len = LEN_PREC(rec);
    UInt i,j,k,save;
    int issorted = 1;
    Obj space;

    // Nothing has to be done if it is already sorted:
    if (len == 0 || GET_RNAM_PREC(rec, len) < 0)
        return;

    // First find the "unsorted part" and check whether it is sorted!
    for (i = len - 1; i >= 1 && GET_RNAM_PREC(rec, i) > 0; i--) {
        if (issorted && GET_RNAM_PREC(rec,i) > GET_RNAM_PREC(rec,i+1)) {
            issorted = 0;
        }
    }
    i++;
    // Now i points to the last positive (and thus still unsorted)
    // component and issorted is 1 iff positions i to len are sorted!
    if (!issorted && len - i + 1 > 1) {
        qsort( ADDR_OBJ(rec)+2*i, len-i+1, 2*sizeof(Obj), &PrecComparer );
    }
    // Now i points to the first positive component and the rest is
    // sorted.
    save = i;
    if (save == 1 ||
        -GET_RNAM_PREC(rec, save - 1) < GET_RNAM_PREC(rec, save)) {
        // Otherwise, nothing has to be done since it is already
        // sorted, we only have to negate the RNams!
        for (j = save;j <= len;j++)
            SET_RNAM_PREC(rec, j, -GET_RNAM_PREC(rec, j));
        return;
    }
    // Next we perform a merge sort on the two presorted areas.
    // For optimal performance, we need some space to mess around:
    space = NEW_PREC(len);
    j = 1;
    k = 1;
    while (j < save && i <= len) {
        if (-GET_RNAM_PREC(rec, j) < GET_RNAM_PREC(rec, i)) {
            SET_RNAM_PREC(space,k,GET_RNAM_PREC(rec,j));
            SET_ELM_PREC(space,k,GET_ELM_PREC(rec,j));
            j++; k++;
        }
        else {
            SET_RNAM_PREC(space, k, -GET_RNAM_PREC(rec, i));
            SET_ELM_PREC(space,k,GET_ELM_PREC(rec,i));
            i++; k++;
        }
    }
    // Copy the rest of the part still missing:
    while (j < save) {
        SET_RNAM_PREC(space, k, GET_RNAM_PREC(rec, j));
        SET_ELM_PREC(space, k, GET_ELM_PREC(rec, j));
        j++;
        k++;
    }
    while (i <= len) {
        SET_RNAM_PREC(space, k, -GET_RNAM_PREC(rec, i));
        SET_ELM_PREC(space, k, GET_ELM_PREC(rec, i));
        i++;
        k++;
    }
    // Finally, copy everything back to where it came from:
    memcpy(ADDR_OBJ(rec) + 2, CONST_ADDR_OBJ(space) + 2,
           sizeof(Obj) * 2 * len);
}

/****************************************************************************
**
*F * * * * * * * * * * * default functions for records  * * * * * * * * * * *
*/

/****************************************************************************
**
*F  FuncREC_NAMES( <self>, <rec> )  . . . . . . . .  record names of a record
**
**  'FuncREC_NAMES' implements a method for the operations 'RecNames'.
**
**  'RecNames( <rec> )'
**
**  'RecNames'  returns a list containing the  names of the components of the
**  record <rec> as strings.
*/
static Obj InnerRecNames(Obj rec)
{
    Obj                 list;           // list of record names, result
    UInt                rnam;           // one name of record
    Obj                 string;         // one name as string
    UInt                i;
    Obj                 name;
    SortPRecRNam(rec);   // Make sure rnams are sorted and thus negative

    // allocate the list
    list = NEW_PLIST( T_PLIST, LEN_PREC(rec) );
    SET_LEN_PLIST( list, LEN_PREC(rec) );

    // loop over the components
    for ( i = 1; i <= LEN_PREC(rec); i++ ) {
        rnam = -GET_RNAM_PREC(rec, i);
        // could have been moved by garbage collection
        name = NAME_RNAM( rnam );
        string = CopyToStringRep( name );
        SET_ELM_PLIST( list, i, string );
        CHANGED_BAG( list );
    }

    // return the list
    return list;
}

static Obj FuncREC_NAMES(Obj self, Obj rec)
{
    if (IS_PREC(rec)) {
        return InnerRecNames(rec);
    }
#ifdef HPCGAP
    if (TNUM_OBJ(rec) == T_AREC) {
        return InnerRecNames(FromAtomicRecord(rec));
    }
#endif
    RequireArgument(SELF_NAME, rec, "must be a record");
    return Fail;
}

/****************************************************************************
**
*F  FuncREC_NAMES_COMOBJ( <self>, <rec> ) . . . record names of a record object
*/
// same as FuncREC_NAMES except for different argument check
static Obj FuncREC_NAMES_COMOBJ(Obj self, Obj rec)
{
    switch (TNUM_OBJ(rec)) {
      case T_COMOBJ:
        return InnerRecNames(rec);
#ifdef HPCGAP
      case T_ACOMOBJ:
        return InnerRecNames(FromAtomicRecord(rec));
#endif
    }
    RequireArgument(SELF_NAME, rec, "must be a component object");
    return Fail;
}

/****************************************************************************
**
*F  EqPRec( <self>, <left>, <right> ) . . . . . . . comparison of two records
**
**  'EqPRec' returns '1'  if the two  operands <left> and <right> are equal
**  and '0' otherwise.  At least one operand must be a plain record.
*/
static Int EqPRec(Obj left, Obj right)
{
    UInt                i;              // loop variable

    // quick first checks
    GAP_ASSERT(IS_PREC(left));
    GAP_ASSERT(IS_PREC(right));
    if ( LEN_PREC(left) != LEN_PREC(right) )
        return 0;

    // ensure records are sorted by their RNam
    SortPRecRNam(left);
    SortPRecRNam(right);

    CheckRecursionBefore();

    // compare componentwise
    for ( i = 1; i <= LEN_PREC(right); i++ ) {

        // compare the names
        if ( GET_RNAM_PREC(left,i) != GET_RNAM_PREC(right,i) ) {
            DecRecursionDepth();
            return 0;
        }

        // compare the values
        if ( ! EQ(GET_ELM_PREC(left,i),GET_ELM_PREC(right,i)) ) {
            DecRecursionDepth();
            return 0;
        }
    }

    // the records are equal
    DecRecursionDepth();
    return 1;
}

/****************************************************************************
**
*F  LtPRec( <self>, <left>, <right> ) . . . . . . . comparison of two records
**
**  'LtPRec' returns '1'  if the operand  <left> is  less than the  operand
**  <right>, and '0'  otherwise.  At least  one operand  must be a  plain
**  record.
*/
static Int LtPRec(Obj left, Obj right)
{
    UInt                i;              // loop variable
    Int                 res;            // result of comparison

    // quick first checks
    GAP_ASSERT(IS_PREC(left));
    GAP_ASSERT(IS_PREC(right));

    // ensure records are sorted by their RNam
    SortPRecRNam(left);
    SortPRecRNam(right);

    CheckRecursionBefore();
    res = 0;

    // compare componentwise
    for ( i = 1; i <= LEN_PREC(right); i++ ) {

        // if the left is a proper prefix of the right one
        if ( LEN_PREC(left) < i ) {
            res = 1;
            break;
        }

        // compare the names
        //
        // The sense of this comparison is determined by the rule that
        // unbound entries compare less than bound ones
        if ( GET_RNAM_PREC(left,i) != GET_RNAM_PREC(right,i) ) {
            res = !LT(NAME_RNAM(-GET_RNAM_PREC(left, i)),
                      NAME_RNAM(-GET_RNAM_PREC(right, i)));
            break;
        }

        // compare the values
        if ( ! EQ(GET_ELM_PREC(left,i),GET_ELM_PREC(right,i)) ) {
            res = LT( GET_ELM_PREC(left,i), GET_ELM_PREC(right,i) );
            break;
        }

    }

    // the records are equal or the right is a prefix of the left
    DecRecursionDepth();
    return res;
}

/****************************************************************************
**
*F  SavePRec( <prec> )
**
*/
#ifdef GAP_ENABLE_SAVELOAD
static void SavePRec(Obj prec)
{
  UInt len,i;
  len = LEN_PREC(prec);
  SaveUInt(len);
  for (i = 1; i <= len; i++)
    {
      SaveUInt(GET_RNAM_PREC(prec, i));
      SaveSubObj(GET_ELM_PREC(prec, i));
    }
}
#endif

/****************************************************************************
**
*F  LoadPRec( <prec> )
**
*/
#ifdef GAP_ENABLE_SAVELOAD
static void LoadPRec(Obj prec)
{
  UInt len,i;
  len = LoadUInt();
  SET_LEN_PREC(prec,len);
  for (i = 1; i <= len; i++)
    {
      SET_RNAM_PREC(prec, i, LoadUInt());
      SET_ELM_PREC(prec, i, LoadSubObj());
    }
}
#endif

/****************************************************************************
**
*F  MarkPRecSubBags( <bag> ) . . . . marking function for precs and com. objs
**
**  'MarkPRecSubBags' is the marking function for bags of type 'T_PREC' or
**  'T_COMOBJ'.
*/
void MarkPRecSubBags(Obj bag, void * ref)
{
    const Bag * data = CONST_PTR_BAG(bag);
    const UInt count = SIZE_BAG(bag) / sizeof(Bag);

    // data[0] is unused for regular precords, but it is used during copying
    // to store a pointer to the copy; moreover, this mark function is also
    // used for component objects, which store their type in slot 0
    MarkBag(data[0], ref);

    for (UInt i = 3; i < count; i += 2) {
        MarkBag(data[i], ref);
    }
}

/****************************************************************************
**
*F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
*/

/****************************************************************************
**
*V  BagNames  . . . . . . . . . . . . . . . . . . . . . . . list of bag names
*/
static StructBagNames BagNames[] = {
  { T_PREC,                     "record (plain)"            },
  { T_PREC +IMMUTABLE,          "record (plain,imm)"        },
  { -1,                         ""                          }
};

/****************************************************************************
**
*V  GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
*/
static StructGVarFunc GVarFuncs [] = {

    GVAR_FUNC_1ARGS(REC_NAMES, rec),
    GVAR_FUNC_1ARGS(REC_NAMES_COMOBJ, rec),
    { 0, 0, 0, 0, 0 }

};

/****************************************************************************
**
*F  InitKernel( <module> )  . . . . . . . . initialise kernel data structures
*/
static Int InitKernel (
    StructInitInfo *    module )
{
    // GASMAN marking functions and GASMAN names
    InitBagNamesFromTable( BagNames );

    InitMarkFuncBags( T_PREC                     , MarkPRecSubBags );
    InitMarkFuncBags( T_PREC +IMMUTABLE          , MarkPRecSubBags );

#ifdef HPCGAP
    // Immutable records are public
    MakeBagTypePublic( T_PREC +IMMUTABLE );
#endif

    // init filters and functions
    InitHdlrFuncsFromTable( GVarFuncs );

#ifdef GAP_ENABLE_SAVELOAD
    // Install saving functions
    SaveObjFuncs[ T_PREC            ] = SavePRec;
    SaveObjFuncs[ T_PREC +IMMUTABLE ] = SavePRec;
    LoadObjFuncs[ T_PREC            ] = LoadPRec;
    LoadObjFuncs[ T_PREC +IMMUTABLE ] = LoadPRec;
#endif

    // install into record function tables
    ElmRecFuncs[ T_PREC            ] = ElmPRec;
    ElmRecFuncs[ T_PREC +IMMUTABLE ] = ElmPRec;
    IsbRecFuncs[ T_PREC            ] = IsbPRec;
    IsbRecFuncs[ T_PREC +IMMUTABLE ] = IsbPRec;
    AssRecFuncs[ T_PREC            ] = AssPRec;
    AssRecFuncs[ T_PREC +IMMUTABLE ] = AssPRec;
    UnbRecFuncs[ T_PREC            ] = UnbPRec;
    UnbRecFuncs[ T_PREC +IMMUTABLE ] = UnbPRec;

    // install tests for being copyable
    IsCopyableObjFuncs[ T_PREC            ] = AlwaysYes;
    IsCopyableObjFuncs[ T_PREC +IMMUTABLE ] = AlwaysYes;

#ifdef USE_THREADSAFE_COPYING
    SetTraversalMethod(T_PREC           , TRAVERSE_BY_FUNCTION, TraversePRecord, CopyPRecord);
    SetTraversalMethod(T_PREC +IMMUTABLE, TRAVERSE_BY_FUNCTION, TraversePRecord, CopyPRecord);
#else
    // install into copy function tables
    CopyObjFuncs [ T_PREC                     ] = CopyPRec;
    CopyObjFuncs [ T_PREC +IMMUTABLE          ] = CopyPRec;
    CleanObjFuncs[ T_PREC                     ] = CleanPRec;
    CleanObjFuncs[ T_PREC +IMMUTABLE          ] = CleanPRec;
#endif

    // install printer
    PrintObjFuncs[  T_PREC            ] = PrintPRec;
    PrintObjFuncs[  T_PREC +IMMUTABLE ] = PrintPRec;

    // install the comparison methods
    for (UInt t1 = T_PREC; t1 <= T_PREC + IMMUTABLE; t1++) {
        for (UInt t2 = T_PREC; t2 <= T_PREC + IMMUTABLE; t2++) {
            EqFuncs[t1][t2] = EqPRec;
            LtFuncs[t1][t2] = LtPRec;
        }
    }

    // install the type functions
    ImportGVarFromLibrary( "TYPE_PREC_MUTABLE",   &TYPE_PREC_MUTABLE   );
    ImportGVarFromLibrary( "TYPE_PREC_IMMUTABLE", &TYPE_PREC_IMMUTABLE );

    TypeObjFuncs[ T_PREC            ] = TypePRec;
    TypeObjFuncs[ T_PREC +IMMUTABLE ] = TypePRec;

    MakeImmutableObjFuncs[ T_PREC   ] = MakeImmutablePRec;

    return 0;
}

/****************************************************************************
**
*F  InitLibrary( <module> ) . . . . . . .  initialise library data structures
*/
static Int InitLibrary (
    StructInitInfo *    module )
{
    // init filters and functions
    InitGVarFuncsFromTable( GVarFuncs );

    return 0;
}

/****************************************************************************
**
*F  InitInfoPRecord() . . . . . . . . . . . . . . . . table of init functions
*/
static StructInitInfo module = {
    // init struct using C99 designated initializers; for a full list of
    // fields, please refer to the definition of StructInitInfo
    .type = MODULE_BUILTIN,
    .name = "precord",
    .initKernel = InitKernel,
    .initLibrary = InitLibrary,
};

StructInitInfo * InitInfoPRecord ( void )
{
    return &module;
}

quality86%

¤ Dauer der Verarbeitung: 0.40 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.