start incremental layout

CHANGES.txt

@@ -16,6 +16,8 @@ Factor 0.76:
   new string-in ( string quot -- ) word, calls quot with stdio bound to
   a stream that reads from the given string.
 
+- Improved inspector. Call it with inspect ( obj -- ).
+
 + Framework
 
 - md5 hashing algorithm in contrib/crypto/ (Doug Coleman).

TODO.FACTOR.txt

@@ -10,6 +10,7 @@
 <magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html
 <magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup
 
+- i/o: don't keep creating new sbufs
 - set-length should not shorten the underlying sequence
 - there is a problem with hashcodes of words and bootstrapping
 - http keep alive, and range get

library/bootstrap/boot-stage3.factor

@@ -68,6 +68,7 @@ t [
     "/library/inference/test.factor"
     "/library/tools/walker.factor"
     "/library/tools/annotations.factor"
+    "/library/tools/inspector.factor"
     "/library/bootstrap/image.factor"
     
     "/library/io/logging.factor"

library/collections/sequences-epilogue.factor

@@ -181,6 +181,11 @@ TUPLE: repeated length object ;
 M: repeated length repeated-length ;
 M: repeated nth nip repeated-object ;
 
+: seq-transpose ( list -- list )
+    #! An example illustrates this word best:
+    #! [ [ 1 2 3 ] [ 4 5 6 ] ] ==> [ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]
+    0 over nth length [ swap [ nth ] map-with ] project-with ;
+
 IN: kernel
 
 : depth ( -- n )

library/compiler/optimizer.factor

@@ -197,7 +197,7 @@ M: #values can-kill* ( literal node -- ? )
 
 : branch-values ( branches -- )
     [ last-node node-in-d >list ] map
-    unify-lengths dual branch-returns set ;
+    unify-lengths seq-transpose branch-returns set ;
 
 : can-kill-branches? ( literal node -- ? )
     #! Check if the literal appears in either branch. This

library/inference/branches.factor

@@ -28,13 +28,10 @@ sequences strings vectors words hashtables prettyprint ;
         [ value-class ] map class-or-list <computed>
     ] ifte ;
 
-: dual ( list -- list )
-    0 over nth length [ swap [ nth ] map-with ] project-with ;
-
 : unify-stacks ( list -- stack )
     #! Replace differing literals in stacks with unknown
     #! results.
-    unify-lengths dual [ unify-results ] map >vector ; 
+    unify-lengths seq-transpose [ unify-results ] map >vector ; 
 
 : balanced? ( list -- ? )
     #! Check if a list of [[ instack outstack ]] pairs is

library/math/matrices.factor

@@ -30,7 +30,6 @@ vectors ;
 : v. ( v v -- x ) v** sum ;
 
 : norm-sq ( v -- n ) 0 [ absq + ] reduce ;
-: norm ( v -- n ) norm-sq sqrt ;
 
 : proj ( u v -- w )
     #! Orthogonal projection of u onto v.

library/math/more-matrices.factor

@@ -3,5 +3,5 @@
 IN: matrices
 USING: kernel math ;
 
-: norm ( vec -- n ) dup v. sqrt ;
+: norm ( vec -- n ) norm-sq sqrt ;
 : normalize ( vec -- vec ) [ norm recip ] keep n*v ;

library/ui/incremental.factor

@@ -0,0 +1,38 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: generic kernel matrices ;
+
+! Incremental layout allows adding lines to panes to be O(1).
+! Note that incremental packs are distinct from ordinary packs
+! defined in layouts.factor, since you don't want all packs to
+! be incremental. In particular, if the children of the pack
+! change size, the incremental strategy does not work.
+
+! The cursor is the current size of the incremental pack.
+! New gadgets are added at cursor-cursor*pack-vector.
+
+TUPLE: incremental cursor ;
+
+M: incremental pref-dim incremental-cursor ;
+
+C: incremental ( pack -- incremental )
+    [ set-delegate ] keep
+    { 0 0 0 } over set-incremental-cursor ;
+
+: next-cursor ( gadget incremental -- cursor )
+    [
+        swap shape-dim swap incremental-cursor
+        2dup v+ >r vmax r>
+    ] keep  pack-vector set-axis ;
+
+: update-cursor ( gadget incremental -- )
+    [ next-cursor ] keep set-incremental-cursor ;
+
+: incremental-loc ( gadget incremental -- )
+    dup incremental-cursor dup rot pack-vector v* v-
+    swap set-gadget-loc ;
+
+: add-incremental ( gadget incremental -- )
+    ( 2dup add-gadget ) (  over prefer )  f over set-gadget-relayout?
+    ( 2dup incremental-loc ) ( update-cursor ) 2drop ;

