Make structural copy handle Blists properly.

src/blister.c

@@ -284,17 +284,30 @@ Obj DoCopyBlist(Obj list, Int mut) {
 
 }
 
+Obj CopyBlistImm (
+    Obj                 list,
+    Int                 mut )
+{
+  return list;
+}
+
 Obj CopyBlist (
     Obj                 list,
     Int                 mut )
 {
-
-    /* don't change immutable objects                                      */
-    if ( ! IS_MUTABLE_OBJ(list) ) {
-        return list;
-    }
-
-    return DoCopyBlist(list, mut);
+    Obj copy;
+    Obj tmp;
+
+    copy =  DoCopyBlist(list, mut);
+    /* leave a forwarding pointer */
+    tmp = NEW_PLIST( T_PLIST, 2 );
+    SET_LEN_PLIST( tmp, 2 );
+    SET_ELM_PLIST( tmp, 1, ADDR_OBJ(list)[0] );
+    SET_ELM_PLIST( tmp, 2, copy );
+    ADDR_OBJ(list)[0] = tmp;
+    CHANGED_BAG(list);
+    RetypeBag( list, TNUM_OBJ(list) + COPYING );
+    return copy;
 }
 
 Obj ShallowCopyBlist ( Obj list)
@@ -308,11 +321,9 @@ Obj ShallowCopyBlist ( Obj list)
 **
 *F  CopyBlistCopy( <list>, <mut> )  . . . . . . . copy a already copied blist
 */
-Obj CopyBlistCopy (
-    Obj                 list,
-    Int                 mut )
+Obj CopyBlistCopy(Obj list, Int mut)
 {
-    return ADDR_OBJ(list)[0];
+    return ELM_PLIST(ADDR_OBJ(list)[0], 2);
 }
 
 
@@ -330,14 +341,13 @@ void CleanBlist (
 **
 *F  CleanBlistCopy( <list> )  . . . . . . . . . . . . .  clean a copied blist
 */
-void CleanBlistCopy (
-    Obj                 list )
+void CleanBlistCopy(Obj list)
 {
-    /* remove the forwarding pointer                                       */
-    ADDR_OBJ(list)[0] = ADDR_OBJ( ADDR_OBJ(list)[0] )[0];
+    /* remove the forwarding pointer */
+    ADDR_OBJ(list)[0] = ELM_PLIST(ADDR_OBJ(list)[0], 1);
 
-    /* now it is cleaned                                                   */
-    RetypeBag( list, TNUM_OBJ(list) - COPYING );
+    /* now it is cleaned */
+    RetypeBag(list, TNUM_OBJ(list) - COPYING);
 }
 
 
@@ -2670,7 +2680,7 @@ static Int InitKernel (
     /* install the copy functions                                          */
     for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
         CopyObjFuncs [ t1                     ] = CopyBlist;
-        CopyObjFuncs [ t1 +IMMUTABLE          ] = CopyBlist;
+        CopyObjFuncs [ t1 +IMMUTABLE          ] = CopyBlistImm;
         CopyObjFuncs [ t1            +COPYING ] = CopyBlistCopy;
         CopyObjFuncs [ t1 +IMMUTABLE +COPYING ] = CopyBlistCopy;
         CleanObjFuncs[ t1                     ] = CleanBlist;