'choice pop' for choosing FIFO semantics after standard push

[hartrock]

cpop stands for 'choice' pop, where the cpop is able to choose, if a standard push without ix leads to FIFO semantics on cpops side.

Currently only the push has this choice of switching from standard LIFO to FIFO semantics, by pushing back using -1 ix, which is working for an empty list: on the other side pop fails, if poping from an empty list with -1 ix.

Here are two macros implementing cpop semantics:

Code: Select all

;; best in functionality
(context 'cpop)
(define-macro (cpop:cpop l (ix 0))
  (if (not (empty? (eval l)))
      (pop (eval l) (eval ix)))) ; returns nil, if empty list
(context MAIN)

;; this has limitations, but should be faster
(macro (emacro-cpop L (Ix 0)) ; emacro: expansion macro
  (if (not (empty? L))
      (pop L Ix))) ; returns nil, if empty list

After loading former code, there has been the following session to show its functionality:

Code: Select all

> ;;
> ;; choices by push for standard pop
> ;;
> ; LIFO
> (push 3 (push 2 (push 1 l)))    ; standard push leading to LIFO
(3 2 1)
> (pop l) (pop l) (pop l) (pop l) ; standard pop
3
2
1
nil
> ;
> ; FIFO:
> (push 3 (push 2 (push 1 l -1) -1) -1) ; FIFO push
(1 2 3)
> (pop l) (pop l) (pop l) (pop l)       ; standard pop
1
2
3
nil
> ;;
> ;;
> ;; choices by pop for standard push
> ;;
> ;; LIFO choice by pop here is the same as LIFO choice by push for standard pop above:
> ;; both with standard push'n'pop.
> ;
> ; FIFO fails, if the list has become empty:
> (push 3 (push 2 (push 1 l)))                ; standard push
(3 2 1)
> (pop l -1) (pop l -1) (pop l -1) (pop l -1) ; FIFO pop (failing)
1
2
3

ERR: invalid list index in function pop
> ; -> this is the problem
> ;
> ; FIFO choice by cpop works:
> (push 3 (push 2 (push 1 l)))                    ; standard push
(3 2 1)
> (cpop l -1) (cpop l -1) (cpop l -1) (cpop l -1) ; FIFO cpop (working)
1
2
3
nil
>

A difference between expansion and run-time macro:

Code: Select all

> ;; this shows a difference between the different macro types: expansion macro works in many cases:
> (push 3 (push 2 (push 1 l)))
(3 2 1)
> (em-cpop l -1) (em-cpop l -1) (em-cpop l -1) (em-cpop l -1) ; (working)
1
2
3
nil
> ;;
> ; but not in all:
> (push 3 (push 2 (push 1 l)))
(3 2 1)
> ((if true cpop "dummy") l -1)    ; -> run-time macro works
1
> ((if true em-cpop "dummy") l -1) ; -> expansion macro fails
(if (not (empty? l)) 
 (pop l -1))
> 

Extending pop by building in cpops FIFO semantics would only be a minor change in interpreter code: it only needs the addition of an empty? list check (so performance should be no problem).

[Lutz]

Talking about performance: when a list gets extended at the end, the last cell address is stored in cell->aux of the envelope cell as an optimization. When accessing the last cell in a list, newLISP checks first if the list is in an optimized status by looking at cell->aux.

For that reason a FIFO pushing at the end and popping in front is much faster, than pushing in front and popping at the end. Each push at the end keeps the list optimized.

A way to speed up your choice-pop code is using the fact that an empty list in a boolean context is taken as false:

Code: Select all

> (set 'l '())
()
> (time (if (not (empty? l)) 'yes 'no) 1000000)
99.422
> (time (if l 'yes 'no) 1000000)
33.054

Also, if no else clause is present in the if statement the evaluated condition is returned:

Code: Select all

> (if (not (empty? l)) 'yes)
nil
> (if l 'yes)
()
> 

… this could be an important distinction when checking the return value of a drop last macro, to distinguish between a nil element dropped and trying to drop from an empty list.

Code: Select all

> (macro (drop L) (if L (pop L -1)))
(lambda-macro (L) (expand '(if L (pop L -1)))) 

> (set 'l '(1 2 3))
(1 2 3)
> (drop l)
3
> (drop l)
2
> (drop l)
1
> (drop l)
()
> 

[hartrock]

Thanks for the hints.

Updated cpop code:

Code: Select all

;; best in functionality
(context 'cpop)
(define-macro (cpop:cpop l (ix 0))
  (if (eval l)
      (pop (eval l) (eval ix)))) ; returns empty list, if empty list
(context MAIN)

;; this has limitations, but should be faster
(macro (em-cpop L (Ix 0)) ; emacro: expansion macro
  (if L
      (pop L Ix))) ; returns empty list, if empty list

Some performance measures
First push and pop for getting a lower bound (using a filled list, so that (pop l -1) never fails).
Short queue:

Code: Select all

> (set 'lt (sequence 1 10) 'num 1000000)
1000000
> ;;
> ;; Note: (pop l -1) would fail for an empty list (l always contains elemennts here).
> ;; LIFO standard
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l)        ) num))
61.152
> (begin (set 'l lt) (time (begin (pop l)        (push 0  l)    ) num))
58.211
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l -1)     ) num))
87.94
> (begin (set 'l lt) (time (begin (pop l -1)     (push 22 l -1) ) num))
87.211
> ;; FIFO by push
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l)        ) num))
60.188
> (begin (set 'l lt) (time (begin (pop l)        (push 22 l -1) ) num))
60.357
> ;; FIFO by pop
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l -1)     ) num))
80.66
> (begin (set 'l lt) (time (begin (pop l -1)     (push 0  l)    ) num))
78.233
> ;;

Long queue:

Code: Select all

> ;;
> (set 'lt (sequence 1 1000) 'num 1000000)
1000000
> ;;
> ;; Note: (pop l -1) would fail for an empty list (l always contains elemennts here).
> ;; LIFO standard
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l)        ) num))
56.846
> (begin (set 'l lt) (time (begin (pop l)        (push 0  l)    ) num))
59.729
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l -1)     ) num))
3855.777
> (begin (set 'l lt) (time (begin (pop l -1)     (push 22 l -1) ) num))
3892.905
> ;; FIFO by push
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l)        ) num))
60.436
> (begin (set 'l lt) (time (begin (pop l)        (push 22 l -1) ) num))
60.664
> ;; FIFO by pop
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l -1)     ) num))
2533.831
> (begin (set 'l lt) (time (begin (pop l -1)     (push 0  l)    ) num))
2538.82
> 

Result of comparison between LIFO standard versus non-standard, and comparison between FIFO by push versus pop (optimized versus unoptimized cases):

• short queue (about 10 elements): small difference,
• long queue (about 1000 elements): huge difference!

Let's stay with the long list, since it is the more critical case, and continue with em-cpop:

Code: Select all

> (set 'lt (sequence 1 1000) 'num 1000000)
1000000
> ;;
> ;; Note: (em-cpop l -1) would also work for an empty list.
> ;; LIFO standard
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l)        ) num))
93.721
> (begin (set 'l lt) (time (begin (em-cpop l)        (push 0  l)    ) num))
82.858
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1)     ) num))
4329.809
> (begin (set 'l lt) (time (begin (em-cpop l -1)     (push 22 l -1) ) num))
3945.459
> ;; FIFO by push
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l)        ) num))
1616.678
> (begin (set 'l lt) (time (begin (em-cpop l)        (push 22 l -1) ) num))
1471.864
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1)     ) num))
2854.785
> (begin (set 'l lt) (time (begin (em-cpop l -1)     (push 0  l)    ) num))
2578.798
> 

Wired observation

Interesting in comparison between pop and em-cpop is the difference between

Code: Select all

> ;; FIFO by push
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l)        ) num))
60.436

