steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

using 2each in some places instead of zip [ uncons ... ] each

cvs
Slava Pestov 2005-07-25 02:59:23 +00:00
parent b547a0c224
commit b0ecd948ce
3 changed files with 14 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
library/tools/inspector.factor
View File

@ -31,7 +31,7 @@ M: hashtable sheet hash>alist unzip 2list ;
: describe ( obj -- list ) : describe ( obj -- list )
sheet dup first length count swons sheet dup first length count swons
dup peek over first zip [ uncons set ] each dup peek over first [ set ] 2each
[ column ] map [ column ] map
seq-transpose seq-transpose
[ " | " join ] map ; [ " | " join ] map ;

7
library/tools/memory.factor
View File

@ -87,11 +87,10 @@ M: object (each-slot) ( quot obj -- )
[ dup size swap type rot seq+ ] keep [ dup size swap type rot seq+ ] keep
1 swap type rot seq+ ; 1 swap type rot seq+ ;
: heap-stats ( -- stats ) : heap-stats ( -- counts sizes )
#! Return a list of instance count/total size pairs. #! Return a list of instance count/total size pairs.
num-types zero-vector num-types zero-vector num-types zero-vector num-types zero-vector
[ >r 2dup r> heap-stat-step ] each-object [ >r 2dup r> heap-stat-step ] each-object ;
swap >list swap >list zip ;
: heap-stat. ( type instances bytes -- ) : heap-stat. ( type instances bytes -- )
dup 0 = [ dup 0 = [
@ -104,7 +103,7 @@ M: object (each-slot) ( quot obj -- )
: heap-stats. ( -- ) : heap-stats. ( -- )
#! Print heap allocation breakdown. #! Print heap allocation breakdown.
0 heap-stats [ dupd uncons heap-stat. 1 + ] each drop ; 0 heap-stats [ >r >r dup r> r> heap-stat. 1 + ] 2each drop ;
: orphans ( word -- list ) : orphans ( word -- list )
#! Orphans are forgotten but still referenced. #! Orphans are forgotten but still referenced.

20
library/ui/layouts.factor
View File

@ -20,7 +20,7 @@ namespaces sdl sequences ;
TUPLE: pack align fill vector ; TUPLE: pack align fill vector ;
: pref-dims ( gadget -- list ) : pref-dims ( gadget -- list )
gadget-children [ pref-dim ] map >list ; gadget-children [ pref-dim ] map ;
: orient ( gadget list1 list2 -- list ) : orient ( gadget list1 list2 -- list )
zip >r pack-vector r> [ uncons rot set-axis ] map-with ; zip >r pack-vector r> [ uncons rot set-axis ] map-with ;
@ -31,28 +31,28 @@ TUPLE: pack align fill vector ;
rot pack-fill v*n v+ rot pack-fill v*n v+
] map-with ; ] map-with ;
: (packed-dims) ( gadget sizes -- list ) : (packed-dims) ( gadget sizes -- seq )
2dup packed-dim-2 swap orient ; 2dup packed-dim-2 swap orient ;
: packed-dims ( gadget sizes -- list ) : packed-dims ( gadget sizes -- seq )
over gadget-children >list >r (packed-dims) r> over gadget-children >r (packed-dims) r>
zip [ uncons set-gadget-dim ] each ; [ set-gadget-dim ] 2each ;
: packed-loc-1 ( sizes -- list ) : packed-loc-1 ( sizes -- seq )
{ 0 0 0 } [ v+ ] accumulate ; { 0 0 0 } [ v+ ] accumulate ;
: packed-loc-2 ( gadget sizes -- list ) : packed-loc-2 ( gadget sizes -- seq )
>r dup rectangle-dim { 1 1 1 } vmax over r> >r dup rectangle-dim { 1 1 1 } vmax over r>
packed-dim-2 [ v- ] map-with packed-dim-2 [ v- ] map-with
>r dup pack-align swap rectangle-dim { 1 1 1 } vmax r> >r dup pack-align swap rectangle-dim { 1 1 1 } vmax r>
[ >r 2dup r> v- n*v ] map 2nip ; [ >r 2dup r> v- n*v ] map 2nip ;
: (packed-locs) ( gadget sizes -- list ) : (packed-locs) ( gadget sizes -- seq )
dup packed-loc-1 >r dupd packed-loc-2 r> orient ; dup packed-loc-1 >r dupd packed-loc-2 r> orient ;
: packed-locs ( gadget sizes -- ) : packed-locs ( gadget sizes -- )
over gadget-children >list >r (packed-locs) r> over gadget-children >r (packed-locs) r>
zip [ uncons set-rectangle-loc ] each ; [ set-rectangle-loc ] 2each ;
: packed-layout ( gadget sizes -- ) : packed-layout ( gadget sizes -- )
2dup packed-locs packed-dims ; 2dup packed-locs packed-dims ;