Some simple-minded optimizations

TODO.FACTOR.txt

@@ -1,9 +1,5 @@
-- make-frame should compile
-
 - httpd search tools
-[2:45pm] tathi: Factor's text display is a bit odd sometimes, until you mouse over (or click, if there's no "live" text)
+- remaining HTML issues need fixing
-[2:48pm] tathi: it appears to be using the font metrics from the sprite tuple, but re-using the texture from the previous letter
-[2:59pm] tathi: hmm...and it looks like it's only be happening the first time you use a given character (from a given font face)
 
 + io:
 
@@ -16,7 +12,11 @@
 
 + ui:
 
-- why aren't some words compiled?
+[2:45pm] tathi: Factor's text display is a bit odd sometimes, until you mouse over (or click, if there's no "live" text)
+[2:48pm] tathi: it appears to be using the font metrics from the sprite tuple, but re-using the texture from the previous letter
+[2:59pm] tathi: hmm...and it looks like it's only be happening the first time you use a given character (from a given font face)
+- make-frame should compile
+- why aren't some cocoa words compiled?
 - editor:
   - delegation issue with fields and interactors
   - multi-line inserts
@@ -45,8 +45,6 @@
 - 'show' doesn't work if invoked from a listener on an object which is
   itself inspected in the listener
 - ui uses too much cpu time idling
-- too many motion events, etc
-- remaining HTML issues need fixing
 - see if its possible to only repaint dirty regions
 - x11 title bars are funny
 - fix top level window positioning

doc/handbook/cookbook.facts

@@ -207,7 +207,7 @@ ARTICLE: "cookbook-io" "I/O cookbook"
 }
 "Send some bytes to a remote host:"
 { $code
-    "\"myhost\" 1033 [ { 12 17 102 } write ] with-stream"
+    "\"myhost\" 1033 <client> [ { 12 17 102 } write ] with-stream"
 }
 { $references
     { }

library/collections/hashtables.factor

@@ -15,12 +15,16 @@ TUPLE: tombstone ;
 : probe ( keys i -- hash i ) 2 + over length mod ; inline
 
 : (key@) ( key keys i -- n )
-    3dup swap nth-unsafe {
+    #! cond form expanded by hand for better interpreter speed
-        { [ dup ((tombstone)) eq? ] [ 2drop probe (key@) ] }
+    3dup swap nth-unsafe dup ((tombstone)) eq? [
-        { [ dup ((empty)) eq? ] [ 2drop 3drop -1 ] }
+        2drop probe (key@)
-        { [ = ] [ 2nip ] }
+    ] [
-        { [ t ] [ probe (key@) ] }
+        dup ((empty)) eq? [
-    } cond ;
+            2drop 3drop -1
+        ] [
+            = [ 2nip ] [ probe (key@) ] if
+        ] if
+    ] if ; inline
 
 : key@ ( key hash -- n )
     hash-array 2dup hash@ (key@) ; inline
@@ -38,11 +42,16 @@ TUPLE: tombstone ;
     swap <hash-array> over set-hash-array init-hash ;
 
 : (new-key@) ( key keys i -- n )
-    3dup swap nth-unsafe {
+    #! cond form expanded by hand for better interpreter speed
-        { [ dup ((empty)) eq? ] [ 2drop 2nip ] }
+    3dup swap nth-unsafe dup ((empty)) eq? [
-        { [ = ] [ 2nip ] }
+        2drop 2nip
-        { [ t ] [ probe (new-key@) ] }
+    ] [
-    } cond ; inline
+        = [
+            2nip
+        ] [
+            probe (new-key@)
+        ] if
+    ] if ; inline
 
 : new-key@ ( key hash -- n )
     hash-array 2dup hash@ (new-key@) ; inline
@@ -241,8 +250,27 @@ M: hashtable hashcode ( hash -- n )
 : ?hash* ( key hash/f -- value/f )
     dup [ hash* ] [ 2drop f f ] if ;
 
+IN: hashtables-internals
+
+: (hash-stack) ( key i seq -- value )
+    over 0 < [
+        3drop f
+    ] [
+        3dup nth-unsafe dup [
+            hash* [
+                >r 3drop r>
+            ] [
+                drop >r 1- r> (hash-stack)
+            ] if
+        ] [
+            2drop >r 1- r> (hash-stack)
+        ] if
+    ] if ;
+
+IN: hashtables
+
 : hash-stack ( key seq -- value )
-    [ dupd hash-member? ] find-last nip ?hash ;
+    dup length 1- swap (hash-stack) ;
 
 : hash-intersect ( hash1 hash2 -- hash1/\hash2 )
     [ drop swap hash ] hash-subset-with ;

library/compiler/inference/branches.factor

@@ -4,6 +4,10 @@ IN: inference
 USING: arrays errors generic hashtables interpreter kernel math
 namespaces parser prettyprint sequences strings vectors words ;
 
+: add-inputs ( n stack -- stack )
+    tuck length - dup 0 >
+    [ value-vector dup rot nappend ] [ drop ] if ;
+
 : unify-lengths ( seq -- seq )
     #! Pad all vectors to the same length. If one vector is
     #! shorter, pad it with unknown results at the bottom.

library/compiler/inference/dataflow.factor

@@ -33,8 +33,11 @@ M: node = eq? ;
 : out-node ( outputs) >r f { } r> { } { } ;
 : meta-d-node meta-d get clone in-node ;
 
-: d-tail ( n -- list ) meta-d get tail* ;
+: d-tail ( n -- list )
-: r-tail ( n -- list ) meta-r get tail* ;
+    dup zero? [ drop f ] [ meta-d get tail* ] if ;
+
+: r-tail ( n -- list )
+    dup zero? [ drop f ] [ meta-r get tail* ] if ;
 
 : node-child node-children first ;
 

library/compiler/inference/inference.factor

@@ -48,13 +48,13 @@ SYMBOL: d-in
 
 : value-vector ( n -- vector ) [ drop <computed> ] map >vector ;
 
-: add-inputs ( n stack -- stack )
-    tuck length - dup 0 >
-    [ value-vector swap append ] [ drop ] if ;
-
 : ensure-values ( n -- )
-    dup meta-d get length [-] d-in [ + ] change
+    meta-d get length 2dup > [
-    meta-d [ add-inputs ] change ;
+        - dup d-in [ + ] change
+        value-vector meta-d [ dupd nappend ] change 
+    ] [
+        2drop
+    ] if ;
 
 : effect ( -- { in# out# } )
     #! After inference is finished, collect information.

library/compiler/inference/words.factor

@@ -7,10 +7,12 @@ IN: inference
 
 : consume-values ( n node -- )
     over ensure-values
-    over 0 rot node-inputs [ pop-d 2drop ] each ;
+    over 0 rot node-inputs
+    meta-d get [ length swap - ] keep set-length ;
 
 : produce-values ( n node -- )
-    over [ drop <computed> push-d ] each 0 swap node-outputs ;
+    >r [ drop <computed> ] map dup r> set-node-out-d
+    meta-d get swap nappend ;
 
 : consume/produce ( word effect -- )
     #! Add a node to the dataflow graph that consumes and

library/ui/text/editor.factor

@@ -3,7 +3,7 @@
 IN: gadgets-text
 USING: arrays errors freetype gadgets gadgets-borders
 gadgets-buttons gadgets-frames gadgets-labels gadgets-scrolling
-io kernel math models namespaces opengl sequences
+gadgets-theme io kernel math models namespaces opengl sequences
 strings styles ;
 
 TUPLE: editor