and

Code: Select all

> ;; FIFO by push
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l)        ) num))
1616.678

This is wired, because LIFO standard for em-cpop has been fast:

Code: Select all

> ;; LIFO standard
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l)        ) num))
93.721

Digging deeper back to push'n'pop; compare cases with or without explicitely given (unneeded and failing for empty lists) pop ix 0 (which will be used by em-cpop):

Code: Select all

> ;; FIFO by push
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l)        ) num))
73.90600000000001
> ;; FIFO by push (with explicit pop ix)
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l 0)        ) num))
1463.805
>

-> here the explicit ix makes it slow,
but:

Code: Select all

> ;; LIFO standard
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l)        ) num))
71.03100000000001
> ;; LIFO standard (with explicit pop ix)
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l 0)      ) num))
66.854
>

-> here it doesn't hurt!

Why this difference?

[Lutz]

pop with index undoes last element optimization, FIFO push on last position after this is then slow because it has to walk through the whole list to find the last element but reestablishes last element optimization after.

[hartrock]

pop with index undoes last element optimization

Here is a patch, which undoes last element optimization only if needed (against newlisp-10.6.4.tgz 2015-08-05 16:18):

Code: Select all

diff --git a/mirror/nl-liststr.c b/mirror/nl-liststr.c
index a601cdd..427f7d7 100644
--- a/mirror/nl-liststr.c
+++ b/mirror/nl-liststr.c
@@ -574,6 +574,7 @@ CELL * list;
 CELL * cell = NULL;
 ssize_t index;
 int evalFlag = FALSE;
