From 54b24fd8b1060c80362898744e797b5d285935d7 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 13 Jul 2008 01:24:43 -0500
Subject: [PATCH 1/6] ui.gadgets: new effects for add-gadget, add-gadgets, and
 (add-gadget)

---
 extra/ui/gadgets/gadgets.factor | 31 ++++++++++++++++++-------------
 1 file changed, 18 insertions(+), 13 deletions(-)

diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor
index 3fc185a10e..ebe3773ce9 100755
--- a/extra/ui/gadgets/gadgets.factor
+++ b/extra/ui/gadgets/gadgets.factor
@@ -285,22 +285,27 @@ SYMBOL: in-layout?
     not-in-layout
     dup (clear-gadget) relayout ;
 
-: ((add-gadget)) ( gadget box -- )
-    [ children>> ?push ] keep (>>children) ;
+: ((add-gadget)) ( parent child -- parent )
+    over children>> ?push >>children ;
 
-: (add-gadget) ( gadget box -- )
-    over unparent
-    dup pick (>>parent)
-    [ ((add-gadget)) ] 2keep
-    graft-state>> second [ graft ] [ drop ] if ;
+: (add-gadget) ( parent child -- parent )
+    dup unparent
+    over >>parent
+    tuck ((add-gadget))
+    tuck graft-state>> second
+        [ graft ]
+        [ drop  ]
+    if ;
 
-: add-gadget ( gadget parent -- )
+: add-gadget ( parent child -- parent )
     not-in-layout
-    [ (add-gadget) ] keep relayout ;
-
-: add-gadgets ( seq parent -- )
+    (add-gadget)
+    dup relayout ;
+  
+: add-gadgets ( parent children -- parent )
     not-in-layout
-    swap [ over (add-gadget) ] each relayout ;
+    [ (add-gadget) ] each
+    dup relayout ;
 
 : parents ( gadget -- seq )
     [ parent>> ] follow ;
@@ -352,7 +357,7 @@ M: f request-focus-on 2drop ;
 : focus-path ( world -- seq )
     [ focus>> ] follow ;
 
-: gadget, ( gadget -- ) gadget get add-gadget ;
+: gadget, ( gadget -- ) gadget get swap add-gadget drop ;
 
 : g ( -- gadget ) gadget get ;
 

From 73e30123f52ae037b11f1977933c04e6e98f61fd Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 13 Jul 2008 01:25:44 -0500
Subject: [PATCH 2/6] ui.gadgets.*: updates for new effects

---
 extra/ui/gadgets/books/books.factor             |  2 +-
 extra/ui/gadgets/borders/borders.factor         |  2 +-
 extra/ui/gadgets/grids/grids.factor             |  4 ++--
 extra/ui/gadgets/incremental/incremental.factor |  2 +-
 extra/ui/gadgets/lists/lists.factor             |  2 +-
 extra/ui/gadgets/menus/menus.factor             |  4 ++--
 extra/ui/gadgets/panes/panes.factor             | 12 ++++++------
 extra/ui/gadgets/sliders/sliders.factor         |  2 +-
 extra/ui/gadgets/tabs/tabs.factor               |  4 ++--
 extra/ui/gadgets/tracks/tracks.factor           |  2 +-
 extra/ui/gadgets/viewports/viewports.factor     |  2 +-
 extra/ui/gadgets/wrappers/wrappers.factor       |  2 +-
 12 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/extra/ui/gadgets/books/books.factor b/extra/ui/gadgets/books/books.factor
index 93a8d271af..ce15bd9e6c 100755
--- a/extra/ui/gadgets/books/books.factor
+++ b/extra/ui/gadgets/books/books.factor
@@ -19,7 +19,7 @@ M: book model-changed
 : new-book ( pages model class -- book )
     new-gadget
         swap >>model
-        [ add-gadgets ] keep ; inline
+        [ swap add-gadgets drop ] keep ; inline
 
 : <book> ( pages model -- book )
     book new-book ;
diff --git a/extra/ui/gadgets/borders/borders.factor b/extra/ui/gadgets/borders/borders.factor
index 7d6a24fed1..d1cf7cfb29 100644
--- a/extra/ui/gadgets/borders/borders.factor
+++ b/extra/ui/gadgets/borders/borders.factor
@@ -10,7 +10,7 @@ TUPLE: border < gadget
 { align initial: { 1/2 1/2 } } ;
 
 : new-border ( child class -- border )
-    new-gadget [ add-gadget ] keep ; inline
+    new-gadget [ swap add-gadget drop ] keep ; inline
 
 : <border> ( child gap -- border )
     swap border new-border
