From 9af7be2ef98b9d3bdf7a54002d9c3ab39909e276 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Thu, 15 Oct 2015 18:34:49 +0200
Subject: [PATCH] ui: the layout-queue is more efficient as a vector than a
 dlist

Improves memory usage in the #1488 example from about 20,4% to 17,4% on
my machine.
---
 basis/ui/gadgets/debug/debug.factor | 10 +++++-----
 basis/ui/gadgets/gadgets.factor     |  9 ++++-----
 basis/ui/ui.factor                  | 23 ++++++++++-------------
 3 files changed, 19 insertions(+), 23 deletions(-)

diff --git a/basis/ui/gadgets/debug/debug.factor b/basis/ui/gadgets/debug/debug.factor
index 8aba04b50f..e7fe21931e 100644
--- a/basis/ui/gadgets/debug/debug.factor
+++ b/basis/ui/gadgets/debug/debug.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays colors.constants dlists io
-io.streams.string kernel namespaces opengl sequences ui
-ui.baseline-alignment ui.gadgets ui.gadgets.buttons
-ui.gadgets.labels ui.gadgets.private ui.pens ui.render ui.text ;
+USING: accessors arrays colors.constants dlists io io.streams.string
+kernel namespaces opengl sequences ui ui.baseline-alignment ui.gadgets
+ui.gadgets.buttons ui.gadgets.labels ui.gadgets.private ui.pens
+ui.render ui.text vectors ;
 IN: ui.gadgets.debug
 
 ! We can't print to output-stream here because that might be a pane
@@ -12,7 +12,7 @@ IN: ui.gadgets.debug
 : with-grafted-gadget ( gadget quot -- )
     [
         <dlist> \ graft-queue set
-        <dlist> \ layout-queue set
+        100 <vector> \ layout-queue set
         over
         graft notify-queued
         dip
diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index 2a9aa1c2f9..74a0f06cf9 100644
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays binary-search combinators concurrency.flags
-deques dlists fry kernel locals make math math.order math.rectangles
+deques fry kernel locals make math math.order math.rectangles
 math.vectors models namespaces sequences threads vectors ;
 IN: ui.gadgets
 
@@ -143,10 +143,9 @@ CONSTANT: layout-queue-limit 8000
 
 : layout-later ( gadget -- )
     layout-queue [
-        [ push-back notify-ui-thread ] [ drop ] if*
-    ] [
-        dlist-length layout-queue-limit > [ yield ] when
-    ] bi ;
+        [ push notify-ui-thread ]
+        [ length layout-queue-limit > [ yield ] when ] bi
+    ] [ drop ] if* ;
 
 : invalidate* ( gadget -- )
     \ invalidate* >>layout-state
diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 796a2d39f6..1a45ba95ba 100644
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -3,9 +3,9 @@
 USING: accessors arrays assocs boxes classes.tuple
 classes.tuple.parser combinators combinators.short-circuit
 concurrency.flags concurrency.promises continuations deques
-destructors dlists fry init kernel lexer make math namespaces
-parser sequences sets strings threads ui.backend ui.gadgets
-ui.gadgets.private ui.gadgets.worlds ui.gestures vocabs.parser
+destructors dlists fry init kernel lexer make math namespaces parser
+sequences sets strings threads ui.backend ui.gadgets
+ui.gadgets.private ui.gadgets.worlds ui.gestures vectors vocabs.parser
 words ;
 IN: ui
 
@@ -105,7 +105,7 @@ M: world ungraft*
     f hand-world set-global
     f world set-global
     <dlist> \ graft-queue set-global
-    <dlist> \ layout-queue set-global
+    100 <vector> \ layout-queue set-global
     <dlist> \ gesture-queue set-global
     V{ } clone ui-windows set-global ;
 
@@ -113,17 +113,14 @@ M: world ungraft*
     dup hand-world get-global eq?
     [ hand-loc get-global swap move-hand ] [ drop ] if ;
 
-: (layout-queued) ( deque -- seq )
-    [
-        in-layout? on
-        [
-            dup layout find-world [ , ] when*
-        ] slurp-deque
-    ] { } make members ; inline
+: slurp-vector ( .. seq quot: ( ... elt -- .. ) -- )
+    over '[ _ empty? not ] -rot '[ _ pop @ ] while ; inline
 
 : layout-queued ( -- seq )
-    layout-queue dup deque-empty?
-    [ drop { } ] [ (layout-queued) ] if ;
+    layout-queue [
+        in-layout? on
+        [ dup layout find-world [ , ] when* ] slurp-vector
+    ] { } make members ;
 
 : redraw-worlds ( seq -- )
     [ dup update-hand draw-world ] each ;