+CELL * outerCell;
 
 params = getEvalDefault(params, &list);
 if(symbolCheck && isProtected(symbolCheck->flags))
@@ -616,7 +617,9 @@ else
 
 while(isList(list->type))
     {
-    list->aux = (UINT)nilCell; /* undo last element optimization */
+    outerCell = list; /* store it for setting aux below */
+    /* replaced by code below */
+    /* list->aux = (UINT)nilCell; */ /* undo last element optimization */
     cell = list;
     list = (CELL *)list->contents;
 
@@ -634,6 +637,9 @@ while(isList(list->type))
     params = getIntegerExt(params, (UINT*)&index, evalFlag);
     }
 
+/* only clear ->aux, if last cell will be pop'ed */
+if(list->next == nilCell) outerCell->aux = (UINT)nilCell;
+
 if(list == (CELL*)cell->contents)
     cell->contents = (UINT)list->next;
 else

It shouldn't change semantics, but solves above issue:

Code: Select all

> ;; Wired removed...
> ;
> (set 'lt (sequence 1 1000) 'num 1000000)
1000000
> ;; LIFO standard
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l)        ) num))
139.095
> ;; LIFO standard (with explicit pop ix)
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l 0)      ) num))
147.966
> ;
> ;; FIFO by push
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l)        ) num))
144.976
> ;; FIFO by push (with explicit pop ix)
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l 0)      ) num))
155.653
> 

Note: no guarantees!
'make testall' gives no failure; but I don't know, if my mental model about the inner workings of the interpreter is correct.

With the patch (if it's correct) all push-backs after ix poping any, but not the last element, should be faster.

PS (update): I've been somewhat irritated by about doubling all fast times against earlier tests. Reason is another host used for the patch. Switching back to the inprogress version without patch, they are doubled, too (against tests in earlier posts with the other host):

Code: Select all

> ;; Wired...
> ;
> (set 'lt (sequence 1 1000) 'num 1000000)
1000000
> ;; LIFO standard
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l)        ) num))
136.833
> ;; LIFO standard (with explicit pop ix)
> (begin (set 'l lt) (time (begin (push 0  l)    (pop l 0)      ) num))
144.943
> ;
> ;; FIFO by push
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l)        ) num))
145.575
> ;; FIFO by push (with explicit pop ix)
> (begin (set 'l lt) (time (begin (push 22 l -1) (pop l 0)      ) num))
3112.816
> 

[Lutz]

Thanks Hartrock, the change was fine, but we can even go a step further, never changing list optimization when using pop on a list:
http://www.newlisp.org/downloads/develo ... nprogress/

... although the change is small, it still needs a lot of testing.

[hartrock]

Here is another patch against newlisp-10.6.4.tgz 2015-08-09 16:32 :

Code: Select all

diff --git a/newlisp.c b/newlisp.c
index 55ff89b..117d27d 100644
--- a/newlisp.c
+++ b/newlisp.c
@@ -2151,6 +2151,35 @@ if(offset < 0)
 return(offset);
 }
 
+void listPrelastLast(CELL * list, CELL ** pPrelast, CELL ** pLast)
+{
+CELL * prelast = nilCell;
+CELL * last = nilCell;
+
+while(list != nilCell)
+    {
+    prelast = last;
+    last = list;
+    list = list->next;
+    }
+
+if (pPrelast) *pPrelast = prelast;
+if (pLast) *pLast = last;
+}
+
+void listLast(CELL * list, CELL ** pLast)
+{
+CELL * last = nilCell;
+
+while(list != nilCell)
+    {
+    last = list;
+    list = list->next;
+    }
+
+if (pLast) *pLast = last;
+}
+
 /* ------------------------ creating and freeing cells ------------------- */
 
 CELL * getCell(int type)
diff --git a/nl-list.c b/nl-list.c
index 9ce174e..43880a9 100644
--- a/nl-list.c
+++ b/nl-list.c
@@ -1047,11 +1047,23 @@ while(isList(list->type))
     else
         {
         list = (CELL *)list->contents;
+#if 0
         if(index < 0) 
             index = convertNegativeOffset(index, list);
 
         while(index--)  list = list->next;
-
+#else
+        if(index == -1)
+            {
+            listLast(list, &list);
+            }
+        else
+            {
+            if(index < 0) 
+                index = convertNegativeOffset(index, list);
+            while(index--)  list = list->next; 
+            }
+#endif
         if(list == nilCell) 
             errorProc(ERR_LIST_INDEX_INVALID);
         }
diff --git a/nl-liststr.c b/nl-liststr.c
index 2253402..ada32cb 100644
--- a/nl-liststr.c
+++ b/nl-liststr.c
@@ -618,9 +618,14 @@ else
 /* pop with index */
 while(isList(list->type))
     {
+#if 0
     cell = envelope = list;
+#else
+    envelope = list;
+#endif
     list = (CELL *)list->contents;
 
+#if 0
     if(index < 0) index = convertNegativeOffset(index, list);
 
     while(index--) 
@@ -628,6 +633,19 @@ while(isList(list->type))
         cell = list;
         list = list->next;
         }
+#else
+    if(index == -1)
+        listPrelastLast(list, &cell, &list);
+    else
+        {
+        if(index < 0) index = convertNegativeOffset(index, list);
+        while(index--) 
+            {
+            cell = list;
+            list = list->next;
+            }
+        }
+#endif
     if(list == nilCell) 
         errorProc(ERR_LIST_INDEX_INVALID);
 
@@ -637,14 +655,23 @@ while(isList(list->type))
 
 if(list->next == nilCell) /* last cell is popped */
     {
+#if 0
     if(list == (CELL*)cell->contents) /* last is also first cell */
+#else
+    if(list == (CELL*)envelope->contents) /* also first cell */
+#endif
         envelope->aux = (UINT)nilCell;        
     else 
         envelope->aux = (UINT)cell; /* cell is previous to last popped */
     }
 
+#if 0
 if(list == (CELL*)cell->contents)
     cell->contents = (UINT)list->next;
+#else
+if(list == (CELL*)envelope->contents)
+    envelope->contents = (UINT)list->next;
+#endif
 else
     cell->next = list->next;
 
diff --git a/protos.h b/protos.h
index 5fd06d8..b835e46 100644
--- a/protos.h
+++ b/protos.h
@@ -598,6 +598,8 @@ int win_fprintf(FILE * fPtr, char * dummy, char * buffer);
 int writeFile(char * fileName, char * buffer, size_t size, char * type);
 size_t listlen(CELL * listHead);
 ssize_t convertNegativeOffset(ssize_t offset, CELL * list);
+void listPrelastLast(CELL * list, CELL ** pPrelast, CELL ** pLast);
+void listLast(CELL * list, CELL ** pLast);
 ssize_t readFile(char * fileName, char * * buffer);
 unsigned int asciiIPtoLong(char *ptr);
 unsigned int update_crc(unsigned int crc, unsigned char *buf, int len);

It gives some performance improvements for poping back from long lists.

Before:

Code: Select all

> ;; from longer to shorter lists
> ;;
> (set 'lt (sequence 1 10000) 'num 100000)
100000
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1) ) num))
6723.186
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 22 l -1) ) num))
6835.562
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1) ) num))
6759.411
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 0  l)    ) num))
6756.627
> ;;
> (set 'lt (sequence 1 1000) 'num 1000000)
1000000
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1) ) num))
4759.021
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 22 l -1) ) num))
5162.605
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1) ) num))
4787.38
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 0  l)    ) num))
5207.72
> ;;
> (set 'lt (sequence 1 10) 'num 10000000)
10000000
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1) ) num))
2219.848
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 22 l -1) ) num))
2177.663
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1) ) num))
2233.914
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 0  l)    ) num))
2137.999
> ;;
> (set 'lt (sequence 1 2) 'num 10000000)
10000000
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1) ) num))
2074.409
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 22 l -1) ) num))
1998.884
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1) ) num))
1921.308
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 0  l)    ) num))
1945.571
> 

