From 2f025f58ae2b8796aed0f4beaf8b50e7b288a1f0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 25 Nov 2008 19:20:25 -0600
Subject: [PATCH 01/15] Frames had problems with resizing

---
 basis/ui/gadgets/frames/frames-tests.factor | 15 +++++++++++++-
 basis/ui/gadgets/frames/frames.factor       | 22 ++++++++++++---------
 2 files changed, 27 insertions(+), 10 deletions(-)

diff --git a/basis/ui/gadgets/frames/frames-tests.factor b/basis/ui/gadgets/frames/frames-tests.factor
index e38e97c76c..27d511e10a 100644
--- a/basis/ui/gadgets/frames/frames-tests.factor
+++ b/basis/ui/gadgets/frames/frames-tests.factor
@@ -1,4 +1,17 @@
+USING: accessors kernel namespaces tools.test ui.gadgets
+ui.gadgets.frames ui.gadgets.grids ui.gadgets.labels ;
 IN: ui.gadgets.frames.tests
-USING: ui.gadgets.frames ui.gadgets tools.test ;
 
 [ ] [ <frame> layout ] unit-test
+
+[ t ] [
+    <frame>
+        "Hello world" <label> @top grid-add
+        "Hello world" <label> @center grid-add
+        dup pref-dim "dim1" set
+        { 1000 1000 } >>dim
+        dup layout*
+        dup pref-dim "dim2" set
+        drop
+    "dim1" get "dim2" get =
+] unit-test
diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor
index b5c3736896..ae4c7d929a 100644
--- a/basis/ui/gadgets/frames/frames.factor
+++ b/basis/ui/gadgets/frames/frames.factor
@@ -1,15 +1,17 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic kernel math namespaces sequences words
-splitting grouping math.vectors ui.gadgets.grids ui.gadgets
-math.geometry.rect ;
+USING: accessors arrays generic kernel math namespaces sequences
+words splitting grouping math.vectors ui.gadgets.grids
+ui.gadgets math.geometry.rect ;
 IN: ui.gadgets.frames
 
-! A frame arranges gadgets in a 3x3 grid, where the center
-! gadgets gets left-over space.
-TUPLE: frame < grid ;
+TUPLE: glue < gadget ;
 
-: <frame-grid> ( -- grid ) 9 [ <gadget> ] replicate 3 group ;
+M: glue pref-dim* drop { 0 0 } ;
+
+: <glue> ( -- glue ) glue new-gadget ;
+
+: <frame-grid> ( -- grid ) 9 [ <glue> ] replicate 3 group ;
 
 : @center 1 1 ; inline
 : @left 0 1 ; inline
@@ -22,13 +24,15 @@ TUPLE: frame < grid ;
 : @bottom-left 0 2 ; inline
 : @bottom-right 2 2 ; inline
 
+TUPLE: frame < grid ;
+
 : new-frame ( class -- frame )
     <frame-grid> swap new-grid ; inline
 
 : <frame> ( -- frame )
     frame new-frame ;
 
-: (fill-center) ( n vec -- )
+: (fill-center) ( dim vec -- )
     [ [ first ] [ third ] bi v+ [v-] ] keep set-second ;
 
 : fill-center ( dim horiz vert -- )
@@ -36,4 +40,4 @@ TUPLE: frame < grid ;
 
 M: frame layout*
     dup compute-grid
-    [ [ rect-dim ] 2dip fill-center ] [ grid-layout ] 3bi ;
+    [ [ dim>> ] 2dip fill-center ] [ grid-layout ] 3bi ;

From c7c1f3903f64048f617116d5b3cac8d53ad0b91c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 25 Nov 2008 21:27:07 -0600
Subject: [PATCH 02/15] Fix performance problem: literals were being scanned
 too often

---
 vm/data_gc.c | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/vm/data_gc.c b/vm/data_gc.c
