gap-system · markuspf · Oct 6, 2017 · Oct 2, 2017
diff --git a/doc/ref/lists.xml b/doc/ref/lists.xml
@@ -440,6 +440,7 @@ the operations <Ref Func="Add"/> and <Ref Func="Remove"/>.
 <Heading>IsBound and Unbind for Lists</Heading>
 
 <#Include Label="IsBound_list">
+<#Include Label="GetWithDefault_list">
 <#Include Label="Unbind_list">
 
 </Section>

diff --git a/lib/hpc/thread1.g b/lib/hpc/thread1.g
@@ -161,15 +161,6 @@ BIND_GLOBAL("CopyToRegion", {x,y} -> x);
 BIND_GLOBAL("SetTLDefault", BindThreadLocal);
 BIND_GLOBAL("SetTLConstructor", BindThreadLocalConstructor);
 
-
-BIND_GLOBAL("CHECKED_GET_ATOMIC_LIST", function(l, pos, default)
-    if IsBound(l[pos]) then
-        return l[pos];
-    else
-        return default;
-    fi;
-end);
-
 BIND_GLOBAL("COMPARE_AND_SWAP", function(l, pos, old, new)
     if IsBound(l[pos]) and IS_IDENTICAL_OBJ(l[pos], old) then
         l[pos] := new;

diff --git a/lib/list.gd b/lib/list.gd
@@ -178,6 +178,51 @@ DeclareOperationKernel( "[]",
     [ IsList, IS_INT ],
     ELM_LIST );
 
+#############################################################################
+##
+##  <#GAPDoc Label="GetWithDefault_list">
+##  <ManSection>
+##  <Oper Name="GetWithDefault" Arg='list, n, default'/>
+##
+##  <Description>
+##  <Ref Func="GetWithDefault"/> returns the <A>n</A>th element of the list
+##  <A>list</A>, if <A>list</A> has a value at index <A>n</A>, and
+##  <A>default</A> otherwise.
+##  <P/>
+##  While this method can be used on any list, it is particularly useful
+##  for Weak Pointer lists <Ref Sect="Weak Pointer Objects"/> where the
+##  value of the list can change.
+##  <P/>
+##  To distinguish between the <A>n</A>th element being unbound, or
+##  <A>default</A> being in <A>list</A>, users can create a new mutable
+##  object, such as a string. <Ref Func="IsIdenticalObj"/> returns
+##  <K>false</K> for different mutable strings, even if their contents are
+##  the same.
+##
+##  <Example><![CDATA[
+##  gap> l := [1,2,,"a"];
+##  [ 1, 2,, "a" ]
+##  gap> newobj := "a";
+##  "a"
+##  gap> GetWithDefault(l, 2, newobj);
+##  2
+##  gap> GetWithDefault(l, 3, newobj);
+##  "a"
+##  gap> GetWithDefault(l, 4, newobj);
+##  "a"
+##  gap> IsIdenticalObj(GetWithDefault(l, 3, newobj), newobj);
+##  true
+##  gap> IsIdenticalObj(GetWithDefault(l, 4, newobj), newobj);
+##  false
+##  ]]></Example>
+##  </Description>
+##  </ManSection>
+##  <#/GAPDoc>
+##
+DeclareOperationKernel( "GetWithDefault",
+    [ IsList, IS_INT, IsObject ],
+    ELM_DEFAULT_LIST );
+
 
 #############################################################################
 ##

diff --git a/src/hpc/aobjects.c b/src/hpc/aobjects.c
@@ -351,20 +351,17 @@ static Obj FuncGET_ATOMIC_LIST(Obj self, Obj list, Obj index)
 // The reason this function exists is that it is not thread-safe to
 // check if an index in a list is bound before reading it, as it
 // could be unbound before the actual reading is performed.
-static Obj FuncCHECKED_GET_ATOMIC_LIST(Obj self, Obj list, Obj index, Obj value)
+static Obj ElmDefAList(Obj list, Int n, Obj value)
 {
-    UInt        n;
     UInt        len;
     AtomicObj * addr;
     Obj         val;
-    if (TNUM_OBJ(list) != T_ALIST && TNUM_OBJ(list) != T_FIXALIST)
-        ArgumentError(
-            "CHECKED_GET_ATOMIC_LIST: First argument must be an atomic list");
+
+    GAP_ASSERT(TNUM_OBJ(list) == T_ALIST || TNUM_OBJ(list) == T_FIXALIST);
+    GAP_ASSERT(n > 0);
     addr = ADDR_ATOM(list);
     len = ALIST_LEN((UInt)addr[0].atom);
-    if (!IS_INTOBJ(index))
-        ArgumentError("CHECKED_GET_ATOMIC_LIST: Second argument must be an integer");
-    n = INT_INTOBJ(index);
+
     if (n <= 0 || n > len) {
         val = 0;
     }
@@ -1882,7 +1879,6 @@ static StructGVarFunc GVarFuncs[] = {
     GVAR_FUNC(FromAtomicList, 1, "list"),
     GVAR_FUNC(AddAtomicList, 2, "list, obj"),
     GVAR_FUNC(GET_ATOMIC_LIST, 2, "list, index"),
-    GVAR_FUNC(CHECKED_GET_ATOMIC_LIST, 3, "list, index, default"),
     GVAR_FUNC(SET_ATOMIC_LIST, 3, "list, index, value"),
     GVAR_FUNC(COMPARE_AND_SWAP, 4, "list, index, old, new"),
     GVAR_FUNC(ATOMIC_BIND, 3, "list, index, new"),
@@ -1988,6 +1984,7 @@ static Int InitKernel (
   LenListFuncs[T_FIXALIST] = LenListAList;
   LengthFuncs[T_FIXALIST] = LengthAList;
   Elm0ListFuncs[T_FIXALIST] = Elm0AList;
+  ElmDefListFuncs[T_FIXALIST] = ElmDefAList;
   Elm0vListFuncs[T_FIXALIST] = Elm0AList;
   ElmListFuncs[T_FIXALIST] = ElmAList;
   ElmvListFuncs[T_FIXALIST] = ElmAList;
@@ -2002,6 +1999,7 @@ static Int InitKernel (
   LenListFuncs[T_ALIST] = LenListAList;
   LengthFuncs[T_ALIST] = LengthAList;
   Elm0ListFuncs[T_ALIST] = Elm0AList;
+  ElmDefListFuncs[T_ALIST] = ElmDefAList;
   Elm0vListFuncs[T_ALIST] = Elm0AList;
   ElmListFuncs[T_ALIST] = ElmAList;
   ElmvListFuncs[T_ALIST] = ElmAList;

diff --git a/src/lists.c b/src/lists.c
@@ -378,6 +378,58 @@ Int ISB2_LIST(Obj list, Obj pos1, Obj pos2)
 */
 Obj (*Elm0ListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos );
 
+/****************************************************************************
+**
+*V  ElmDefListFuncs[ <type> ] . . . . . . . . .  table of selection functions
+**
+**  'ELM_DEFAULT_LIST' returns the element at the position <pos> in the list
+**  <list>, or <default> if <list> has no assigned object at position <pos>.
+**  An error is signalled if <list> is not a list. It is the responsibility
+**  of the caller to ensure that <pos> is a positive integer.
+*/
+Obj (*ElmDefListFuncs[LAST_REAL_TNUM + 1])(Obj list, Int pos, Obj def);
+
+// Default implementation of ELM_DEFAULT_LIST
+Obj ElmDefListDefault(Obj list, Int pos, Obj def)
+{
+    Obj val = ELM0_LIST(list, pos);
+    if (val) {
+        return val;
+    }
+    else {
+        return def;
+    }
+}
+
+/****************************************************************************
+**
+*F  ElmDefListObject( <list>, <pos>, <default> )select an element from a list
+**
+**  `ElmDefListObject' is the `ELM_DEFAULT_LIST' function for objects.
+**
+*/
+static Obj ElmDefListOper;
+
+Obj ElmDefListObject(Obj list, Int pos, Obj def)
+{
+    return DoOperation3Args(ElmDefListOper, list, INTOBJ_INT(pos), def);
+}
+
+Obj FuncELM_DEFAULT_LIST(Obj self, Obj list, Obj pos, Obj def)
+{
+    // Dispath ensures 'list' is a list, and 'pos' is an int.
+    // just need to check 'pos' is a small int which is > 0.
+    if (!IS_INTOBJ(pos)) {
+        ErrorMayQuit("GetWithDefault: <pos> must be an integer (not a %s)",
+                     (Int)TNAM_OBJ(pos), 0);
+    }
+
+    Int ipos = INT_INTOBJ(pos);
+    if (ipos < 1) {
+        ErrorMayQuit("GetWithDefault: <pos> must be >= 0", 0, 0);
+    }
+    return ELM_DEFAULT_LIST(list, ipos, def);
+}
 
 /****************************************************************************
 **
@@ -2328,15 +2380,16 @@ static StructGVarProp GVarProps [] = {
 **
 *V  GVarOpers . . . . . . . . . . . . . . . . .  list of operations to export
 */
-static StructGVarOper GVarOpers [] = {
+static StructGVarOper GVarOpers[] = {
 
     // POS_LIST can take 2 or 3 arguments; since NewOperation ignores the
     // handler for variadic operations, use DoOperation0Args as a placeholder.
-    { "POS_LIST", -1, "list, obj[, start]", &PosListOper,
-      DoOperation0Args, "src/lists.c:POS_LIST" },
+    { "POS_LIST", -1, "list, obj[, start]", &PosListOper, DoOperation0Args,
+      "src/lists.c:POS_LIST" },
 
     GVAR_OPER(ISB_LIST, 2, "list, pos", &IsbListOper),
     GVAR_OPER(ELM0_LIST, 2, "list, pos", &Elm0ListOper),
+    GVAR_OPER(ELM_DEFAULT_LIST, 3, "list, pos, default", &ElmDefListOper),
     GVAR_OPER(ELM_LIST, 2, "list, pos", &ElmListOper),
     GVAR_OPER(ELMS_LIST, 2, "list, poss", &ElmsListOper),
     GVAR_OPER(UNB_LIST, 2, "list, pos", &UnbListOper),
@@ -2462,6 +2515,16 @@ static Int InitKernel (
         Elm0vListFuncs[ type ] = Elm0ListObject;
     }
 
+    // make and install ELM_DEFAULT_LIST operation
+    // we install this for all TNUMs, as the default implementation delegates
+    // to other list operations, we can error if approriate
+    for (type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++) {
+        ElmDefListFuncs[type] = ElmDefListDefault;
+    }
+    for (type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++) {
+        ElmDefListFuncs[type] = ElmDefListObject;
+    }
+
 
     /* make and install the 'ELM_LIST' operation                           */
     for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {

diff --git a/src/lists.h b/src/lists.h
@@ -236,6 +236,31 @@ static inline Obj ELM0_LIST(Obj list, Int pos)
     return (*Elm0ListFuncs[TNUM_OBJ(list)])(list, pos);
 }
 
+/****************************************************************************
+**
+*V  ElmDefListFuncs[ <type> ] . . . . . . . . .  table of selection functions
+**
+**  A package implementing a list type <type> can provide a function for
+**  'ELM_DEFAULT_LIST' and install it in 'ElmDefListFuncs[<type>]', otherwise
+**  a default implementation is provided.
+*/
+extern Obj (*ElmDefListFuncs[LAST_REAL_TNUM + 1])(Obj list, Int pos, Obj def);
+
+
+/****************************************************************************
+**
+*F  ELM_DEFAULT_LIST( <list>, <pos>, <default> )select an element from a list
+**
+**  'ELM_DEFAULT_LIST' returns the element at the position <pos> in the list
+**  <list>, or <default> if <list> has no assigned object at position <pos>.
+**  An error is signalled if <list> is not a list. It is the responsibility
+**  of the caller to ensure that <pos> is a positive integer.
+*/
+static inline Obj ELM_DEFAULT_LIST(Obj list, Int pos, Obj def)
+{
+    return (*ElmDefListFuncs[TNUM_OBJ(list)])(list, pos, def);
+}
+
 
 /****************************************************************************
 **

diff --git a/src/weakptr.c b/src/weakptr.c
@@ -434,6 +434,7 @@ Obj FuncUnbindElmWPObj( Obj self, Obj wp, Obj pos)
   return 0;
 }
 
+
 /****************************************************************************
 **
 *F  FuncElmWPObj( <self>, <wp>, <pos> ) . . . . . . . . . . .Access WP Object
@@ -448,32 +449,20 @@ Obj FuncUnbindElmWPObj( Obj self, Obj wp, Obj pos)
 **  collection.
 */
 
-Obj FuncElmWPObj( Obj self, Obj wp, Obj pos)
-{
-  if (TNUM_OBJ(wp) != T_WPOBJ)
-    {
-      ErrorMayQuit("ElmWPObj: First argument must be a weak pointer object, not a %s",
-                   (Int)TNAM_OBJ(wp), 0);
-    }
-
-  if (!IS_INTOBJ(pos))
-    {
-      ErrorMayQuit("ElmWPObj: Position must be a small integer, not a %s",
-                (Int)TNAM_OBJ(pos),0L);
-    }
+#include <stdio.h>
 
-  UInt ipos = INT_INTOBJ(pos);
-  if (ipos < 1)
-    {
-      ErrorMayQuit("ElmWPObj: Position must be a positive integer",0L,0L);
-    }
+// Provide implementation of ElmDefListFuncs
+Obj ElmDefWPList(Obj wp, Int ipos, Obj def)
+{
+    GAP_ASSERT(TNUM_OBJ(wp) == T_WPOBJ);
+    GAP_ASSERT(ipos >= 1);
 
 #ifdef HPCGAP
-  if ( LengthWPObj(wp) < ipos ) 
-    return Fail;
+  if ( LengthWPObj(wp) < ipos )
+      return def;
 #else
-  if ( STORED_LEN_WPOBJ(wp) < ipos ) 
-    return Fail;
+  if ( STORED_LEN_WPOBJ(wp) < ipos )
+      return def;
 #endif
 
 #ifdef BOEHM_GC
@@ -483,19 +472,40 @@ Obj FuncElmWPObj( Obj self, Obj wp, Obj pos)
 #ifdef BOEHM_GC
   MEMBAR_READ();
   if (elm == 0 || ELM_WPOBJ(wp, ipos) == 0)
-    return Fail;
+      return def;
 #else
   if (IS_WEAK_DEAD_BAG(elm))
     {
       ELM_WPOBJ(wp,ipos) = 0;
-      return Fail;
+      return def;
     }
   if (elm == 0)
-    return Fail;
+      return def;
 #endif
   return elm;
 }
 
+Obj FuncElmWPObj(Obj self, Obj wp, Obj pos)
+{
+    if (TNUM_OBJ(wp) != T_WPOBJ) {
+        ErrorMayQuit("ElmWPObj: First argument must be a weak pointer "
+                     "object, not a %s",
+                     (Int)TNAM_OBJ(wp), 0);
+    }
+
+    if (!IS_INTOBJ(pos)) {
+        ErrorMayQuit("ElmWPObj: Position must be a small integer, not a %s",
+                     (Int)TNAM_OBJ(pos), 0L);
+    }
+
+    Int ipos = INT_INTOBJ(pos);
+    if (ipos < 1) {
+        ErrorMayQuit("ElmWPObj: Position must be a positive integer", 0L, 0L);
+    }
+
+    return ElmDefWPList(wp, ipos, Fail);
+}
+
 
 /****************************************************************************
 **
@@ -841,7 +851,10 @@ static Int InitKernel (
     /* saving function                                                     */
     SaveObjFuncs[ T_WPOBJ ] = SaveWPObj;
     LoadObjFuncs[ T_WPOBJ ] = LoadWPObj;
-
+
+    // List functions
+    ElmDefListFuncs[T_WPOBJ] = ElmDefWPList;
+
     /* copying functions                                                   */
     CopyObjFuncs[  T_WPOBJ           ] = CopyObjWPObj;
     CopyObjFuncs[  T_WPOBJ + COPYING ] = CopyObjWPObjCopy;

diff --git a/tst/testinstall/atomic_list.tst b/tst/testinstall/atomic_list.tst
@@ -60,14 +60,14 @@ gap> IsBound(a[3]);
 false
 gap> IsBound(a[9]);
 false
-gap> CHECKED_GET_ATOMIC_LIST(a, 2, -1);
+gap> GetWithDefault(a, 2, -1);
 7
-gap> CHECKED_GET_ATOMIC_LIST(a, 3, -1);
+gap> GetWithDefault(a, 3, -1);
 -1
-gap> CHECKED_GET_ATOMIC_LIST(a, 10, -1);
+gap> GetWithDefault(a, 10, -1);
 -1
 gap> s := "";;
-gap> IsIdenticalObj(CHECKED_GET_ATOMIC_LIST(a, 10, s), s);
+gap> IsIdenticalObj(GetWithDefault(a, 10, s), s);
 true
 gap> COMPARE_AND_SWAP(a, 2, 6, 5);
 false
@@ -141,14 +141,14 @@ gap> IsBound(a[3]);
 false
 gap> IsBound(a[9]);
 false
-gap> CHECKED_GET_ATOMIC_LIST(a, 2, -1);
+gap> GetWithDefault(a, 2, -1);
 7
-gap> CHECKED_GET_ATOMIC_LIST(a, 3, -1);
+gap> GetWithDefault(a, 3, -1);
 -1
-gap> CHECKED_GET_ATOMIC_LIST(a, 10, -1);
+gap> GetWithDefault(a, 10, -1);
 -1
 gap> s := "";;
-gap> IsIdenticalObj(CHECKED_GET_ATOMIC_LIST(a, 10, s), s);
+gap> IsIdenticalObj(GetWithDefault(a, 10, s), s);
 true
 gap> COMPARE_AND_SWAP(a, 2, 6, 5);
 false