diff --git a/extra/ui/gadgets/grids/grids.factor b/extra/ui/gadgets/grids/grids.factor
index b539934771..474e6b95c0 100644
--- a/extra/ui/gadgets/grids/grids.factor
+++ b/extra/ui/gadgets/grids/grids.factor
@@ -12,7 +12,7 @@ grid
 
 : new-grid ( children class -- grid )
     new-gadget
-    [ (>>grid) ] [ >r concat r> add-gadgets ] [ nip ] 2tri ;
+    [ (>>grid) ] [ >r concat r> swap add-gadgets drop ] [ nip ] 2tri ;
     inline
 
 : <grid> ( children -- grid )
@@ -21,7 +21,7 @@ grid
 : grid-child ( grid i j -- gadget ) rot grid>> nth nth ;
 
 : grid-add ( gadget grid i j -- )
-    >r >r 2dup add-gadget r> r>
+    >r >r 2dup swap add-gadget drop r> r>
     3dup grid-child unparent rot grid>> nth set-nth ;
 
 : grid-remove ( grid i j -- )
diff --git a/extra/ui/gadgets/incremental/incremental.factor b/extra/ui/gadgets/incremental/incremental.factor
index c74f6676ad..8c227d76ce 100755
--- a/extra/ui/gadgets/incremental/incremental.factor
+++ b/extra/ui/gadgets/incremental/incremental.factor
@@ -45,7 +45,7 @@ M: incremental pref-dim*
 
 : add-incremental ( gadget incremental -- )
     not-in-layout
-    2dup (add-gadget)
+    2dup swap (add-gadget) drop
     over prefer-incremental
     over layout-later
     2dup incremental-loc
diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor
index 776814853f..c2539e146a 100755
--- a/extra/ui/gadgets/lists/lists.factor
+++ b/extra/ui/gadgets/lists/lists.factor
@@ -48,7 +48,7 @@ TUPLE: list < pack index presenter color hook ;
 M: list model-changed
     nip
     dup clear-gadget
-    dup <list-items> over add-gadgets
+    dup <list-items> over swap add-gadgets drop
     bound-index ;
 
 : selected-rect ( list -- rect )
diff --git a/extra/ui/gadgets/menus/menus.factor b/extra/ui/gadgets/menus/menus.factor
index 3e1145a8b6..4f815bc33d 100644
--- a/extra/ui/gadgets/menus/menus.factor
+++ b/extra/ui/gadgets/menus/menus.factor
@@ -15,7 +15,7 @@ TUPLE: menu-glass < gadget ;
 : <menu-glass> ( menu world -- glass )
     menu-glass new-gadget
     >r over menu-loc over set-rect-loc r>
-    [ add-gadget ] keep ;
+    [ swap add-gadget drop ] keep ;
 
 M: menu-glass layout* gadget-child prefer ;
 
@@ -26,7 +26,7 @@ M: menu-glass layout* gadget-child prefer ;
 : show-glass ( gadget world -- )
     over hand-clicked set-global
     [ hide-glass ] keep
-    [ add-gadget ] 2keep
+    [ swap add-gadget drop ] 2keep
     set-world-glass ;
 
 : show-menu ( gadget owner -- )
diff --git a/extra/ui/gadgets/panes/panes.factor b/extra/ui/gadgets/panes/panes.factor
index 973c8c5725..9b547ce544 100755
--- a/extra/ui/gadgets/panes/panes.factor
+++ b/extra/ui/gadgets/panes/panes.factor
@@ -22,10 +22,10 @@ selection-color caret mark selecting? ;
     drop ;
 
 : add-output ( current pane -- )
-    [ set-pane-output ] [ add-gadget ] 2bi ;
+    [ set-pane-output ] [ swap add-gadget drop ] 2bi ;
 
 : add-current ( current pane -- )
-    [ set-pane-current ] [ add-gadget ] 2bi ;
+    [ set-pane-current ] [ swap add-gadget drop ] 2bi ;
 
 : prepare-line ( pane -- )
     [ clear-selection ]
@@ -120,7 +120,7 @@ C: <pane-stream> pane-stream
 GENERIC: write-gadget ( gadget stream -- )
 
 M: pane-stream write-gadget
-    pane-stream-pane pane-current add-gadget ;
+    pane-stream-pane pane-current swap add-gadget drop ;
 
 M: style-stream write-gadget
     stream>> write-gadget ;