After:

Code: Select all

> ;; from longer to shorter lists
> ;;
> (set 'lt (sequence 1 10000) 'num 100000)
100000
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1) ) num))
3766.13
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 22 l -1) ) num))
3746.027
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1) ) num))
3759.977
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 0  l)    ) num))
3650.811
> ;;
> (set 'lt (sequence 1 1000) 'num 1000000)
1000000
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1) ) num))
3349.033
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 22 l -1) ) num))
3411.04
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1) ) num))
3360.739
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 0  l)    ) num))
3455.855
> ;;
> (set 'lt (sequence 1 10) 'num 10000000)
10000000
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1) ) num))
2046.184
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 22 l -1) ) num))
1976.498
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1) ) num))
1958.404
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 0  l)    ) num))
1975.241
> ;;
> (set 'lt (sequence 1 2) 'num 10000000)
10000000
> ;; LIFO non-standard
> (begin (set 'l lt) (time (begin (push 22 l -1) (em-cpop l -1) ) num))
1853.397
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 22 l -1) ) num))
1995.456
> ;; FIFO by em-cpop
> (begin (set 'l lt) (time (begin (push 0  l)    (em-cpop l -1) ) num))
1747.217
> (begin (set 'l lt) (time (begin (em-cpop l -1) (push 0  l)    ) num))
1871.158
> 

... although the change is small, it still needs a lot of testing.

This is true indeed: I've made some errors during creating this patch, and detected them at interesting places by running some tests (yours and mines).

[abaddon1234]

Thanks for the info
gclub