B/listt: Lists Template. @Purpose: Code to support the list of... kind of value constructor. @------------------------------------------------------------------------------- @p Block Format. A list is a variable-length array of values all of which have the same kind. (Compare a combination, a fixed-length array of values with possibly different kinds.) The short block for a list is a pointer to the long block. The long block consists of the strong kind ID of the items (not of the list itself!), followed by the number of items, followed by one word for each item. @c Constant LIST_ITEM_KOV_F = 0; ! The kind of the items Constant LIST_LENGTH_F = 1; ! The number of items Constant LIST_ITEM_BASE = 2; ! List items begin at this entry @p KOV Support. See the "BlockValues.i6t" segment for the specification of the following routines. @c [ LIST_OF_TY_Support task arg1 arg2 arg3; switch(task) { CREATE_KOVS: return LIST_OF_TY_Create(arg1, arg2); DESTROY_KOVS: LIST_OF_TY_Destroy(arg1); MAKEMUTABLE_KOVS: return 1; COPYKIND_KOVS: return LIST_OF_TY_CopyKind(arg1, arg2); COPYQUICK_KOVS: return LIST_OF_TY_QuickCopy(arg1, arg2); COPYSB_KOVS: BlkValueCopySB1(arg1, arg2); KINDDATA_KOVS: return LIST_OF_TY_KindData(arg1, arg2); EXTENT_KOVS: return BlkValueRead(arg1, LIST_LENGTH_F) + LIST_ITEM_BASE; COPY_KOVS: LIST_OF_TY_Copy(arg1, arg2, arg3); COMPARE_KOVS: return LIST_OF_TY_Compare(arg1, arg2); HASH_KOVS: return LIST_OF_TY_Hash(arg1); DEBUG_KOVS: print " = {", (LIST_OF_TY_Say) arg1, "} of kind ", BlkValueRead(arg1, LIST_ITEM_KOV_F); } ! We choose not to respond to: CAST_KOVS, READ_FILE_KOVS, WRITE_FILE_KOVS rfalse; ]; @p Creation. Lists are by default created empty but in a block-value with enough capacity to hold 25 items, this being what's left in a 32-word block once all overheads are taken care of: 4 words are consumed by the header, then 2 more by the list metadata entries below. @c [ LIST_OF_TY_Create skov sb list; skov = KindBaseTerm(skov, 0); list = FlexAllocate(27*WORDSIZE, LIST_OF_TY, BLK_FLAG_MULTIPLE + BLK_FLAG_WORD); BlkValueWrite(list, LIST_ITEM_KOV_F, skov, true); BlkValueWrite(list, LIST_LENGTH_F, 0, true); sb = BlkValueCreateSB1(sb, list); return sb; ]; @p Destruction. If the list items are themselves block-values, they must all be freed before the list itself can be freed. @c [ LIST_OF_TY_Destroy list no_items i k; k = BlkValueRead(list, LIST_ITEM_KOV_F); if (KOVIsBlockValue(k)) { no_items = BlkValueRead(list, LIST_LENGTH_F); for (i=0: i ex) { if (BlkValueSetLBCapacity(list, len+LIST_ITEM_BASE) == false) return 0; } if (kov) BlkValueWrite(list, LIST_ITEM_KOV_F, kov); else BlkValueWrite(list, LIST_ITEM_KOV_F, OBJECT_TY); BlkValueWrite(list, LIST_LENGTH_F, len); obj = 0; for (i=0: i no_items+1))) { print "*** Couldn't add at entry ", posn, " in the list "; LIST_OF_TY_Say(list, true); print ", which has entries in the range 1 to ", no_items, " ***^"; RunTimeProblem(RTP_LISTRANGEERROR); rfalse; } ex = BlkValueLBCapacity(list); if (no_items+LIST_ITEM_BASE+1 > ex) { if (BlkValueSetLBCapacity(list, ex+16) == false) return 0; } if (KOVIsBlockValue(contents_kind)) { nv = BlkValueCreate(contents_kind); BlkValueCopy(nv, v); v = nv; } if (posnflag) { posn--; for (i=no_items:i>posn:i--) { BlkValueWrite(list, i+LIST_ITEM_BASE, BlkValueRead(list, i-1+LIST_ITEM_BASE)); } BlkValueWrite(list, posn+LIST_ITEM_BASE, v); } else { BlkValueWrite(list, no_items+LIST_ITEM_BASE, v); } BlkValueWrite(list, LIST_LENGTH_F, no_items+1); return list; ]; @p Append List. Instead of adjoining a single value, we adjoin an entire second list, which must be of a compatible kind of value (something which NI's type-checking machinery polices for us). Except that we have a list |more| rather than a value |v| to insert, the specification is the same as for |LIST_OF_TY_InsertItem|. @c [ LIST_OF_TY_AppendList list more posnflag posn nodups v i j no_items msize ex nv; if ((list==0) || (BlkValueWeakKind(list) ~= LIST_OF_TY)) return false; if ((more==0) || (BlkValueWeakKind(more) ~= LIST_OF_TY)) return list; no_items = BlkValueRead(list, LIST_LENGTH_F); if ((posnflag) && ((posn<1) || (posn > no_items+1))) { print "*** Couldn't add at entry ", posn, " in the list "; LIST_OF_TY_Say(list, true); print ", which has entries in the range 1 to ", no_items, " ***^"; RunTimeProblem(RTP_LISTRANGEERROR); rfalse; } msize = BlkValueRead(more, LIST_LENGTH_F); ex = BlkValueLBCapacity(list); if (no_items+msize+LIST_ITEM_BASE > ex) { if (BlkValueSetLBCapacity(list, no_items+msize+LIST_ITEM_BASE+8) == false) return 0; } if (posnflag) { posn--; for (i=no_items+msize:i>=posn+msize:i--) { BlkValueWrite(list, i+LIST_ITEM_BASE, BlkValueRead(list, i-msize+LIST_ITEM_BASE)); } ! BlkValueWrite(list, posn, v); for (j=0: j to) || (from <= 0) || (to > no_items)) { if (forgive) { if (from <= 0) from = 1; if (to >= no_items) to = no_items; if (from > to) return list; } else { print "*** Couldn't remove entries ", from, " to ", to, " from the list "; LIST_OF_TY_Say(list, true); print ", which has entries in the range 1 to ", no_items, " ***^"; RunTimeProblem(RTP_LISTRANGEERROR); rfalse; } } to--; from--; d = to-from+1; if (KOVIsBlockValue(BlkValueRead(list, LIST_ITEM_KOV_F))) for (i=0: i ex) { if (BlkValueSetLBCapacity(list, newsize+LIST_ITEM_BASE) == false) return 0; } dv = DefaultValueOfKOV(BlkValueRead(list, LIST_ITEM_KOV_F)); for (i=no_items: i newsize) { if (this_way_only == 1) return list; if (truncation_end == -1) { if (KOVIsBlockValue(BlkValueRead(list, LIST_ITEM_KOV_F))) for (i=0: ino_items)) { if (forgive) return false; print "*** Couldn't read from entry ", i, " of a list which"; switch (no_items) { 0: print " is empty ***^"; 1: print " has only one entry, numbered 1 ***^"; default: print " has entries numbered from 1 to ", no_items, " ***^"; } RunTimeProblem(RTP_LISTRANGEERROR); if (no_items >= 1) i = 1; else return false; } return BlkValueRead(list, LIST_ITEM_BASE+i-1); ]; @p Write Item. The slightly odd name for this function comes about because our usual way to convert an rvalue such as |LIST_OF_TY_GetItem(L, 4)| is to prefix |Write|, so that it becomes |WriteLIST_OF_TY_GetItem(L, 4)|. @c [ WriteLIST_OF_TY_GetItem list i val no_items; if ((list==0) || (BlkValueWeakKind(list) ~= LIST_OF_TY)) return false; no_items = BlkValueRead(list, LIST_LENGTH_F); if ((i<=0) || (i>no_items)) { print "*** Couldn't write to list entry ", i, " of a list which"; switch (no_items) { 0: print " is empty ***^"; 1: print " has only one entry, numbered 1 ***^"; default: print " has entries numbered from 1 to ", no_items, " ***^"; } return RunTimeProblem(RTP_LISTRANGEERROR); } BlkValueWrite(list, LIST_ITEM_BASE+i-1, val); ]; @p Put Item. Higher-level code should not use |Write_LIST_OF_TY_GetItem|, because it does not properly keep track of block-value copying: the following should be used instead. @c [ LIST_OF_TY_PutItem list i v no_items nv; if ((list==0) || (BlkValueWeakKind(list) ~= LIST_OF_TY)) return false; no_items = BlkValueRead(list, LIST_LENGTH_F); if (KOVIsBlockValue(BlkValueRead(list, LIST_ITEM_KOV_F))) { nv = BlkValueCreate(BlkValueRead(list, LIST_ITEM_KOV_F)); BlkValueCopy(nv, v); v = nv; } if ((i<=0) || (i>no_items)) return false; BlkValueWrite(list, LIST_ITEM_BASE+i-1, v); ]; @p Multiple Object List. The parser uses one data structure which is really a list: but which can't be represented as such because the heap might not exist. This is the multiple object list, which is used to handle commands like TAKE ALL by firing off a sequence of actions with one of the objects taken from entries in turn of the list. The following converts it to a list structure. @c [ LIST_OF_TY_Mol list len i; if ((list==0) || (BlkValueWeakKind(list) ~= LIST_OF_TY)) return 0; len = multiple_object-->0; LIST_OF_TY_SetLength(list, len); for (i=1: i<=len: i++) LIST_OF_TY_PutItem(list, i, multiple_object-->i); return list; ]; [ LIST_OF_TY_Set_Mol list len i; if ((list==0) || (BlkValueWeakKind(list) ~= LIST_OF_TY)) return 0; len = BlkValueRead(list, LIST_LENGTH_F); if (len > 63) len = 63; multiple_object-->0 = len; for (i=1: i<=len: i++) multiple_object-->i = BlkValueRead(list, LIST_ITEM_BASE+i-1); ]; @p Reversing. Reversing a list is, happily, a very efficient operation when the list contains block-values: because the pointers are rearranged but none is duplicated or destroyed, we can for once ignore the fact that they are pointers to block-values and simply move them around like any other data. @c [ LIST_OF_TY_Reverse list no_items i v; if ((list==0) || (BlkValueWeakKind(list) ~= LIST_OF_TY)) return 0; no_items = BlkValueRead(list, LIST_LENGTH_F); if (no_items < 2) return list; for (i=0:i*20:i--) BlkValueWrite(list, LIST_ITEM_BASE+i, BlkValueRead(list, LIST_ITEM_BASE+i-1)); BlkValueWrite(list, LIST_ITEM_BASE, v); } return list; ]; @p Sorting. And the same, again, is true of sorting: but we do have to take note of block values when it comes to performing comparisons, because we can only compare items in the list by looking at their contents, not the pointers to their contents. |LIST_OF_TY_Sort(list, dir, prop)| sorts the given |list| in ascending order if |dir| is 1, in descending order if |dir| is $-1$, or in random order if |dir| is 2. The comparison used is the one for the kind of value stored in the list, unless the optional argument |prop| is supplied, in which case we sort based not on the item values but on their values for the property |prop|. (This only makes sense if the list contains objects.) @c Global LIST_OF_TY_Sort_cf; [ LIST_OF_TY_Sort list dir prop cf i j no_items v; BlkMakeMutable(list); no_items = BlkValueRead(list, LIST_LENGTH_F); if (dir == 2) { if (no_items < 2) return; for (i=1:i j) return 1; if (i < j) return -1; return 0; } else return cf(i, j); ];