@@ -299,12 +299,12 @@ M: paragraph dispose drop ;
 
 : gadget-write ( string gadget -- )
     over empty?
-    [ 2drop ] [ >r <label> text-theme r> add-gadget ] if ;
+    [ 2drop ] [ >r <label> text-theme r> swap add-gadget drop ] if ;
 
 M: pack stream-write gadget-write ;
 
 : gadget-bl ( style stream -- )
-    >r " " <word-break-gadget> style-label r> add-gadget ;
+    >r " " <word-break-gadget> style-label r> swap add-gadget drop ;
 
 M: paragraph stream-write
     swap " " split
@@ -322,7 +322,7 @@ M: paragraph stream-write1
 
 : gadget-format ( string style stream -- )
     pick empty?
-    [ 3drop ] [ >r swap <styled-label> r> add-gadget ] if ;
+    [ 3drop ] [ >r swap <styled-label> r> swap add-gadget drop ] if ;
 
 M: pack stream-format
     gadget-format ;
diff --git a/extra/ui/gadgets/sliders/sliders.factor b/extra/ui/gadgets/sliders/sliders.factor
index b5d8862359..641883e7e1 100755
--- a/extra/ui/gadgets/sliders/sliders.factor
+++ b/extra/ui/gadgets/sliders/sliders.factor
@@ -140,7 +140,7 @@ M: elevator layout*
 
 : elevator, ( orientation -- )
     dup <elevator> g-> set-slider-elevator
-    swap <thumb> g-> set-slider-thumb over add-gadget
+    swap <thumb> g-> set-slider-thumb add-gadget
     @center frame, ;
 
 : <left-button> ( -- button )
diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor
index 7c663f88e3..ce7e68c622 100755
--- a/extra/ui/gadgets/tabs/tabs.factor
+++ b/extra/ui/gadgets/tabs/tabs.factor
@@ -16,7 +16,7 @@ DEFER: (del-page)
     [ [ gadget-parent '[ , , , (del-page) ] "X" swap
        <bevel-button> @right frame, ] 3keep 
       [ swapd <toggle-button> @center frame, ] dip ] make-frame
-    swap add-gadget ;
+    add-gadget drop ;
 
 : redo-toggler ( tabbed -- )
      [ names>> ] [ model>> ] [ toggler>> ] tri
@@ -41,7 +41,7 @@ DEFER: (del-page)
     [ [ model>> swap ]
       [ names>> length 1 - swap ]
       [ toggler>> ] tri add-toggle ]
-    [ content>> add-gadget ]
+    [ content>> swap add-gadget drop ]
     [ refresh-book ] tri ;
 
 : del-page ( name tabbed -- )
diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 5de9b9d366..eca49d3aab 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -47,7 +47,7 @@ M: track pref-dim*
     rot gadget-orientation set-axis ;
 
 : track-add ( gadget track constraint -- )
-    over track-sizes push add-gadget ;
+    over track-sizes push swap add-gadget drop ;
 
 : track, ( gadget constraint -- )
     gadget get swap track-add ;
diff --git a/extra/ui/gadgets/viewports/viewports.factor b/extra/ui/gadgets/viewports/viewports.factor
index 100d6c8a39..91265abcfa 100755
--- a/extra/ui/gadgets/viewports/viewports.factor
+++ b/extra/ui/gadgets/viewports/viewports.factor
@@ -18,7 +18,7 @@ TUPLE: viewport < gadget ;
     viewport new-gadget
         swap >>model
         t >>clipped?
-        [ add-gadget ] keep ;
+        [ swap add-gadget drop ] keep ;
 
 M: viewport layout*
     dup rect-dim viewport-gap 2 v*n v-
diff --git a/extra/ui/gadgets/wrappers/wrappers.factor b/extra/ui/gadgets/wrappers/wrappers.factor
index 24fc13a4be..55846b2255 100644
--- a/extra/ui/gadgets/wrappers/wrappers.factor
+++ b/extra/ui/gadgets/wrappers/wrappers.factor
@@ -7,7 +7,7 @@ TUPLE: wrapper < gadget ;
 
 : new-wrapper ( child class -- wrapper )
     new-gadget
-        [ add-gadget ] keep ; inline
+        [ swap add-gadget drop ] keep ; inline
 
 : <wrapper> ( child -- border )
     wrapper new-wrapper ;

From 7c8d03f765272480f041365f56ef5dd450b0ad06 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 13 Jul 2008 01:28:53 -0500
Subject: [PATCH 3/6] ui.gadgets.*: update tests for new effects

