minor pane optimization

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 4748801f3cee6c0d4901455d1030c2ce80ee7bcd..52abb451379ff6740fbf64ee12792f8f9ca27da3 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -5,6 +5,8 @@
 \r
 + ui:\r
 \r
+- off-by-one error in pickup?\r
+- closing ui does not stop timers\r
 - adding/removing timers automatically for animated gadgets\r
 - fix listener prompt display after presentation commands invoked\r
 - theme abstraction in ui\r
@@ -13,7 +15,6 @@
 - gaps in pack layout\r
 - find out why so many small bignums get consed\r
 - faster mouse tracking\r
-- binary search to locate visible children of packs\r
 - rewrite frame layout for new style\r
 - an interior paint that is only painted on rollover and mouse press;\r
   use it for menu items. give menus a gradient background\r

diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index 52d919d66a2f52f76d5f401760443377104bdbf7..f524662b9746674eb31460d7d175034bdff98b41 100644 (file)
--- a/library/compiler/compiler.factor
+++ b/library/compiler/compiler.factor
@@ -63,3 +63,7 @@ M: compound (compile) ( word -- )
     #! Compute a quotation into an uninterned word, for testing
     #! purposes.
     gensym [ swap define-compound ] keep dup compile execute ;
+
+\ optimize profile
+\ linearize profile
+\ simplify profile

diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor
index 4c8b49c81872f0cdfffb264bae5b7941751dc496..5137e4bfee137921ce09a53d3db2e5f4fbfbdd72 100644 (file)
--- a/library/syntax/prettyprint.factor
+++ b/library/syntax/prettyprint.factor
@@ -321,7 +321,7 @@ M: wrapper pprint* ( wrapper -- )
 : short. ( object -- )
     dup unparse-short swap write-object terpri ;
 
-: [.] ( sequence -- ) [ unparse-short. ] each ;
+: [.] ( sequence -- ) [ short. ] each ;
 
 : stack. reverse-slice [.] ;
 

diff --git a/library/tools/annotations.factor b/library/tools/annotations.factor
index 0f2c88342670f288a6a0abbafad371ce792e79ba..1d3599705ef6fee7bc8e78ecd13420eb32f0434b 100644 (file)
--- a/library/tools/annotations.factor
+++ b/library/tools/annotations.factor
@@ -1,25 +1,23 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: words
+USING: interpreter io kernel lists math namespaces prettyprint
+sequences strings test ;
 
 ! The annotation words let you flag a word for either tracing
 ! or single-stepping. Note that currently, words referring to
-! annotated words cannot be compiled; and annotating a word has
-! no effect of compiled calls to that word.
-USING: interpreter io kernel lists namespaces prettyprint
-sequences strings test ;
-
+! annotated words cannot be compiled.
 : annotate ( word quot -- | quot: word def -- def )
     over >r >r dup word-def r> call r> swap define-compound ;
     inline
 
 : (watch) ( word def -- def )
     [
-        "===> Entering: " pick word-name append , \ print ,
-        \ .s ,
+        "===> Entering: " pick word-name append ,
+        [ print .s ] %
         %
-        "===> Leaving:  " swap word-name append , \ print ,
-        \ .s ,
+        "===> Leaving:  " swap word-name append ,
+        [ print .s ] %
     ] make-list ;
 
 : watch ( word -- )
@@ -31,6 +29,16 @@ sequences strings test ;
     #! Cause the word to start the code walker when executed.
     [ nip [ walk ] cons ] annotate ;
 
-: timer ( word -- )
-    #! Print the time taken to execute the word when it's called.
-    [ nip [ time ] cons ] annotate ;
+: +@ ( n var -- ) dup get [ swap >r + r> ] when* set ;
+
+: with-profile ( quot word -- )
+    millis >r >r call r> millis r> - swap global [ +@ ] bind ;
+    inline
+
+: (profile) ( word def -- def )
+    [ , literalize , \ with-profile , ] make-list ;
+
+: profile ( word -- )
+    #! When the word is called, time it, and add the time to
+    #! the value in a global variable named by the word.
+    [ (profile) ] annotate ;

diff --git a/library/tools/walker.factor b/library/tools/walker.factor
index b6fa1ea98797d61765f19d07a7f8e4e3c43b8f81..ed97dbedd0bbb6ce0ac498aa971d43dd4c55fc83 100644 (file)
--- a/library/tools/walker.factor
+++ b/library/tools/walker.factor
@@ -15,8 +15,7 @@ sequences io strings vectors words ;
 : &r
     #! Print stepper call stack, as well as the currently
     #! executing quotation.
-    meta-cf get unparse-short.
-    meta-executing get . meta-r get stack. ;
+    meta-cf get short. meta-executing get . meta-r get stack. ;
 
 : &get ( var -- value )
     #! Get stepper variable value.

diff --git a/library/ui/panes.factor b/library/ui/panes.factor
index ff31aab34d3465954cd32a5bf92aac85d997d0b7..d9102a76e3cb0e9e4426d561f742df1d524f8dfe 100644 (file)
--- a/library/ui/panes.factor
+++ b/library/ui/panes.factor
@@ -66,24 +66,26 @@ M: pane focusable-child* ( pane -- editor )
 : pane-clear ( pane -- )
     dup pane-output clear-incremental pane-current clear-gadget ;
 
-: pane-ignore? ( style text pane -- ? )
-    #! If we already have stuff in the current pack, and there
-    #! is no style information or text to write, ignore it.
-    #! Otherwise, we either have a fancy style (like an icon
-    #! or gadget being output), or we want the current pack to
-    #! have a minimal height so we put the empty label there.
-    pane-current gadget-children empty? not
-    rot not and swap empty? and ;
-
 : pane-write-1 ( style text pane -- )
-    3dup pane-ignore? [
+    pick not pick empty? and [
         3drop
     ] [
         >r <presentation> r> pane-current add-gadget
     ] ifte ;
 
+: prepare-print ( current -- gadget )
+    #! Optimization: if line has 1 child, add the child.
+    dup gadget-children {
+        { [ dup empty? ] [ 2drop "" <label> ] }
+        { [ dup length 1 = ] [ nip first ] }
+        { [ t ] [ drop ] }
+    } cond ;
+
+: pane-print-1 ( current pane -- )
+    >r prepare-print r> pane-output add-incremental ;
+
 : pane-terpri ( pane -- )
-    dup pane-current over pane-output add-incremental
+    dup pane-current over pane-print-1
     <line-shelf> over set-pane-current init-active-line ;
 
 : pane-write ( style pane list -- )