index 643747f777..ac77058fea 100755
--- a/vm/data_gc.c
+++ b/vm/data_gc.c
@@ -885,12 +885,13 @@ void garbage_collection(CELL gen,
 	/* collect objects referenced from older generations */
 	collect_cards();
 
-	if(collecting_gen != TENURED)
+	/* don't scan code heap unless it has pointers to this
+	generation or younger */
+	if(collecting_gen >= last_code_heap_scan)
 	{
-		/* don't scan code heap unless it has pointers to this
-		generation or younger */
-		if(collecting_gen >= last_code_heap_scan)
+		if(collecting_gen != TENURED)
 		{
+		
 			/* if we are doing code GC, then we will copy over
 			literals from any code block which gets marked as live.
 			if we are not doing code GC, just consider all literals
@@ -898,12 +899,12 @@ void garbage_collection(CELL gen,
 			code_heap_scans++;
 
 			collect_literals();
-
-			if(collecting_accumulation_gen_p())
-				last_code_heap_scan = collecting_gen;
-			else
-				last_code_heap_scan = collecting_gen + 1;
 		}
+
+		if(collecting_accumulation_gen_p())
+			last_code_heap_scan = collecting_gen;
+		else
+			last_code_heap_scan = collecting_gen + 1;
 	}
 
 	collect_next_loop(scan,&newspace->here);

From 826be7530ea310ddb133c974643eefe40288df71 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 25 Nov 2008 21:51:41 -0600
Subject: [PATCH 03/15] Check Mac OS X version on startup and give up if we're
 running something older than 10.5

---
 vm/os-macosx.m | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/vm/os-macosx.m b/vm/os-macosx.m
index d14e6ceb23..9b0366ff75 100644
--- a/vm/os-macosx.m
+++ b/vm/os-macosx.m
@@ -25,6 +25,14 @@ NS_ENDHANDLER
 
 void early_init(void)
 {
+	SInt32 version;
+	Gestalt(gestaltSystemVersion,&version);
+	if(version <= 0x1050)
+	{
+		printf("Factor requires Mac OS X 10.5 or later.\n");
+		exit(1);
+	}
+
 	[[NSAutoreleasePool alloc] init];
 }
 

From 418353b99e53a903311297f78e4879ae0b081999 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 25 Nov 2008 23:03:55 -0600
Subject: [PATCH 04/15] Locals-in-literals rewriting was broken if a lambda was
 nested inside of an array

---
 basis/locals/locals-tests.factor | 11 +++++++++++
 basis/locals/locals.factor       | 11 +++++++++--
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index 44c04da1a1..66551d83f3 100644
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -418,6 +418,17 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 [ "USE: locals [let | a" eval ] [ error>> unexpected-eof? ] must-fail-with
 [ "USE: locals [|" eval ] [ error>> unexpected-eof? ] must-fail-with
 
+[ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test
+[ 25 ] [ 5 [| | { [| a | a sq ] } ] call first call ] unit-test
+
+:: FAILdog-1 ( -- b ) { [| c | c ] } ;
+
+\ FAILdog-1 must-infer
+
+:: FAILdog-2 ( a -- b ) a { [| c | c ] } cond ;
+
+\ FAILdog-2 must-infer
+
 ! :: wlet-&&-test ( a -- ? )
 !     [wlet | is-integer? [ a integer? ]
 !             is-even? [ a even? ]
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index e66b1531d2..3b23795d90 100644
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -235,6 +235,8 @@ M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
 M: tuple rewrite-element
     [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
 
+M: lambda rewrite-element local-rewrite* ;
+
 M: local rewrite-element , ;
 
 M: local-reader rewrite-element , ;
@@ -252,7 +254,7 @@ M: tuple local-rewrite* rewrite-element ;
 M: hashtable local-rewrite* rewrite-element ;
 
 M: word local-rewrite*
-    dup { >r r> } memq?
+    dup { >r r> load-locals get-local drop-locals } memq?
     [ >r/r>-in-lambda-error ] [ call-next-method ] if ;
 
 M: object lambda-rewrite* , ;
@@ -350,10 +352,15 @@ M: wlet local-rewrite*
     word [ over "declared-effect" set-word-prop ] when*
     in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
 
+ERROR: bad-lambda-rewrite output ;
+
+M: bad-lambda-rewrite summary
+    drop "You have found a bug in locals. Please report." ;
+
 : parse-locals-definition ( word -- word quot )
     "(" expect parse-locals \ ; (parse-lambda) <lambda>
     2dup "lambda" set-word-prop
-    lambda-rewrite first ;
+    lambda-rewrite dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
 
 : (::) ( -- word def ) CREATE-WORD parse-locals-definition ;
 

From 51a2aa60375f053e9a2fa8176ca54c4715282f6b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 25 Nov 2008 23:04:13 -0600
Subject: [PATCH 05/15] Tweak case>quot so that it works with lambdas

---
 core/combinators/combinators.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index 893078fb39..68eef23691 100644
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -45,7 +45,7 @@ ERROR: no-cond ;
     [ rot \ if 3array append [ ] like ] assoc-each ;
 
 : cond>quot ( assoc -- quot )
-    [ dup callable? [ [ t ] swap 2array ] when ] map
+    [ dup pair? [ [ t ] swap 2array ] unless ] map
     reverse [ no-cond ] swap alist>quot ;
 
 ! case

From f8d4935e0d699d2d1b40354ab516f13c5d5f3f91 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 25 Nov 2008 23:04:34 -0600
Subject: [PATCH 06/15] Remove two remaining usage s of -roll from UI

---
 basis/ui/gadgets/menus/menus.factor |  3 +--
 basis/ui/traverse/traverse.factor   | 10 +++++-----
 2 files changed, 6 insertions(+), 7 deletions(-)

diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor
index 7dd57e526a..e973dd07dc 100644
--- a/basis/ui/gadgets/menus/menus.factor
+++ b/basis/ui/gadgets/menus/menus.factor
@@ -46,7 +46,6 @@ M: menu-glass layout* gadget-child prefer ;
     faint-boundary ;
 
 : <commands-menu> ( hook target commands -- gadget )
-    <filled-pile>
-        -roll
+    [ <filled-pile> ] 3dip
         [ <menu-item> add-gadget ] with with each
     5 <border> menu-theme ;
diff --git a/basis/ui/traverse/traverse.factor b/basis/ui/traverse/traverse.factor
index eadd110fe7..5135c3da6e 100644
--- a/basis/ui/traverse/traverse.factor
+++ b/basis/ui/traverse/traverse.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors namespaces make sequences kernel math arrays io
 ui.gadgets generic combinators ;
@@ -7,7 +7,7 @@ IN: ui.traverse
 TUPLE: node value children ;
 
 : traverse-step ( path gadget -- path' gadget' )
-    >r unclip r> children>> ?nth ;
+    [ unclip ] dip children>> ?nth ;
 
 : make-node ( quot -- ) { } make node boa , ; inline
 
@@ -43,7 +43,7 @@ TUPLE: node value children ;
     traverse-step traverse-from-path ;
 
 : (traverse-middle) ( frompath topath gadget -- )
-    >r >r first 1+ r> first r> children>> <slice> % ;
+    [ first 1+ ] [ first ] [ children>> ] tri* <slice> % ;
 
 : traverse-post ( topath gadget -- )
     traverse-step traverse-to-path ;
@@ -59,8 +59,8 @@ TUPLE: node value children ;
 DEFER: (gadget-subtree)
 
 : traverse-child ( frompath topath gadget -- )
-    dup -roll [
-        >r >r rest-slice r> r> traverse-step (gadget-subtree)
+    [ -rot ] keep [
+        [ rest-slice ] 2dip traverse-step (gadget-subtree)
     ] make-node ;
 
 : (gadget-subtree) ( frompath topath gadget -- )

From f3cdd650e7a3cc05133135e4dc826a362f7afac4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 25 Nov 2008 23:04:57 -0600
Subject: [PATCH 07/15] Clicking past the end of a document moves caret to the
 end

---
 basis/ui/gadgets/editors/editors.factor | 65 ++++++++++++++-----------
 1 file changed, 37 insertions(+), 28 deletions(-)

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 856795e4ed..59461c173f 100644
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -1,12 +1,12 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays documents io kernel math models
-namespaces make opengl opengl.gl sequences strings io.styles
-math.vectors sorting colors combinators assocs math.order fry
-calendar alarms ui.clipboards ui.commands ui.gadgets
-ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
-ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.wrappers
-ui.render ui.gestures math.geometry.rect ;
+namespaces locals fry make opengl opengl.gl sequences strings
+io.styles math.vectors sorting colors combinators assocs
+math.order fry calendar alarms ui.clipboards ui.commands
+ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.theme
+ui.gadgets.wrappers ui.render ui.gestures math.geometry.rect ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget
@@ -104,14 +104,20 @@ M: editor ungraft*
     editor-font* "" string-height ;
 
 : y>line ( y editor -- line# )
-    [ line-height / >fixnum ] keep model>> validate-line ;
+    line-height / >fixnum ;
 
-: point>loc ( point editor -- loc )
-    [
-        [ first2 ] dip tuck y>line dup ,
-        [ dup editor-font* ] dip
-        rot editor-line x>offset ,
-    ] { } make ;
+:: point>loc ( point editor -- loc )
+    point second editor y>line {
+        { [ dup 0 < ] [ drop { 0 0 } ] }
+        { [ dup editor model>> last-line# > ] [ drop editor model>> doc-end ] }
+        [| n |
+            n
+            point first
+            editor editor-font*
+            n editor editor-line
+            x>offset 2array
+        ]
+    } cond ;
 
 : clicked-loc ( editor -- loc )
     [ hand-rel ] keep point>loc ;
@@ -141,8 +147,8 @@ M: editor ungraft*
     line-height * ;
 
 : caret-loc ( editor -- loc )
-    [ editor-caret* ] keep 2dup loc>x
-    rot first rot line>y 2array ;
+    [ editor-caret* ] keep
+    [ loc>x ] [ [ first ] dip line>y ] 2bi 2array ;
 
 : caret-dim ( editor -- dim )
     line-height 0 swap 2array ;
@@ -175,12 +181,16 @@ M: editor ungraft*
     [ font>> ] dip { 0 0 } draw-string ;
 
 : first-visible-line ( editor -- n )
-    clip get rect-loc second origin get second -
-    swap y>line ;
+    [
+        [ clip get rect-loc second origin get second - ] dip
+        y>line
+    ] keep model>> validate-line ;
 
 : last-visible-line ( editor -- n )
-    clip get rect-extent nip second origin get second -
-    swap y>line 1+ ;
+    [
+        [ clip get rect-extent nip second origin get second - ] dip
+        y>line
+    ] keep model>> validate-line 1+ ;
 
 : with-editor ( editor quot -- )
     [
@@ -193,9 +203,8 @@ M: editor ungraft*
     ] with-scope ; inline
 
 : visible-lines ( editor -- seq )
-    \ first-visible-line get
-    \ last-visible-line get
-    rot control-value <slice> ;
+    [ \ first-visible-line get \ last-visible-line get ] dip
+    control-value <slice> ;
 
 : with-editor-translation ( n quot -- )
     [ line-translation origin get v+ ] dip with-translation ;
@@ -313,9 +322,9 @@ M: editor gadget-text* editor-string % ;
 : editor-cut ( editor clipboard -- )
     dupd gadget-copy remove-selection ;
 
-: delete/backspace ( elt editor quot -- )
+: delete/backspace ( editor quot -- )
     over gadget-selection? [
-        drop nip remove-selection
+        drop remove-selection
     ] [
         [ [ [ editor-caret* ] [ model>> ] bi ] dip call ]
         [ drop model>> ]
@@ -323,19 +332,19 @@ M: editor gadget-text* editor-string % ;
     ] if ; inline
 
 : editor-delete ( editor elt -- )
-    swap [ over [ rot next-elt ] dip swap ] delete/backspace ;
+    '[ dupd _ next-elt ] delete/backspace ;
 
 : editor-backspace ( editor elt -- )
-    swap [ over [ rot prev-elt ] dip ] delete/backspace ;
+    '[ over [ _ prev-elt ] dip ] delete/backspace ;
 
 : editor-select-prev ( editor elt -- )
-    swap [ rot prev-elt ] change-caret ;
+    '[ _ prev-elt ] change-caret ;
 
 : editor-prev ( editor elt -- )
     dupd editor-select-prev mark>caret ;
 
 : editor-select-next ( editor elt -- )
-    swap [ rot next-elt ] change-caret ;
+    '[ _ next-elt ] change-caret ;
 
 : editor-next ( editor elt -- )
     dupd editor-select-next mark>caret ;

From 4e9495a7e724a2d7daa0719a5c1cc2f74f8ac4cb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 25 Nov 2008 23:05:19 -0600
Subject: [PATCH 08/15] Tweak listener GUI layout

---
 basis/ui/tools/listener/listener.factor | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 1fe2d8eb24..de0ce43f20 100644
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -6,9 +6,9 @@ listener debugger threads boxes concurrency.flags math arrays
 generic accessors combinators assocs fry ui.commands ui.gadgets
 ui.gadgets.editors ui.gadgets.labelled ui.gadgets.panes
 ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.packs
-ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations
-ui.tools.browser ui.tools.interactor ui.tools.inspector
-ui.tools.workspace ;
+ui.gadgets.tracks ui.gadgets.borders ui.gadgets.frames
+ui.gadgets.grids ui.gestures ui.operations ui.tools.browser
+ui.tools.interactor ui.tools.inspector ui.tools.workspace ;
 IN: ui.tools.listener
 
 TUPLE: listener-gadget < track input output ;
@@ -153,9 +153,9 @@ M: engine-word word-completion-string
     dup <listener-input> >>input ;
 
 : <listener-scroller> ( listener -- scroller )
-    <filled-pile>
-        over output>> add-gadget
-        swap input>> add-gadget
+    <frame>
+        over output>> @top grid-add
+        swap input>> @center grid-add
     <scroller> ;
 
 : <listener-gadget> ( -- gadget )

From d334c60897285591a91bb9527fa8ed43f538c3e6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 26 Nov 2008 00:59:12 -0600
Subject: [PATCH 09/15] Fix literal rewriting for macro expansions that use fry
 to splice in a quot

---
 basis/locals/locals-tests.factor | 2 ++
 basis/locals/locals.factor       | 7 +++++++
 2 files changed, 9 insertions(+)

diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index 66551d83f3..8796721b1b 100644
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -429,6 +429,8 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 \ FAILdog-2 must-infer
 
+[ 3 ] [ 3 [| a | \ a ] call ] unit-test
+
 ! :: wlet-&&-test ( a -- ? )
 !     [wlet | is-integer? [ a integer? ]
 !             is-even? [ a even? ]
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index 3b23795d90..df713a50e7 100644
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -206,6 +206,8 @@ M: array rewrite-literal? [ rewrite-literal? ] contains? ;
 
 M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
 
+M: wrapper rewrite-literal? drop t ;
+
 M: hashtable rewrite-literal? drop t ;
 
 M: vector rewrite-literal? drop t ;
@@ -243,6 +245,9 @@ M: local-reader rewrite-element , ;
 
 M: word rewrite-element literalize , ;
 
+M: wrapper rewrite-element
+    dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
+
 M: object rewrite-element , ;
 
 M: array local-rewrite* rewrite-element ;
@@ -253,6 +258,8 @@ M: tuple local-rewrite* rewrite-element ;
 
 M: hashtable local-rewrite* rewrite-element ;
 
+M: wrapper local-rewrite* rewrite-element ;
+
 M: word local-rewrite*
     dup { >r r> load-locals get-local drop-locals } memq?
     [ >r/r>-in-lambda-error ] [ call-next-method ] if ;

From ef88afa323baa9ff78b0b86351a5af2ee050dd56 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 26 Nov 2008 01:00:23 -0600
Subject: [PATCH 10/15] Fix combinators.short-circuit for stricter locals
 invariant checking

---
 .../short-circuit/short-circuit.factor        | 21 ++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

diff --git a/basis/combinators/short-circuit/short-circuit.factor b/basis/combinators/short-circuit/short-circuit.factor
index 2b4e522789..d8bab4dd34 100644
--- a/basis/combinators/short-circuit/short-circuit.factor
+++ b/basis/combinators/short-circuit/short-circuit.factor
@@ -3,9 +3,13 @@ locals generalizations macros fry ;
 IN: combinators.short-circuit
 
 MACRO:: n&& ( quots n -- quot )
-    [ f ]
-    quots [| q | { [ drop n ndup q call dup not ] [ drop n ndrop f ] } ] map
-    [ n nnip ] suffix 1array
+    [ f ] quots [| q |
+        n
+        [ q '[ drop _ ndup @ dup not ] ]
+        [ '[ drop _ ndrop f ] ]
+        bi 2array
+    ] map
+    n '[ _ nnip ] suffix 1array
     [ cond ] 3append ;
 
 MACRO: 0&& ( quots -- quot ) '[ _ 0 n&& ] ;
@@ -14,10 +18,13 @@ MACRO: 2&& ( quots -- quot ) '[ _ 2 n&& ] ;
 MACRO: 3&& ( quots -- quot ) '[ _ 3 n&& ] ;
 
 MACRO:: n|| ( quots n -- quot )
-    [ f ]
-    quots
-    [| q | { [ drop n ndup q call dup ] [ n nnip ] } ] map
-    { [ drop n ndrop t ] [ f ] } suffix 1array
+    [ f ] quots [| q |
+        n
+        [ q '[ drop _ ndup @ dup ] ]
+        [ '[ _ nnip ] ]
+        bi 2array
+    ] map
+    n '[ drop _ ndrop t ] [ f ] 2array suffix 1array
     [ cond ] 3append ;
 
 MACRO: 0|| ( quots -- quot ) '[ _ 0 n|| ] ;

From 69d5628944dc1a7f89743644bbc23f2deebea0fe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 26 Nov 2008 01:41:13 -0600
Subject: [PATCH 11/15] Workaround bug in Apple X3100 driver

---
 basis/opengl/opengl.factor              | 17 +++++++++++++--
 basis/ui/gadgets/buttons/buttons.factor |  4 ++--
 basis/ui/render/render.factor           | 29 +++++++++++++++----------
 3 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor
index ecb4c4a08c..3b807bf8b6 100644
--- a/basis/opengl/opengl.factor
+++ b/basis/opengl/opengl.factor
@@ -71,18 +71,22 @@ MACRO: all-enabled-client-state ( seq quot -- )
     line-vertices GL_LINES 0 2 glDrawArrays ;
 
 : (rect-vertices) ( dim -- vertices )
+    #! We use GL_LINE_STRIP with a duplicated first vertex
+    #! instead of GL_LINE_LOOP to work around a bug in Apple's
+    #! X3100 driver.
     {
         [ drop 0.5 0.5 ]
         [ first 0.3 - 0.5 ]
         [ [ first 0.3 - ] [ second 0.3 - ] bi ]
         [ second 0.3 - 0.5 swap ]
-    } cleave 8 narray >c-float-array ;
+        [ drop 0.5 0.5 ]
+    } cleave 10 narray >c-float-array ;
 
 : rect-vertices ( dim -- )
     (rect-vertices) gl-vertex-pointer ;
 
 : (gl-rect) ( -- )
-    GL_LINE_LOOP 0 4 glDrawArrays ;
+    GL_LINE_STRIP 0 5 glDrawArrays ;
 
 : gl-rect ( dim -- )
     rect-vertices (gl-rect) ;
@@ -119,7 +123,16 @@ MACRO: all-enabled-client-state ( seq quot -- )
 : circle-points ( loc dim steps -- points )
     circle-steps unit-circle adjust-points scale-points ;
 
+: close-path ( points -- points' )
+    dup first suffix ;
+
 : circle-vertices ( loc dim steps -- vertices )
+    #! We use GL_LINE_STRIP with a duplicated first vertex
+    #! instead of GL_LINE_LOOP to work around a bug in Apple's
+    #! X3100 driver.
+    circle-points close-path concat >c-float-array ;
+
+: fill-circle-vertices ( loc dim steps -- vertices )
     circle-points concat >c-float-array ;
 
 : (gen-gl-object) ( quot -- id )
diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index 88d957f8cc..0fae5103ec 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -177,7 +177,7 @@ PRIVATE>
 
 M: radio-paint recompute-pen
     swap dim>>
-    [ { 4 4 } swap { 9 9 } v- circle-steps circle-vertices >>interior-vertices ]
+    [ { 4 4 } swap { 9 9 } v- circle-steps fill-circle-vertices >>interior-vertices ]
     [ { 1 1 } swap { 3 3 } v- circle-steps circle-vertices >>boundary-vertices ] bi
     drop ;
 
@@ -194,7 +194,7 @@ M: radio-paint draw-interior
 
 M: radio-paint draw-boundary
     [ (radio-paint) ] [ boundary-vertices>> gl-vertex-pointer ] bi
-    GL_LINE_LOOP 0 circle-steps glDrawArrays ;
+    GL_LINE_STRIP 0 circle-steps 1+ glDrawArrays ;
 
 :: radio-knob-theme ( gadget -- gadget )
     [let | radio-paint [ black <radio-paint> ] |
diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor
index 1e4c9c34f1..36c0d5f256 100755
--- a/basis/ui/render/render.factor
+++ b/basis/ui/render/render.factor
@@ -168,24 +168,29 @@ M: gradient draw-interior
     } cleave ;
 
 ! Polygon pen
-TUPLE: polygon color vertex-array count ;
+TUPLE: polygon color
+interior-vertices
+interior-count
+boundary-vertices
+boundary-count ;
 
 : <polygon> ( color points -- polygon )
-    [ concat >c-float-array ] [ length ] bi polygon boa ;
-
-: draw-polygon ( polygon mode -- )
-    swap
-    [ color>> gl-color ]
-    [ vertex-array>> gl-vertex-pointer ]
-    [ 0 swap count>> glDrawArrays ]
-    tri ;
+    dup close-path [ [ concat >c-float-array ] [ length ] bi ] bi@
+    polygon boa ;
 
 M: polygon draw-boundary
-    GL_LINE_LOOP draw-polygon drop ;
+    nip
+    [ color>> gl-color ]
+    [ boundary-vertices>> gl-vertex-pointer ]
+    [ [ GL_LINE_STRIP 0 ] dip boundary-count>> glDrawArrays ]
+    tri ;
 
 M: polygon draw-interior
-    dup count>> 2 > GL_POLYGON GL_LINES ?
-    draw-polygon drop ;
+    nip
+    [ color>> gl-color ]
+    [ interior-vertices>> gl-vertex-pointer ]
+    [ [ GL_POLYGON 0 ] dip interior-count>> glDrawArrays ]
+    tri ;
 
 : arrow-up    { { 3 0 } { 6 6 } { 0 6 } } ;
 : arrow-right { { 0 0 } { 6 3 } { 0 6 } } ;

From 53df21c03318051b7a49fe8687594ffe4ae95591 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 26 Nov 2008 04:08:52 -0600
Subject: [PATCH 12/15] Faster MD5

---
 basis/checksums/md5/md5.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor
index 6158254f84..257fd930c4 100644
--- a/basis/checksums/md5/md5.factor
+++ b/basis/checksums/md5/md5.factor
@@ -14,7 +14,7 @@ IN: checksums.md5
 SYMBOLS: a b c d old-a old-b old-c old-d ;
 
 : T ( N -- Y )
-    sin abs 4294967296 * >bignum ; foldable
+    sin abs 4294967296 * >integer ; foldable
 
 : initialize-md5 ( -- )
     0 bytes-read set

From d927ed5620f3a2ff0105b1f634f4451b99d840aa Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 26 Nov 2008 04:20:25 -0600
Subject: [PATCH 13/15] Better hints

---
 basis/math/bitwise/bitwise.factor | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor
index afd83d4458..2ccbbe4005 100644
--- a/basis/math/bitwise/bitwise.factor
+++ b/basis/math/bitwise/bitwise.factor
@@ -22,17 +22,15 @@ IN: math.bitwise
     [ shift ] dip 2^ wrap ; inline
 
 : bitroll ( x s w -- y )
-    [ wrap ] keep
-    [ shift-mod ]
-    [ [ - ] keep shift-mod ] 3bi bitor ; inline
+    [ shift-mod ] [ [ - ] keep shift-mod ] 3bi bitor ; inline
 
 : bitroll-32 ( n s -- n' ) 32 bitroll ; inline
 
-HINTS: bitroll-32 bignum fixnum ;
+HINTS: bitroll-32 { bignum fixnum } { fixnum fixnum } ;
 
 : bitroll-64 ( n s -- n' ) 64 bitroll ; inline
 
-HINTS: bitroll-64 bignum fixnum ;
+HINTS: bitroll-64 { bignum fixnum } { fixnum fixnum } ;
 
 ! 32-bit arithmetic
 : w+ ( int int -- int ) + 32 bits ; inline

From 498761376a3ef4c04edf71752ca5e3e33dea1607 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 26 Nov 2008 04:25:18 -0600
Subject: [PATCH 14/15] Cleanup

---
 basis/checksums/common/common.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/checksums/common/common.factor b/basis/checksums/common/common.factor
index 1f25efef24..7d5f34777d 100644
--- a/basis/checksums/common/common.factor
+++ b/basis/checksums/common/common.factor
@@ -18,4 +18,4 @@ SYMBOL: bytes-read
     ] "" make 64 group ;
 
 : update-old-new ( old new -- )
-    [ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline
+    [ [ get ] bi@ w+ dup ] 2keep [ set ] bi@ ; inline

From c7d86ebd554c71d09e0bfde0aaefc7e79a3632f7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 26 Nov 2008 05:24:35 -0600
Subject: [PATCH 15/15] Oops

---
 basis/math/bitwise/bitwise.factor | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor
index 2ccbbe4005..71ada945cd 100644
--- a/basis/math/bitwise/bitwise.factor
+++ b/basis/math/bitwise/bitwise.factor
@@ -22,16 +22,13 @@ IN: math.bitwise
     [ shift ] dip 2^ wrap ; inline
 
 : bitroll ( x s w -- y )
+    [ wrap ] keep
     [ shift-mod ] [ [ - ] keep shift-mod ] 3bi bitor ; inline
 
 : bitroll-32 ( n s -- n' ) 32 bitroll ; inline
 
-HINTS: bitroll-32 { bignum fixnum } { fixnum fixnum } ;
-
 : bitroll-64 ( n s -- n' ) 64 bitroll ; inline
 
-HINTS: bitroll-64 { bignum fixnum } { fixnum fixnum } ;
-
 ! 32-bit arithmetic
 : w+ ( int int -- int ) + 32 bits ; inline
 : w- ( int int -- int ) - 32 bits ; inline