---
 extra/ui/gadgets/gadgets-tests.factor            | 16 ++++++++--------
 .../ui/gadgets/scrollers/scrollers-tests.factor  |  2 +-
 extra/ui/gadgets/worlds/worlds-tests.factor      |  8 ++++----
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor
index 1bea304f15..1a2555d538 100755
--- a/extra/ui/gadgets/gadgets-tests.factor
+++ b/extra/ui/gadgets/gadgets-tests.factor
@@ -9,9 +9,9 @@ io.streams.string math.geometry.rect ;
     ! c contains b contains a
     <gadget> "a" set
     <gadget> "b" set
-    "a" get "b" get add-gadget
+    "a" get "b" get swap add-gadget drop
     <gadget> "c" set
-    "b" get "c" get add-gadget
+    "b" get "c" get swap add-gadget drop
 
     ! position a and b
     { 100 200 } "a" get set-rect-loc
@@ -33,8 +33,8 @@ io.streams.string math.geometry.rect ;
 <gadget> "g3" set
 { 100 200 } "g3" get set-rect-dim
 
-"g1" get "g2" get add-gadget
-"g2" get "g3" get add-gadget
+"g1" get "g2" get swap add-gadget drop
+"g2" get "g3" get swap add-gadget drop
 
 [ { 30 30 } ] [ "g1" get screen-loc ] unit-test
 [ { 30 30 } ] [ "g1" get screen-rect rect-loc ] unit-test
@@ -49,11 +49,11 @@ io.streams.string math.geometry.rect ;
 <gadget> "g1" set
 { 300 300 } "g1" get set-rect-dim
 <gadget> "g2" set
-"g2" get "g1" get add-gadget
+"g2" get "g1" get swap add-gadget drop
 { 20 20 } "g2" get set-rect-loc
 { 20 20 } "g2" get set-rect-dim
 <gadget> "g3" set
-"g3" get "g1" get add-gadget
+"g3" get "g1" get swap add-gadget drop
 { 100 100 } "g3" get set-rect-loc
 { 20 20 } "g3" get set-rect-dim
 
@@ -66,7 +66,7 @@ io.streams.string math.geometry.rect ;
 [ t ] [ { 110 110 } "g1" get pick-up "g3" get eq? ] unit-test
 
 <gadget> "g4" set
-"g4" get "g2" get add-gadget
+"g4" get "g2" get swap add-gadget drop
 { 5 5 } "g4" get set-rect-loc
 { 1 1 } "g4" get set-rect-dim
 
@@ -123,7 +123,7 @@ M: mock-gadget ungraft*
     : add-some-children
         3 [
             <mock-gadget> over <model> over set-gadget-model
-            dup "g" get add-gadget
+            dup "g" get swap add-gadget drop
             swap 1+ number>string set
         ] each ;
 
diff --git a/extra/ui/gadgets/scrollers/scrollers-tests.factor b/extra/ui/gadgets/scrollers/scrollers-tests.factor
index cfbb1fdca5..fb3e6cec23 100755
--- a/extra/ui/gadgets/scrollers/scrollers-tests.factor
+++ b/extra/ui/gadgets/scrollers/scrollers-tests.factor
@@ -61,7 +61,7 @@ tools.test.ui math.geometry.rect ;
 
 <gadget> { 600 400 } over set-rect-dim "g1" set
 <gadget> { 600 10 } over set-rect-dim "g2" set
-"g2" get "g1" get add-gadget
+"g2" get "g1" get swap add-gadget drop
 
 "g1" get <scroller>
 { 300 300 } over set-rect-dim
diff --git a/extra/ui/gadgets/worlds/worlds-tests.factor b/extra/ui/gadgets/worlds/worlds-tests.factor
index ea4612cd4e..4ce54c583f 100644
--- a/extra/ui/gadgets/worlds/worlds-tests.factor
+++ b/extra/ui/gadgets/worlds/worlds-tests.factor
@@ -18,7 +18,7 @@ namespaces models kernel ;
 
 <gadget> "g1" set
 <gadget> "g2" set