library/ui/layouts.factor

@@ -19,18 +19,17 @@ namespaces sdl sequences ;
         drop
     ] ifte ;
 
-GENERIC: alignment
-GENERIC: filling
-GENERIC: orientation
-
 : pref-dims ( gadget -- list )
     gadget-children [ pref-dim ] map ;
 
 : orient ( gadget list1 list2 -- list )
-    zip >r orientation r> [ uncons rot set-axis ] map-with ;
+    zip >r pack-vector r> [ uncons rot set-axis ] map-with ;
 
 : packed-dim-2 ( gadget sizes -- list )
-    [ over shape-dim { 1 1 1 } vmax over v- rot filling v*n v+ ] map-with ;
+    [
+        over shape-dim { 1 1 1 } vmax over v-
+        rot pack-fill v*n v+
+    ] map-with ;
 
 : (packed-dims) ( gadget sizes -- list )
     2dup packed-dim-2 swap orient ;
@@ -43,8 +42,9 @@ GENERIC: orientation
     { 0 0 0 } [ v+ ] accumulate ;
 
 : packed-loc-2 ( gadget sizes -- list )
-    >r dup shape-dim { 1 1 1 } vmax over r> packed-dim-2 [ v- ] map-with
-    >r dup alignment swap shape-dim { 1 1 1 } vmax r>
+    >r dup shape-dim { 1 1 1 } vmax over r>
+    packed-dim-2 [ v- ] map-with
+    >r dup pack-align swap shape-dim { 1 1 1 } vmax r>
     [ >r 2dup r> v- n*v ] map 2nip ;
 
 : (packed-locs) ( gadget sizes -- list )
@@ -76,21 +76,14 @@ C: pack ( align fill vector -- pack )
 
 : <line-shelf> 0 0 <shelf> ;
 
-M: pack orientation pack-vector ;
-
-M: pack filling pack-fill ;
-
-M: pack alignment pack-align ;
-
 M: pack pref-dim ( pack -- dim )
     [
         pref-dims
         [ { 0 0 0 } [ vmax ] reduce ] keep
         { 0 0 0 } [ v+ ] reduce
-    ] keep orientation set-axis ;
+    ] keep pack-vector set-axis ;
 
-M: pack layout* ( pack -- )
-    dup pref-dims packed-layout ;
+M: pack layout* ( pack -- ) dup pref-dims packed-layout ;
 
 : <stack> ( list -- gadget )
     #! A stack lays out all its children on top of each other.

library/ui/load.factor

@@ -24,6 +24,7 @@ USING: kernel parser sequences io ;
     "/library/ui/menus.factor"
     "/library/ui/splitters.factor"
     "/library/ui/presentations.factor"
+    "/library/ui/incremental.factor"
     "/library/ui/panes.factor"
     "/library/ui/init-world.factor"
     "/library/ui/ui.factor"

library/ui/panes.factor

@@ -49,7 +49,7 @@ TUPLE: pane output active current input continuation ;
 
 C: pane ( -- pane )
     <line-pile> over set-delegate
-    <line-pile> over add-output
+    <line-pile> <incremental> over add-output
     <line-shelf> over set-pane-current
     "" <editor> over set-pane-input
     dup init-active-line
@@ -60,10 +60,10 @@ M: pane focusable-child* ( pane -- editor )
     pane-input ;
 
 : pane-write-1 ( style text pane -- )
-    [ <presentation> ] keep pane-current add-gadget ;
+    [ <presentation> ] keep pane-current add-incremental ;
 
 : pane-terpri ( pane -- )
-    dup pane-current over pane-output add-gadget
+    dup pane-current over pane-output add-incremental
     <line-shelf> over set-pane-current init-active-line ;
 
 : pane-write ( style pane list -- )

library/vocabularies.factor

@@ -94,9 +94,9 @@ SYMBOL: vocabularies
     "scratchpad" "in" set
     [
         "compiler" "debugger" "errors" "generic"
-        "hashtables" "inference" "interpreter" "jedit" "kernel"
-        "listener" "lists" "math" "matrices" "memory"
-        "namespaces" "parser" "prettyprint" "processes"
+        "hashtables" "inference" "inspector" "interpreter"
+        "jedit" "kernel" "listener" "lists" "math" "matrices"
+        "memory" "namespaces" "parser" "prettyprint" "processes"
         "sequences" "io" "strings" "styles" "syntax" "test"
         "threads" "unparser" "vectors" "words" "scratchpad"
     ] "use" set ;