kernel: replace IMMUTABLE by OBJ_FLAG_IMMUTABLE

lib/mat8bit.gi

@@ -849,10 +849,10 @@ InstallGlobalFunction( RepresentationsOfMatrix,
             Print(" compressed over GF(",Q_VEC8BIT(m),") ");
         elif IsPlistRep(m) then
             Print(" plain list, tnum: ",TNUM_OBJ(m)," ");
-            if TNUM_OBJ(m) in [T_PLIST_FFE,T_PLIST_FFE+1] then
+            if TNUM_OBJ(m) = T_PLIST_FFE then
                 Print("known to be vecffe over GF(",CHAR_FFE_DEFAULT(m[1]),"^",
                       DEGREE_FFE_DEFAULT(m[1]),") ");
-            elif TNUM_OBJ(m) in [T_PLIST_CYC..T_PLIST_CYC_SSORT+1] then
+            elif TNUM_OBJ(m) in [T_PLIST_CYC..T_PLIST_CYC_SSORT] then
                 Print("known to be vector of cyclotomics ");
             fi;
         else

src/bags.c

@@ -10,7 +10,11 @@
 
 #include "error.h"
 #include "gasman.h"
-#include "objects.h"    // HACK: for FIRST_IMM_MUT_TNUM; remove this later
+#include "objects.h"
+
+#ifdef HPCGAP
+#include "hpc/guards.h"
+#endif
 
 /****************************************************************************
 **
@@ -24,82 +28,31 @@ TNumInfoBags InfoBags[NUM_TYPES];
 UInt8 SizeAllBags;
 
 
-#ifdef GAP_KERNEL_DEBUG
-void PrecheckRetypeBag(Bag bag, UInt new_type)
+// An object which records its mutability in its type, such as a compressed
+// vector, needs the flag once it turns into a list or record.
+static void KeepMutability(Bag bag, UInt new_type)
 {
-    // If the new type contains an (im)mutability bit, verify that this does
-    // not remove mutability from an object that was previously mutable --
-    // something we generally don't allow
-    if (FIRST_IMM_MUT_TNUM <= new_type && new_type <= LAST_IMM_MUT_TNUM) {
-#if !defined(USE_THREADSAFE_COPYING)
-        // HACK: T_COPYING is used for mutable and immutable objects alike, so
-        // we can't really determine whether it is "mutable" or not. In
-        // fact, it is not even a "real" TNUM (it comes after LAST_REAL_TNUM),
-        // so asking such an object for mutability is not even supported.
-        //
-        // In the future, there are at least two ways we could get rid of this
-        // hack: Either we drop T_COPYING by adopting the copying code from
-        // HPC-GAP for regular GAP as well. Or we could add an
-        // IMMUTABLE_OBJ_FLAG which can be used to mark any object as
-        // immutable, including T_COPYING objects.
-        if (TNUM_BAG(bag) == T_COPYING)
-            return;
-#endif
-
-        // Some GAP code and packages (including EDIM) produce invalid
-        // T_DATOBJ objects without correct type info, so skip T_DATOBJ for now
-        if (IS_DATOBJ(bag))
-            return;
-
-#ifndef HPCGAP
-        // HACK: when using `DeclareGlobalVariable`, the placeholder object of
-        // type `IsToBeDefinedObj` is immutable, while `InstallValue` also
-        // accepts mutable values, which are then copied into the placeholder
-        // *bag* itself, thus turning the placeholder (which is a T_POSOBJ)
-        // into any different kind of bag, including mutable ones.
-        if (TNUM_BAG(bag) == T_POSOBJ)
-            return;
-#endif
-        Int oldImm = !IS_MUTABLE_OBJ(bag);
-        Int newImm = new_type & IMMUTABLE;
-        if (oldImm && !newImm) {
-            ErrorMayQuit(
-                "RetypeBag: cannot change immutable object to mutable", 0, 0);
-        }
-    }
+    if (new_type < FIRST_IMM_MUT_TNUM || LAST_IMM_MUT_TNUM < new_type)
+        return;
+    if (IS_MUTABLE_OBJ(bag))
+        CLEAR_OBJ_FLAG(bag, OBJ_FLAG_IMMUTABLE);
+    else
+        SET_OBJ_FLAG(bag, OBJ_FLAG_IMMUTABLE);
 }
-#endif
-
 
 // TODO: perhaps this should become RetypeObj ?
 void RetypeBagSM(Bag bag, UInt new_type)
 {
-    if (FIRST_IMM_MUT_TNUM <= new_type && new_type <= LAST_IMM_MUT_TNUM) {
-        Int oldImm = !IS_MUTABLE_OBJ(bag);
-        Int newImm = new_type & IMMUTABLE;
-        if (newImm)
-            ErrorMayQuit(
-                "RetypeBagSM: target tnum should not indicate immutability",
-                0, 0);
-        if (oldImm)
-            new_type |= IMMUTABLE;
-    }
+    KeepMutability(bag, new_type);
     RetypeBag(bag, new_type);
 }
 
 #ifdef HPCGAP
 void RetypeBagSMIfWritable(Bag bag, UInt new_type)
 {
-    if (FIRST_IMM_MUT_TNUM <= new_type && new_type <= LAST_IMM_MUT_TNUM) {
-        Int oldImm = !IS_MUTABLE_OBJ(bag);
-        Int newImm = new_type & IMMUTABLE;
-        if (newImm)
-            ErrorMayQuit(
-                "RetypeBagSM: target tnum should not indicate immutability",
-                0, 0);
-        if (oldImm)
-            new_type |= IMMUTABLE;
-    }
-    RetypeBagIfWritable(bag, new_type);
+    if (!CheckWriteAccess(bag))
+        return;
+    KeepMutability(bag, new_type);
+    RetypeBag(bag, new_type);
 }
 #endif

src/blister.c

@@ -216,7 +216,7 @@ static Obj DoCopyBlist(Obj list, Int mut)
     Obj copy;
 
     // make a copy
-    copy = NewBag(MUTABLE_TNUM(TNUM_OBJ(list)), SIZE_OBJ(list));
+    copy = NewBag(TNUM_OBJ(list), SIZE_OBJ(list));
     if (!mut)
         MakeImmutableNoRecurse(copy);
 
@@ -1707,11 +1707,8 @@ static void MakeImmutableBlist(Obj blist)
 */
 static StructBagNames BagNames[] = {
   { T_BLIST,                           "list (boolean)"                  },
-  { T_BLIST       +IMMUTABLE,          "list (boolean,imm)"              },
   { T_BLIST_NSORT,                     "list (boolean,nsort)"            },
-  { T_BLIST_NSORT +IMMUTABLE,          "list (boolean,nsort,imm)"        },
   { T_BLIST_SSORT,                     "list (boolean,ssort)"            },
-  { T_BLIST_SSORT +IMMUTABLE,          "list (boolean,ssort,imm)"        },
   { -1,                                ""                                }
 };
 
@@ -1896,25 +1893,14 @@ static Int InitKernel (
     // GASMAN marking functions and GASMAN names
     InitBagNamesFromTable( BagNames );
 
-    for ( t1 = T_BLIST;  t1 <= T_BLIST_SSORT;  t1 += 2 ) {
+    for ( t1 = T_BLIST;  t1 <= T_BLIST_SSORT;  t1++ ) {
         InitMarkFuncBags( t1                     , MarkNoSubBags  );
-        InitMarkFuncBags( t1 +IMMUTABLE          , MarkNoSubBags  );
     }
 
     // Make immutable blists public
-#ifdef HPCGAP
-    for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
-        MakeBagTypePublic( t1 + IMMUTABLE );
-    }
-#endif
-
-    // install the type methods
     TypeObjFuncs[ T_BLIST            ] = TypeBlist;
-    TypeObjFuncs[ T_BLIST +IMMUTABLE ] = TypeBlist;
     TypeObjFuncs[ T_BLIST_NSORT            ] = TypeBlistNSort;
-    TypeObjFuncs[ T_BLIST_NSORT +IMMUTABLE ] = TypeBlistNSort;
     TypeObjFuncs[ T_BLIST_SSORT            ] = TypeBlistSSort;
-    TypeObjFuncs[ T_BLIST_SSORT +IMMUTABLE ] = TypeBlistSSort;
 
     // initialise list tables
     InitClearFiltsTNumsFromTable   ( ClearFiltsTab );
@@ -1924,74 +1910,52 @@ static Int InitKernel (
 
 #ifdef GAP_ENABLE_SAVELOAD
     // Install the saving functions -- cannot save while copying
-    for ( t1 = T_BLIST;  t1 <= T_BLIST_SSORT;  t1 += 2 ) {
+    for ( t1 = T_BLIST;  t1 <= T_BLIST_SSORT;  t1++ ) {
         SaveObjFuncs[ t1            ] = SaveBlist;
-        SaveObjFuncs[ t1 +IMMUTABLE ] = SaveBlist;
         LoadObjFuncs[ t1            ] = LoadBlist;
-        LoadObjFuncs[ t1 +IMMUTABLE ] = LoadBlist;
     }
 #endif
 
     // install the copy functions
-    for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
+    for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1++ ) {
 #if !defined(USE_THREADSAFE_COPYING)
         CopyObjFuncs [ t1                     ] = CopyBlist;
-        CopyObjFuncs [ t1 +IMMUTABLE          ] = CopyBlist;
         CleanObjFuncs[ t1                     ] = 0;
-        CleanObjFuncs[ t1 +IMMUTABLE          ] = 0;
 #endif
         ShallowCopyObjFuncs[ t1               ] = ShallowCopyBlist;
-        ShallowCopyObjFuncs[ t1 +IMMUTABLE    ] = ShallowCopyBlist;
     }
 
     // install the comparison methods
-    for ( t1 = T_BLIST;  t1 <= T_BLIST_SSORT+IMMUTABLE;  t1++ ) {
-        for ( t2 = T_BLIST;  t2 <= T_BLIST_SSORT+IMMUTABLE;  t2++ ) {
+    for ( t1 = T_BLIST;  t1 <= T_BLIST_SSORT;  t1++ ) {
+        for ( t2 = T_BLIST;  t2 <= T_BLIST_SSORT;  t2++ ) {
             EqFuncs[ t1 ][ t2 ] = EqBlist;
         }
     }
 
     // install the list functions in the tables
-    for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
+    for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 ++ ) {
         LenListFuncs    [ t1            ] = LenBlist;
-        LenListFuncs    [ t1 +IMMUTABLE ] = LenBlist;
         IsbListFuncs    [ t1            ] = IsbBlist;
-        IsbListFuncs    [ t1 +IMMUTABLE ] = IsbBlist;
         Elm0ListFuncs   [ t1            ] = Elm0Blist;
-        Elm0ListFuncs   [ t1 +IMMUTABLE ] = Elm0Blist;
         Elm0vListFuncs  [ t1            ] = Elm0vBlist;
-        Elm0vListFuncs  [ t1 +IMMUTABLE ] = Elm0vBlist;
         ElmListFuncs    [ t1            ] = ElmBlist;
-        ElmListFuncs    [ t1 +IMMUTABLE ] = ElmBlist;
         ElmvListFuncs   [ t1            ] = ElmvBlist;
-        ElmvListFuncs   [ t1 +IMMUTABLE ] = ElmvBlist;
         ElmwListFuncs   [ t1            ] = ElmvBlist;
-        ElmwListFuncs   [ t1 +IMMUTABLE ] = ElmvBlist;
         ElmsListFuncs   [ t1            ] = ElmsBlist;
-        ElmsListFuncs   [ t1 +IMMUTABLE ] = ElmsBlist;
         UnbListFuncs    [ t1            ] = UnbBlist;
         AssListFuncs    [ t1            ] = AssBlist;
         AsssListFuncs   [ t1            ] = AsssListDefault;
         IsDenseListFuncs[ t1            ] = AlwaysYes;
-        IsDenseListFuncs[ t1 +IMMUTABLE ] = AlwaysYes;
         IsHomogListFuncs[ t1            ] = IsHomogBlist;
-        IsHomogListFuncs[ t1 +IMMUTABLE ] = IsHomogBlist;
         IsTableListFuncs[ t1            ] = AlwaysNo;
-        IsTableListFuncs[ t1 +IMMUTABLE ] = AlwaysNo;
         IsPossListFuncs [ t1            ] = IsPossBlist;
-        IsPossListFuncs [ t1 +IMMUTABLE ] = IsPossBlist;
         PosListFuncs    [ t1            ] = PosBlist;
-        PosListFuncs    [ t1 +IMMUTABLE ] = PosBlist;
         PlainListFuncs  [ t1            ] = PlainBlist;
-        PlainListFuncs  [ t1 +IMMUTABLE ] = PlainBlist;
         MakeImmutableObjFuncs [ t1      ] = MakeImmutableBlist;
     }
     IsSSortListFuncs[ T_BLIST            ] = IsSSortBlist;
-    IsSSortListFuncs[ T_BLIST +IMMUTABLE ] = IsSSortBlist;
     IsSSortListFuncs[ T_BLIST_NSORT            ] = AlwaysNo;
-    IsSSortListFuncs[ T_BLIST_NSORT +IMMUTABLE ] = AlwaysNo;
     IsSSortListFuncs[ T_BLIST_SSORT            ] = AlwaysYes;
-    IsSSortListFuncs[ T_BLIST_SSORT +IMMUTABLE ] = AlwaysYes;
 
     // Import the types of blists:
     ImportGVarFromLibrary( "TYPE_BLIST_MUT", &TYPE_BLIST_MUT );

src/blister.h

@@ -30,7 +30,7 @@
 EXPORT_INLINE BOOL IS_BLIST_REP(Obj list)
 {
     return T_BLIST <= TNUM_OBJ(list) &&
-           TNUM_OBJ(list) <= T_BLIST_SSORT + IMMUTABLE;
+           TNUM_OBJ(list) <= T_BLIST_SSORT;
 }
 
 

src/error.c

@@ -588,10 +588,15 @@ void RequireArgumentEx(const char * funcname,
         gap_strlcat(msgbuf, " (not the value 'fail')", sizeof(msgbuf));
     else {
         const char * tnam = TNAM_OBJ(op);
+        UInt         tnum = TNUM_OBJ(op);
+        // the names of list and record tnums do not mention mutability
+        if (FIRST_IMM_MUT_TNUM <= tnum && tnum <= LAST_IMM_MUT_TNUM &&
+            !IS_MUTABLE_OBJ(op))
+            gap_strlcat(msgbuf, " (not an immutable %s)", sizeof(msgbuf));
         // heuristic to choose between 'a' and 'an': use 'an' before a vowel
         // and 'a' otherwise; however, that's not always correct, e.g. it is
         // "an FFE", so we add a special case for that as well
-        if (TNUM_OBJ(op) == T_FFE || tnam[0] == 'a' || tnam[0] == 'e' ||
+        else if (tnum == T_FFE || tnam[0] == 'a' || tnam[0] == 'e' ||
             tnam[0] == 'i' || tnam[0] == 'o' || tnam[0] == 'u')
             gap_strlcat(msgbuf, " (not an %s)", sizeof(msgbuf));
         else

src/gasman.h

@@ -548,17 +548,8 @@ void RetypeBagIfWritable(Bag bag, UInt new_type);
 #define RetypeBagIfWritable(x,y)     RetypeBag(x,y)
 #endif
 
-#ifdef GAP_KERNEL_DEBUG
-// This helper tests whether the type change is "allowed". As such, it rejects
-// attempts to retype an immutable list or record into a mutable one.
-void PrecheckRetypeBag(Bag bag, UInt new_type);
-#endif
-
 EXPORT_INLINE void RetypeBag(Bag bag, UInt new_type)
 {
-#ifdef GAP_KERNEL_DEBUG
-    PrecheckRetypeBag(bag, new_type);
-#endif
     RetypeBagIntern(bag, new_type);
 }
 
@@ -567,9 +558,6 @@ EXPORT_INLINE void RetypeBag(Bag bag, UInt new_type)
 **
 **  'RetypeBagSM' works like 'RetypeBag', but ensures that the given bag
 **  retains the same mutability (SM).
-**
-**  FIXME: for now, this checks the tnums; later, this will be turned
-**  into a check for an object flag
 */
 void RetypeBagSM(Bag bag, UInt new_type);
 #ifdef HPCGAP

src/hpc/serialize.c

@@ -235,6 +235,10 @@ static inline BOOL IsBasicObj(Obj obj)
 #define OBJ_BACKREF(x) ((Obj)((x) << 2))
 #define BACKREF_OBJ(obj) (((UInt)(obj)) >> 2)
 
+// Tag preceding an immutable list, record, object set or object map; their
+// tnums do not record mutability.
+#define T_IMMUTABLE_TAG 254
+
 static int SerializedAlready(SerializerState * state, Obj obj)
 {
     Obj ref = LookupObjMap(state->registry, obj);
@@ -268,12 +272,21 @@ static void SerializeObj(SerializerState * state, Obj obj)
         WriteImmediateObj(state, INTOBJ_INT(0));
         return;
     }
-    SerializationFuncByTNum[TNUM_OBJ(obj)](state, obj);
+    UInt tnum = TNUM_OBJ(obj);
+    if (FIRST_IMM_MUT_TNUM <= tnum && tnum <= LAST_IMM_MUT_TNUM &&
+        !IS_MUTABLE_OBJ(obj))
+        WriteTNum(state, T_IMMUTABLE_TAG);
+    SerializationFuncByTNum[tnum](state, obj);
 }
 
 static Obj DeserializeObj(DeserializerState * state)
 {
     UInt tnum = ReadTNum(state);
+    if (tnum == T_IMMUTABLE_TAG) {
+        Obj obj = DeserializeObj(state);
+        MakeImmutableNoRecurse(obj);
+        return obj;
+    }
     return DeserializationFuncByTNum[tnum](state, tnum);
 }
 
@@ -585,8 +598,6 @@ static Obj DeserializeRecord(DeserializerState * state, UInt tnum)
         SET_ELM_PREC(result, i, el);
     }
     SortPRecRNam(result);
-    if (tnum == T_PREC + IMMUTABLE)
-        RetypeBag(result, tnum);
     return result;
 }
 
@@ -713,7 +724,6 @@ static Obj LookupIntTag(Obj tag)
 retry:
     switch (map ? TNUM_OBJ(map) : -1) {
     case T_OBJMAP:
-    case T_OBJMAP + IMMUTABLE:
         result = LookupObjMap(map, tag);
         if (result || func)
             return result;
@@ -741,7 +751,6 @@ static Obj DeserializeTypedObj(DeserializerState * state, UInt tnum)
     switch (tagtnum) {
     case T_INT:
     case T_STRING:
-    case T_STRING + IMMUTABLE:
         if (tagtnum == T_INT) {
             tag = DeserializeInt(state, T_INT);
             type = LookupIntTag(tag);
@@ -765,6 +774,7 @@ static Obj DeserializeTypedObj(DeserializerState * state, UInt tnum)
                 ErrorQuit("DeserializeTypedObj: expected plist, got %s", (Int)TNAM_OBJ(result), 0);
             break;
         case T_PREC:
+            // TODO/FIXME: reject immutable ones?
             result = DeserializeObj(state);
             if (TNUM_OBJ(result) != T_COMOBJ)
                 ErrorQuit("DeserializeTypedObj: expected component object, got %s", (Int)TNAM_OBJ(result), 0);
@@ -858,7 +868,6 @@ static void SerializeTypedObj(SerializerState * state, Obj obj)
         switch (TNUM_OBJ(rep)) {
         case T_INT:
         case T_STRING:
-        case T_STRING + IMMUTABLE:
             SerializeObj(state, rep);
             UInt sp = LEN_PLIST(state->stack);
             switch (TNUM_OBJ(obj)) {
@@ -1058,13 +1067,13 @@ static Int InitKernel(StructInitInfo * module)
     for (i = FIRST_PLIST_TNUM; i <= LAST_PLIST_TNUM; i++) {
         RegisterSerializerFunctions(i, SerializeList, DeserializeList);
     }
-    for (i = T_RANGE_NSORT; i <= T_RANGE_SSORT + IMMUTABLE; i++) {
+    for (i = T_RANGE_NSORT; i <= T_RANGE_SSORT; i++) {
         RegisterSerializerFunctions(i, SerializeRange, DeserializeRange);
     }
-    for (i = T_BLIST; i <= T_BLIST_SSORT + IMMUTABLE; i++) {
+    for (i = T_BLIST; i <= T_BLIST_SSORT; i++) {
         RegisterSerializerFunctions(i, SerializeBlist, DeserializeBlist);
     }
-    for (i = T_STRING; i <= T_STRING_SSORT + IMMUTABLE; i++) {
+    for (i = T_STRING; i <= T_STRING_SSORT; i++) {
         RegisterSerializerFunctions(i, SerializeString, DeserializeString);
     }