-"g1" get "g2" get add-gadget
+"g1" get "g2" get swap add-gadget drop
 
 [ ] [
     "g2" get <test-world> "w" set
@@ -33,8 +33,8 @@ namespaces models kernel ;
 <gadget> "g1" set
 <gadget> "g2" set
 <gadget> "g3" set
-"g1" get "g3" get add-gadget
-"g2" get "g3" get add-gadget
+"g1" get "g3" get swap add-gadget drop
+"g2" get "g3" get swap add-gadget drop
 
 [ ] [
     "g3" get <test-world> "w" set
@@ -55,7 +55,7 @@ TUPLE: focus-test < gadget ;
 
 : <focus-test>
     focus-test new-gadget
-    <focusing> over add-gadget ;
+    <focusing> over swap add-gadget drop ;
 
 M: focus-test focusable-child* gadget-child ;
 

From 731e57c7b7817982b25ee4ae0c25766bb575424e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 13 Jul 2008 02:02:08 -0500
Subject: [PATCH 4/6] automata.ui: update for new add-gadget effect

---
 extra/automata/ui/ui.factor | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/extra/automata/ui/ui.factor b/extra/automata/ui/ui.factor
index 5678a6f06b..78f1074eb8 100644
--- a/extra/automata/ui/ui.factor
+++ b/extra/automata/ui/ui.factor
@@ -23,11 +23,8 @@ IN: automata.ui
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-QUALIFIED: ui.gadgets
 QUALIFIED: ui.gadgets.grids
 
-: add-gadget ( parent child -- parent ) over ui.gadgets:add-gadget ;
-
 : grid-add ( grid child i j -- grid )
   >r >r dupd swap r> r> ui.gadgets.grids:grid-add ;
 

From 86f14db12d47a55e181136b7934f1df78b14a455 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 13 Jul 2008 02:05:04 -0500
Subject: [PATCH 5/6] boids.ui: update for new add-gadget effect

---
 extra/boids/ui/ui.factor | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor
index b1f594b8c2..6b175eeb5e 100755
--- a/extra/boids/ui/ui.factor
+++ b/extra/boids/ui/ui.factor
@@ -120,24 +120,24 @@ VARS: population-label cohesion-label alignment-label separation-label ;
     [ "1 - Randomize" [ drop randomize ] button* ]
 
     [ <pile> 1 over set-pack-fill
-      population-label> over add-gadget
-      "3 - Add 10" [ drop add-10-boids ] button* over add-gadget
-      "2 - Sub 10" [ drop sub-10-boids ] button* over add-gadget ]
+      population-label> add-gadget
+      "3 - Add 10" [ drop add-10-boids ] button* add-gadget
+      "2 - Sub 10" [ drop sub-10-boids ] button* add-gadget ]
 
     [ <pile> 1 over set-pack-fill
-      cohesion-label> over add-gadget
-      "q - +0.1" [ drop inc-cohesion-weight ] button* over add-gadget
-      "a - -0.1" [ drop dec-cohesion-weight ] button* over add-gadget ]
+      cohesion-label> add-gadget
+      "q - +0.1" [ drop inc-cohesion-weight ] button* add-gadget
+      "a - -0.1" [ drop dec-cohesion-weight ] button* add-gadget ]
 
     [ <pile> 1 over set-pack-fill
-      alignment-label> over add-gadget
-      "w - +0.1" [ drop inc-alignment-weight ] button* over add-gadget
-      "s - -0.1" [ drop dec-alignment-weight ] button* over add-gadget ]
+      alignment-label> add-gadget
+      "w - +0.1" [ drop inc-alignment-weight ] button* add-gadget
+      "s - -0.1" [ drop dec-alignment-weight ] button* add-gadget ]
 
     [ <pile> 1 over set-pack-fill
-      separation-label> over add-gadget
-      "e - +0.1" [ drop inc-separation-weight ] button* over add-gadget
-      "d - -0.1" [ drop dec-separation-weight ] button* over add-gadget ]
+      separation-label> add-gadget
+      "e - +0.1" [ drop inc-separation-weight ] button* add-gadget
+      "d - -0.1" [ drop dec-separation-weight ] button* add-gadget ]
 
   } [ call ] map [ [ gadget, ] each ] make-shelf
     1 over set-pack-fill

From aff81d80e7318619e10c8a5fa81d7f98c0baf5c2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 13 Jul 2008 02:29:59 -0500
Subject: [PATCH 6/6] Fix walker

---
 vm/quotations.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vm/quotations.c b/vm/quotations.c
index a1555136db..b75d3f79e0 100755
--- a/vm/quotations.c
+++ b/vm/quotations.c
@@ -386,7 +386,7 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
 				break;
 			}
 		default:
-			COUNT(userenv[JIT_PUSH_LITERAL],i)
+			COUNT(userenv[immediate_p(obj) ? JIT_PUSH_IMMEDIATE : JIT_PUSH_LITERAL],i)
 			break;
 		}
 	}