From ec660c857ffcffbabb58db165cc4815fbbac2d0b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 00:04:56 -0500
Subject: [PATCH 01/11] Add unit test for Joe Groff's bg

---
 basis/compiler/tests/alien.factor | 40 ++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index e44ae681ff..dc73888796 100755
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -3,7 +3,7 @@ USING: alien alien.c-types alien.syntax compiler kernel
 namespaces namespaces tools.test sequences stack-checker
 stack-checker.errors words arrays parser quotations
 continuations effects namespaces.private io io.streams.string
-memory system threads tools.test math accessors ;
+memory system threads tools.test math accessors combinators ;
 
 FUNCTION: void ffi_test_0 ;
 [ ] [ ffi_test_0 ] unit-test
@@ -401,3 +401,41 @@ C-STRUCT: test_struct_13
 FUNCTION: int ffi_test_39 ( long a, long b, test_struct_13 s ) ;
 
 [ 21 ] [ 12347 12347 make-test-struct-13 ffi_test_39 ] unit-test
+
+! Joe Groff found this problem
+C-STRUCT: double-rect
+{ "double" "a" }
+{ "double" "b" }
+{ "double" "c" }
+{ "double" "d" } ;
+
+: <double-rect> ( a b c d -- foo )
+    "double-rect" <c-object>
+    {
+        [ set-double-rect-d ]
+        [ set-double-rect-c ]
+        [ set-double-rect-b ]
+        [ set-double-rect-a ]
+        [ ]
+    } cleave ;
+
+: >double-rect< ( foo -- a b c d )
+    {
+        [ double-rect-a ]
+        [ double-rect-b ]
+        [ double-rect-c ]
+        [ double-rect-d ]
+    } cleave ;
+
+: double-rect-callback ( -- alien )
+    "void" { "void*" "void*" "double-rect" } "cdecl"
+    [ "example" set-global 2drop ] alien-callback ;
+
+: double-rect-test ( arg -- arg' )
+    f f rot
+    double-rect-callback
+    "void" { "void*" "void*" "double-rect" } "cdecl" alien-indirect
+    "example" get-global ;
+
+[ 1.0 2.0 3.0 4.0 ]
+[ 1.0 2.0 3.0 4.0 <double-rect> double-rect-test >double-rect< ] unit-test

From 0eb8b5609c800c2ba5f83aadb904af9279343f40 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 03:24:40 -0500
Subject: [PATCH 02/11] Remove invaders.rom imported by accident

---
 .../space-invaders/resources/invaders.rom        | Bin 8192 -> 0 bytes
 1 file changed, 0 insertions(+), 0 deletions(-)
 delete mode 100644 unmaintained/space-invaders/resources/invaders.rom

diff --git a/unmaintained/space-invaders/resources/invaders.rom b/unmaintained/space-invaders/resources/invaders.rom
deleted file mode 100644
index 606ec01945d665881793becbde201b7292947a9e..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 8192
zcmeG>|9=}*a&K3w)k?A@tu5KoN{Zh~w(Qu!m?gH8#THIV{3Xy3X!zD^FA3prC^1d~
z7u&&>orFLR3WN`EB+&B7^$uL1t;4mSkWY`MvbOel6&`V75`w~qVv5B<!lk}kxZwC!
zohRA3<A?hTnzg<2=Dm5d^JeDFdoxA|X&-nIx;S!jO8eU!j1DMUu^h*>gcP4)oT+xC
zeuW2<%aM8(8~c+{G|H4KXEAB<4Jlt?^-CDriPZCWFwsd#1`~gc$bZ^2=zAWJok;tE
zCCUJ$b|WH9#j1jp0Zb4>T3J$PMU%&er!VUWo+0?`A9H&Rsl(WLVkeR@CO5NW83R1Y
z<HA%de1B)iibHlhSrs!(i80iu2-q;9C^3N=lzgm5S>>{<Tn=fU3zYMpeq<KM1`|s>
zQ!0-;)ppz-8=OqmG2w75+?+Nn7R%ZqB%^@uZ1>=Q-N01ZG4CQ1o*@NcU9LgCv%0zw
z500q_560<i;8Mgk81?V{gz0QHC)O|ukI8msJ&4+8RHU}}wksS4Wx(_z)F)eUb9j|u
zpLv1##J;wB)YbB+TieBK92{HQGwQna(MIh>#*-wB%;P!~UR8(4M~rO7v4%9$H6*v=
z`*n~_=IcRTb7F+iC-o@9e=4)3+I#MBbGYa6u5kC`T{<5ZkzYnwQzUu0tX*Q{<sk<r
z;^0Ys5mBV$`H9~%FjMoh@N%<5;_{HTfC5?Bff=?)<}0Gy#SwJ}SaUf`9*~Bo8^=zH
zpR&H=+CrA}y0uzXcHx+j88eLJ4mR9;>%pEx7aIo6?qS2<58pX;c1rGK|L5eFlVTq7
zX*aWGF44y}nm1Q<iLPu%ZB>=FgPjZmljIGiaBaM0NZE*$2XM4T`5W9_XAajUUNKcl
zRR5)J_?qbQLsOA>L_YSZ9aR6|fn(R9(#zySAE~wuCOeAA7v9)la*;`WAAA%*JHF^l
zDJJ4zNw@HDcxzSFW<)+`rkzolM<)tQJdTExc1#Z0h7=KZPna8&eVClGl7311)<WOK
z0<p5%B^EqN-iSf*u|e&i302iGsvoyxH^Byz8pO`j4wEzWj7jS>k$ADi0;mO0*^9{y
z5^0ghQg;+71z7JkK1z0)8WcYU(r%*$kj5MWR#rS1T+kwK4(#p>c_~F=B`618TC+*4
z#Dte7$3cWKgGtVq3^r-w!muAIx!PnM7c-pkDN@6c+uf7l#o=&mE&SGo>jdc2kh`G^
zBpwwM;F87ReR669h=(VStBdgNPGun`&$-q0pjCy%x?vvE>NvR^Yp{SUSGf#}Wq#fQ
zR;YX$FX}Tkr2c}dUK4s6S3Zjug`UOgV_=q8nqd~QiHA7mQ$v0dZwZGt>yxVDR}@^i
z1o!=0;z_P5v;^y7EslOmR-4sktZc^Womkm|$p*99jR)mgocNwutnte=V1IDqN%bLW
z@BwTvad8EXeog1qeRtkAY`9WiaB8bx*@m-RR%E#}`Q;|+MT(^E#El8T4BPP`T)7Qv
zF@93K14qyNK?q=(69SldQj5*%-B+01k!7~pFR#uq0|ueHv99!E`C-i4K}c~90v<~b
zB!<lp%?wU`04Luu4~~WFkh&SX@<-+t^%y=pu5JP3$8!jnH0kGo<*G0WZNubRejK7m
z&#0xn@06`G^eFvC?3;nE@M2x;rCtC|kY*A$@!`efhrHT@M@@1+K9c&(d@4`r!Rn*n
znlU_}Jc`LC9xzx;0iU%jMHT>Jl!O2CFM-3U594nb<zcL6-J_j!dU}k!)N5vkU3<-(
zPlMb8MdsLGeY|hf-swry^Sa!PYiSs6=i%e>$AM4}mV0q+ZB=b;lvnz&wuv8%YcSM9
zonL#-J=eJ19csnk3t&bzF7JXsoOGJO@Pi4bnZ}N{c(9Nmq@3nDhBR2jC$lS+chiV{
ziU(hcg~N|4(A!|42*lTKd1La#x4h095EQ~7R7vt?i{VY?Sq9_$d3hg>9q3Bq2{Y_o
zvfM(By5Xz5jjXlshW4=!9AO%RCpSAdd38{{B`6(ER#?J?`H7$<raXZoXyZb7LchT<
zS(_H<d#PJ~BD<;<iFeTt9PA>Si{;*6=n1TW%)9*H3BdSyoQ+I9K8PlAVU2j9#KDmZ
z0vwl(va7=3PTVDk$0X=E!=$-nzlGmFq`Z$|cwp|Rl@SVE!l7AA%6z2C2Qf}&m|o>P
z4t;?`Q<&W8Bj*`%ks-$gB_k`D5cv=eR6|yb5Q#H{^U2*yLbGycHUt3=A{lvF08xNs
z7?WcRnAMruDv&}J5b`!6$9-^c&3K8oh}eAOf`{y}f-we@=dHw1Olqy<v_KXWlY4B*
zHi73T<qwM|c*1$L5_;l_|4!G!?}O`uGu0tDQ~NAhKimSeS1d$gHMgJ&xTVsH&uWiT
za_Uvpv$`x+iJScn2UQFR6b;B?{RbH#dQgdDH4bqo%_ZIyNYYBK^J#AgJeC9HS;>zI
za$qT#6FSeZY161lr=DXSk6u<{;K&gD<3PY;?Wo&fl1`G0a2%|9LC{6CU@C$-!K%Kq
zle{p&gF#g*HoC_vpQEv9p;bmam~R)Z3O$E)A{JF=Vmfj8s;VIB@*en_kZiR=I7wQ=
zvBRg~+*usEC^KcHrHzTZp<i4VfKWf(K%SDav+7VZqwJ?qY{n}e2pa6^u)&=U>o8xP
zh7}Hh3r<!32A`db?JDnD8;(6$-gOsTM(*#_{@J>n{M`EJ$%{^S(oQmBozA|G>!XsE
z$!bi#gip(}a5Z5|;lj|DE-?bBUs**S`Ff3})JImGG{DLBB|XwWZx`v&2ge=N{#3OQ
zOIsSc<bMc;8xw`L*ktu=SGaCTuQPSMEh^Jv5PXaCX`Dd)EY8rzJ+{Q{HaMW?tV6w_
z#g^;URSz~YIz14Ry|z|f02f)-O?s^{`2t*Ks=DCBl<&=6)Q0f{uO0=u-5}dA)=x^*
zK2b}KZDZn98`$c3n+}l{ZVu5V?L%910A7>Y*6al_^$VLbwbAQLy#+MxDu+{h-Zm#v
zA_ZLu%;&)-9GWmqn8{AxW%9O7JqL$MagBpZ{K_uQ1jzF?aVSWR*<grxym0(eg2YO@
z_@YEUvylOtc+j6~0EMWRTxrYiTo3W%s2iqGon~aX{MvI{knS<qX|VS|UlLrcayyOg
zsA)TF6;Rd|`;bzGsls+a3pOHrevi+QCyR^3y(M%PoWll6{EJ-{uaB~z73S|s$emtt
zi}ws`NojWGKnYRj#09#PT|7B2+N)mqT<)R>a%unV72gWNDmA+uwzKxKuMi1^jtJ{;
z!sfgBT-Cr;4P4d0RSjI#z*P<Wf71YY#EnL#qzUef=}=d=a46T9WH7Q0n-gX?ROWzW
zWNN4@+!dbhE_drAQdi*|(Naou<;hZK`Ca?^JVR*BPrbvf_oXcptkxopOvMTc!}*Dr
zdw#Ijt;6&oWj&q~>Ei3jH{5V_T92o%NC$oYaiwp5=03MRG}1LE(0guOEyGZ-fV@&&
zh>g=NCu%$@3)kyz<NXsoo>9JqUh?;z;5>(6WFxuPqgG;?>W1#aQ8T@h?eIW0TH}F|
z+gcl~*i3k$F2w}*RTGSAD?PFa*TyUFqq%>nJIX=l5EM!H-$5FQ9O&H-_IlnOA9dwv
zf9ZiQ{eZ0TEHi)N>eN*mhW00}cBr>0yRo*y(+%~Vfq{V?joIp>o;T{6+3V5Oe7JwU
z<B@+BB_p13-T>-++zmxe)qxcYT<}ZF=m44a4ry<A_+rS2A1s0*;4eKoHP_Uf`sVe2
zMf)FmCTSAGpn6zd#*+tAzV-AdkSsBA`9Y{>>DAd}EO&j6)2d#$`CuHhnX9iQZ!c1>
z0nu8EpsJO2je%TcSh)r=BZ|gp3#vkOOy$=&+-Jm68;YtQ34M)YN)YSy`cN(l0;NK>
zBwobQ5r37Ge5&Zgz9Q|}q9XvPL&OTmYG1Zurx(el3h{Nx;fA|wSsCxoCVTG`@quo*
z4Aa|kw!WtqX<xIl_ZmuR1IpZGd<b%5xbPqMX+N^l+<ORW8|1V*m#o5-``1O;9J-v$
z_^4d`W$i&<Hj5Jv2jrhf4z5Kye4@OVrvHKBm~ssANbo6?SX#{g9<0o>kikI_@D*J9
zUPm#l0w+6)<sXAr&?>-$Ih!qa6j#NvsSbF^E5KkMPS;GBb@fG{ezRB>B~hkTs3Rwy
zf$wO$izVeHOsA)7T4HIZ#c(BlRvcvxb`2>nVtGIC=Fihl&s8#j6E&9eL=wvM`WY5}
z)7+T)GS~_h3=2JFH77m>2FlAA)_PfdHy{^5(nD4BHso3_V<<~#pybDB>BVA!noFE#
zXkzNB5PuqQcpw9b+LTS0ITD1lBUSGuH+i)RFHB~R(Vo+giD;^K1UA7^_pm;qZo;<$
z^I_d)Wa`H{O}2KEZLP_6muZk@VT;47pnlz=Ch_6qKCha<X|D1;oY><Pp^zT>C6-5M
zA?2(#;el8JLLUWRT8+hcuFeY;{Q(TQa}0wnhp~DGPBY2F-YiVSy);9LAn*$9kc}=L
zku(D}k*ENM)4sBSn&dCAb3Cl`EGWD&&gtq4_@MFvo-pY$3TYYxzM;M30V=9e$jBW5
zc|oc8xujhXAg$J}^Fd+_Z>VO^r{fNb%+!i+lmG=3YGkHC`?*#AEhQp<B@xLtSE*U;
zBMm;S#RnxRZA%d>tOILl>U{7I6s^HWQ{Jb18kB{=*N^xdg}{ymQ*{CCvw!kIJ!sph
zt?>qB0j5o3aa{ISi@&owtUy;WpT~(#hlmOVM}7tH{}Ss%+Jq0m3J=V!kSR~j_@EZS
zyKV(j^)x2V`M_vL-MvO_V#cS-TXD0L9{9(2y{=T128zUdn_%J1oQY)?SC@wZUQeOR
zk)LO`TFe;<f{HnzNP12atHRCeJM|IX)LYWtSJG)ttdx4wH-3ZLhe5Bj3IUae#9B#*
zh;*onM*9b)`I!BHq|-Y6*u};!lJ-qQ)g<lIMyz!4nZpJSxL!p#P~)<LC@7DMI6Ryf
zi8$@Z%Za6tGJnJ&MglpsAi}r{3my3pN50(~@#i`t^PQ0b)**7G{<4TgxG~$F>j{)a
z7=&E(gKYPb?j`6FLIda-He=3P7r-?x7=-5+Cgj>1sHkB$l*s_)HZI%E{W^e<37Urh
zXHby)Y!2Va1I`Dzaf)Y99Dqw^Pz@>oVk+AF8vJFmh@mVIzArew(95m~A_39aO~4Rk
zmyb+bx4Te~8aK|)Zful*mN~rdfZvrt2mF9g=^eD3iI8PHF!l<_LnqkbKO!?T9jY%o
zl6?U~=8+Ou9(@AW!e2T3Ek$T)&-RDT&CHy8XnPM}@N@@{Y-(s|*mNY=oyF02nJwAg
z-$Cg+`nNC1jyt?ZIvN`qJC1lAIr={m7CM|I@bqW;DS&bV#}t|@|LVNfbZr}Ff|Uy9
zpV~~{bC#FeZ*F=_Y<2E$h&8?&?cHDQmm*GwkY89(kuw=Gc~CyfMG6sP=PFnit|=7k
z;QwtQ_m1Ug`3`re4ff4VZ@TuZ3Ax_9DYRzKO3#rSzhB19a;{kyp2Y*R1IR$7MghEA
zjlE!rg`g7)!!Vqk;Y|!<x3U6j=PWie{C|qK2sYkk$~ZG6nHw|xnaphFQs#fZ^K%LM
zvQIxylw_P{m#5~1mtOvRml;|vm$}9TFOMs09xiV|eYE$HSnQGBX#Ik`oC}4}YfZww
z#zPHtL09X&hl2Zr<$GZbkrK%-N&XTkC`qu)b*o!jTbr7isOuCs5vU*{<a@x*Vu54P
z#$ete9I!2F3J8l(Amgb1G?-WYRnS)b+n`XrKaeS363O!x6mp`sJUFk=^1yrx%u`Z&
zQ)vmn{<gNZI)Kq-%a(;G4lp{`zl=gE1V9*H(L!-S5c&b4W&Ly*v7pBoz<$9U%F+W4
zK8O0T7gM@^m%vd-`Dgh8znUz*VtFGSZ@p#ZbpRERBLc9gslTZSU~G<WFUzpKfcLX`
zEakJoEx0!TT<3DS)&cyp6>Ybz2N(rN`6IcXejbHaw6#&b%a^s?b3ed5cWFP>{?^-W
zyKNP~1q<8SngKSow60zUux?Hd*R{2+Yyf<2Ik3)<I~$jwk3Met01UbN-Be$&?ZBT=
zX)Y|yZSjJ#NTk9)heRTNsJIFF5vmsk6h?ou;@5buY#AZHfD;QNS;G9v)g`vddrK^p
zlO-8e<V-?gBsXEnAGRcJ`t#KozE5LjW}w9N5*jE0_TwRlpD#fCtO(4@5(#9v7C7An
MmIwm#39z331Jt3$sQ>@~


From 6d050a61a7066bf4c06aba2c8eed8f95dbc832e2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 04:02:32 -0500
Subject: [PATCH 03/11] Fix Joe Groff's x86-64 structs/callbacks bug

---
 basis/cpu/x86/32/32.factor                     | 3 +++
 basis/cpu/x86/64/64.factor                     | 3 +++
 basis/cpu/x86/architecture/architecture.factor | 7 -------
 3 files changed, 6 insertions(+), 7 deletions(-)

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 6f255893db..67a8ec8a2c 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -173,6 +173,9 @@ M: x86.32 %box-long-long ( n func -- )
         [ (%box-long-long) ] [ f %alien-invoke ] bi*
     ] with-aligned-stack ;
 
+: struct-return@ ( size n -- n )
+    [ stack-frame* cell + + ] [ \ stack-frame get swap - ] ?if ;
+
 M: x86.32 %box-large-struct ( n size -- )
     ! Compute destination address
     [ swap struct-return@ ] keep
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 1eb4a7896b..4770c09a83 100755
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -116,6 +116,9 @@ M: x86.64 %box-small-struct ( size -- )
     RDX swap MOV
     "box_small_struct" f %alien-invoke ;
 
+: struct-return@ ( size n -- n )
+    [ ] [ \ stack-frame get swap - ] ?if ;
+
 M: x86.64 %box-large-struct ( n size -- )
     ! Struct size is parameter 2
     RSI over MOV
diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor
index 13524aecc4..171e67bcfb 100755
--- a/basis/cpu/x86/architecture/architecture.factor
+++ b/basis/cpu/x86/architecture/architecture.factor
@@ -141,13 +141,6 @@ M: x86 small-enough? ( n -- ? )
 
 : temp@ ( n -- op ) stack-reg \ stack-frame get rot - [+] ;
 
-: struct-return@ ( size n -- n )
-    [
-        stack-frame* cell + +
-    ] [
-        \ stack-frame get swap -
-    ] ?if ;
-
 HOOK: %unbox-struct-1 cpu ( -- )
 
 HOOK: %unbox-struct-2 cpu ( -- )

From 10e9f09ccf1a0267b31ecead3515186a387aa9b0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 04:02:42 -0500
Subject: [PATCH 04/11] Add missing type

---
 basis/cocoa/types/types.factor | 1 +
 1 file changed, 1 insertion(+)

diff --git a/basis/cocoa/types/types.factor b/basis/cocoa/types/types.factor
index 6e65bc1a72..0bf4257a0b 100644
--- a/basis/cocoa/types/types.factor
+++ b/basis/cocoa/types/types.factor
@@ -46,6 +46,7 @@ C-STRUCT: NSSize
     { "CGFloat" "h" } ;
 
 TYPEDEF: NSSize _NSSize
+TYPEDEF: NSSize CGSize
 TYPEDEF: NSPoint CGPoint
 
 : <NSSize> ( w h -- size )

From 0699aa5640eea8290b96ca7f57eccc309c7f51cd Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 04:02:54 -0500
Subject: [PATCH 05/11] Fix regression

---
 .../generator/registers/registers.factor         | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/basis/compiler/generator/registers/registers.factor b/basis/compiler/generator/registers/registers.factor
index 76d3c32594..6fdb8d9886 100755
--- a/basis/compiler/generator/registers/registers.factor
+++ b/basis/compiler/generator/registers/registers.factor
@@ -50,13 +50,21 @@ C: <vreg> vreg ( n reg-class -- vreg )
 
 M: vreg v>operand [ n>> ] [ reg-class>> ] bi vregs nth ;
 M: vreg live-vregs* , ;
-M: vreg move-spec reg-class>> move-spec ;
+
+M: vreg move-spec
+    reg-class>> {
+        { [ dup int-regs? ] [ f ] }
+        { [ dup float-regs? ] [ float ] }
+    } cond nip ;
+
+M: vreg operand-class*
+    reg-class>> {
+        { [ dup int-regs? ] [ f ] }
+        { [ dup float-regs? ] [ float ] }
+    } cond nip ;
 
 INSTANCE: vreg value
 
-M: float-regs move-spec drop float ;
-M: float-regs operand-class* drop float ;
-
 ! Temporary register for stack shuffling
 SINGLETON: temp-reg
 

From 8b79eeeff2485a11658c5de0f644ed7fefbf9fff Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 04:36:32 -0500
Subject: [PATCH 06/11] Add file to work dir to ensure it gets checked in

---
 work/README.txt | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 work/README.txt

diff --git a/work/README.txt b/work/README.txt
new file mode 100644
index 0000000000..fd1af07408
--- /dev/null
+++ b/work/README.txt
@@ -0,0 +1 @@
+The 'work' directory is for your own personal vocabularies.

From 40da49bef5b65286309746d9866e58a0efa4a708 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 05:17:27 -0500
Subject: [PATCH 07/11] Perform loop detection before normalization, clean up
 normalization pass, more aggressive recursive return value propagation. Fixes
 regression on nsieve benchmark

---
 .../tree/cleanup/cleanup-tests.factor         |   3 +-
 .../tree/dead-code/dead-code-tests.factor     |  10 +-
 .../tree/def-use/def-use-tests.factor         |  17 ++-
 .../escape-analysis-tests.factor              |  16 +--
 .../tree/finalization/finalization.factor     |   2 +
 .../introductions/introductions.factor        |  36 +++++++
 .../normalization/normalization-tests.factor  |  20 ++--
 .../tree/normalization/normalization.factor   | 101 +-----------------
 .../normalization/renaming/renaming.factor    |  48 +++++++++
 .../compiler/tree/optimizer/optimizer.factor  |   4 +-
 .../tree/propagation/inlining/inlining.factor |   3 +-
 .../tree/propagation/propagation-tests.factor |   3 +-
 .../propagation/recursive/recursive.factor    |   3 +-
 .../recursive-tests.factor}                   |  36 +++----
 .../recursive.factor}                         |  24 ++++-
 .../tuple-unboxing-tests.factor               |  14 +--
 16 files changed, 186 insertions(+), 154 deletions(-)
 create mode 100644 basis/compiler/tree/normalization/introductions/introductions.factor
 create mode 100644 basis/compiler/tree/normalization/renaming/renaming.factor
 rename basis/compiler/tree/{loop/detection/detection-tests.factor => recursive/recursive-tests.factor} (75%)
 rename basis/compiler/tree/{loop/detection/detection.factor => recursive/recursive.factor} (80%)

diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index 15bc6444ac..2e8eb15959 100644
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -10,12 +10,13 @@ compiler.tree
 compiler.tree.combinators
 compiler.tree.cleanup
 compiler.tree.builder
+compiler.tree.recursive
 compiler.tree.normalization
 compiler.tree.propagation
 compiler.tree.checker ;
 
 : cleaned-up-tree ( quot -- nodes )
-    build-tree normalize propagate cleanup dup check-nodes ;
+    build-tree analyze-recursive normalize propagate cleanup dup check-nodes ;
 
 [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
 
diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor
index e8d2b29027..7b15fdf856 100644
--- a/basis/compiler/tree/dead-code/dead-code-tests.factor
+++ b/basis/compiler/tree/dead-code/dead-code-tests.factor
@@ -3,16 +3,17 @@ compiler.tree.dead-code compiler.tree.def-use compiler.tree
 compiler.tree.combinators compiler.tree.propagation
 compiler.tree.cleanup compiler.tree.escape-analysis
 compiler.tree.tuple-unboxing compiler.tree.debugger
-compiler.tree.normalization compiler.tree.checker tools.test
-kernel math stack-checker.state accessors combinators io
-prettyprint words sequences.deep sequences.private arrays
-classes kernel.private ;
+compiler.tree.recursive compiler.tree.normalization
+compiler.tree.checker tools.test kernel math stack-checker.state
+accessors combinators io prettyprint words sequences.deep
+sequences.private arrays classes kernel.private ;
 IN: compiler.tree.dead-code.tests
 
 \ remove-dead-code must-infer
 
 : count-live-values ( quot -- n )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup
@@ -64,6 +65,7 @@ IN: compiler.tree.dead-code.tests
 
 : optimize-quot ( quot -- quot' )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup
diff --git a/basis/compiler/tree/def-use/def-use-tests.factor b/basis/compiler/tree/def-use/def-use-tests.factor
index 993627eb15..d970e04afd 100755
--- a/basis/compiler/tree/def-use/def-use-tests.factor
+++ b/basis/compiler/tree/def-use/def-use-tests.factor
@@ -1,9 +1,10 @@
 USING: accessors namespaces assocs kernel sequences math
 tools.test words sets combinators.short-circuit
 stack-checker.state compiler.tree compiler.tree.builder
-compiler.tree.normalization compiler.tree.propagation
-compiler.tree.cleanup compiler.tree.def-use arrays kernel.private
-sorting math.order binary-search compiler.tree.checker ;
+compiler.tree.recursive compiler.tree.normalization
+compiler.tree.propagation compiler.tree.cleanup
+compiler.tree.def-use arrays kernel.private sorting math.order
+binary-search compiler.tree.checker ;
 IN: compiler.tree.def-use.tests
 
 \ compute-def-use must-infer
@@ -18,6 +19,7 @@ IN: compiler.tree.def-use.tests
 
 : test-def-use ( quot -- )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup
@@ -27,7 +29,14 @@ IN: compiler.tree.def-use.tests
 : too-deep ( a b -- c )
     dup [ drop ] [ 2dup too-deep too-deep drop ] if ; inline recursive
 
-[ ] [ [ too-deep ] build-tree normalize compute-def-use check-nodes ] unit-test
+[ ] [
+    [ too-deep ]
+    build-tree
+    analyze-recursive
+    normalize
+    compute-def-use
+    check-nodes
+] unit-test
 
 ! compute-def-use checks for SSA violations, so we use that to
 ! ensure we generate some common patterns correctly.
diff --git a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
index f51046c6cb..7ece8a5a80 100644
--- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
+++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
@@ -1,13 +1,14 @@
 IN: compiler.tree.escape-analysis.tests
 USING: compiler.tree.escape-analysis
 compiler.tree.escape-analysis.allocations compiler.tree.builder
-compiler.tree.normalization math.functions
-compiler.tree.propagation compiler.tree.cleanup
-compiler.tree.combinators compiler.tree sequences math math.private
-kernel tools.test accessors slots.private quotations.private
-prettyprint classes.tuple.private classes classes.tuple
-compiler.intrinsics namespaces compiler.tree.propagation.info
-stack-checker.errors kernel.private ;
+compiler.tree.recursive compiler.tree.normalization
+math.functions compiler.tree.propagation compiler.tree.cleanup
+compiler.tree.combinators compiler.tree sequences math
+math.private kernel tools.test accessors slots.private
+quotations.private prettyprint classes.tuple.private classes
+classes.tuple compiler.intrinsics namespaces
+compiler.tree.propagation.info stack-checker.errors
+kernel.private ;
 
 \ escape-analysis must-infer
 
@@ -28,6 +29,7 @@ M: node count-unboxed-allocations* drop ;
 
 : count-unboxed-allocations ( quot -- sizes )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup
diff --git a/basis/compiler/tree/finalization/finalization.factor b/basis/compiler/tree/finalization/finalization.factor
index dafe032ab6..ba7e4ff652 100644
--- a/basis/compiler/tree/finalization/finalization.factor
+++ b/basis/compiler/tree/finalization/finalization.factor
@@ -7,6 +7,7 @@ byte-arrays alien.accessors
 compiler.intrinsics
 compiler.tree
 compiler.tree.builder
+compiler.tree.recursive
 compiler.tree.normalization
 compiler.tree.propagation
 compiler.tree.propagation.info
@@ -39,6 +40,7 @@ M: #shuffle finalize*
 : splice-quot ( quot -- nodes )
     [
         build-tree
+        analyze-recursive 
         normalize
         propagate
         cleanup
diff --git a/basis/compiler/tree/normalization/introductions/introductions.factor b/basis/compiler/tree/normalization/introductions/introductions.factor
new file mode 100644
index 0000000000..9e96dc0472
--- /dev/null
+++ b/basis/compiler/tree/normalization/introductions/introductions.factor
@@ -0,0 +1,36 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces sequences accessors math kernel
+compiler.tree ;
+IN: compiler.tree.normalization.introductions
+
+SYMBOL: introductions
+
+GENERIC: count-introductions* ( node -- )
+
+: count-introductions ( nodes -- n )
+    #! Note: we use each, not each-node, since the #branch
+    #! method recurses into children directly and we don't
+    #! recurse into #recursive at all.
+    [
+        0 introductions set
+        [ count-introductions* ] each
+        introductions get
+    ] with-scope ;
+
+: introductions+ ( n -- ) introductions [ + ] change ;
+
+M: #introduce count-introductions*
+    out-d>> length introductions+ ;
+
+M: #branch count-introductions*
+    children>>
+    [ count-introductions ] map supremum
+    introductions+ ;
+
+M: #recursive count-introductions*
+    [ label>> ] [ child>> count-introductions ] bi
+    >>introductions
+    drop ;
+
+M: node count-introductions* drop ;
diff --git a/basis/compiler/tree/normalization/normalization-tests.factor b/basis/compiler/tree/normalization/normalization-tests.factor
index 1b4f728adc..c4a97fcc92 100644
--- a/basis/compiler/tree/normalization/normalization-tests.factor
+++ b/basis/compiler/tree/normalization/normalization-tests.factor
@@ -1,5 +1,8 @@
 IN: compiler.tree.normalization.tests
-USING: compiler.tree.builder compiler.tree.normalization
+USING: compiler.tree.builder compiler.tree.recursive
+compiler.tree.normalization
+compiler.tree.normalization.introductions
+compiler.tree.normalization.renaming
 compiler.tree compiler.tree.checker
 sequences accessors tools.test kernel math ;
 
@@ -22,27 +25,30 @@ sequences accessors tools.test kernel math ;
 [ 0 2 ] [
     [ foo ] build-tree
     [ recursive-inputs ]
-    [ normalize recursive-inputs ] bi
+    [ analyze-recursive normalize recursive-inputs ] bi
 ] unit-test
 
-[ ] [ [ [ 1 ] [ 2 ] if + * ] build-tree normalize check-nodes ] unit-test
+: test-normalization ( quot -- )
+    build-tree analyze-recursive normalize check-nodes ;
+
+[ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
 
 DEFER: bbb
 : aaa ( x -- ) dup [ dup >r bbb r> aaa ] [ drop ] if ; inline recursive
 : bbb ( x -- ) >r drop 0 r> aaa ; inline recursive
 
-[ ] [ [ bbb ] build-tree normalize check-nodes ] unit-test
+[ ] [ [ bbb ] test-normalization ] unit-test
 
 : ccc ( -- ) ccc drop 1 ; inline recursive
 
-[ ] [ [ ccc ] build-tree normalize check-nodes ] unit-test
+[ ] [ [ ccc ] test-normalization ] unit-test
 
 DEFER: eee
 : ddd ( -- ) eee ; inline recursive
 : eee ( -- ) swap ddd ; inline recursive
 
-[ ] [ [ eee ] build-tree normalize check-nodes ] unit-test
+[ ] [ [ eee ] test-normalization ] unit-test
 
 : call-recursive-5 ( -- ) call-recursive-5 ; inline recursive
 
-[ ] [ [ call-recursive-5 swap ] build-tree normalize check-nodes ] unit-test
+[ ] [ [ call-recursive-5 swap ] test-normalization ] unit-test
diff --git a/basis/compiler/tree/normalization/normalization.factor b/basis/compiler/tree/normalization/normalization.factor
index b826a1590b..bebe2e91b6 100644
--- a/basis/compiler/tree/normalization/normalization.factor
+++ b/basis/compiler/tree/normalization/normalization.factor
@@ -6,7 +6,9 @@ stack-checker.backend
 stack-checker.branches
 stack-checker.inlining
 compiler.tree
-compiler.tree.combinators ;
+compiler.tree.combinators
+compiler.tree.normalization.introductions
+compiler.tree.normalization.renaming ;
 IN: compiler.tree.normalization
 
 ! A transform pass done before optimization can begin to
@@ -16,9 +18,6 @@ IN: compiler.tree.normalization
 ! replaced with a single one, at the beginning of a program.
 ! This simplifies subsequent analysis.
 !
-! - We collect #return-recursive and #call-recursive nodes and
-! store them in the #recursive's label slot.
-!
 ! - We normalize #call-recursive as follows. The stack checker
 ! says that the inputs of a #call-recursive are the entire stack
 ! at the time of the call. This is a conservative estimate; we
@@ -28,93 +27,6 @@ IN: compiler.tree.normalization
 ! #call-recursive into a #copy of the unchanged values and a
 ! #call-recursive with trimmed inputs and outputs.
 
-! Collect introductions
-SYMBOL: introductions
-
-GENERIC: count-introductions* ( node -- )
-
-: count-introductions ( nodes -- n )
-    #! Note: we use each, not each-node, since the #branch
-    #! method recurses into children directly and we don't
-    #! recurse into #recursive at all.
-    [
-        0 introductions set
-        [ count-introductions* ] each
-        introductions get
-    ] with-scope ;
-
-: introductions+ ( n -- ) introductions [ + ] change ;
-
-M: #introduce count-introductions*
-    out-d>> length introductions+ ;
-
-M: #branch count-introductions*
-    children>>
-    [ count-introductions ] map supremum
-    introductions+ ;
-
-M: #recursive count-introductions*
-    [ label>> ] [ child>> count-introductions ] bi
-    >>introductions
-    drop ;
-
-M: node count-introductions* drop ;
-
-! Collect label info
-GENERIC: collect-label-info ( node -- )
-
-M: #return-recursive collect-label-info
-    dup label>> (>>return) ;
-
-M: #call-recursive collect-label-info
-    dup label>> calls>> push ;
-
-M: #recursive collect-label-info
-    label>> V{ } clone >>calls drop ;
-
-M: node collect-label-info drop ;
-
-! Rename
-SYMBOL: rename-map
-
-: rename-value ( value -- value' )
-    [ rename-map get at ] keep or ;
-
-: rename-values ( values -- values' )
-    rename-map get '[ [ _ at ] keep or ] map ;
-
-GENERIC: rename-node-values* ( node -- node )
-
-M: #introduce rename-node-values* ;
-
-M: #shuffle rename-node-values*
-    [ rename-values ] change-in-d
-    [ [ rename-value ] assoc-map ] change-mapping ;
-
-M: #push rename-node-values* ;
-
-M: #r> rename-node-values*
-    [ rename-values ] change-in-r ;
-
-M: #terminate rename-node-values*
-    [ rename-values ] change-in-d
-    [ rename-values ] change-in-r ;
-
-M: #phi rename-node-values*
-    [ [ rename-values ] map ] change-phi-in-d ;
-
-M: #declare rename-node-values*
-    [ [ [ rename-value ] dip ] assoc-map ] change-declaration ;
-
-M: #alien-callback rename-node-values* ;
-
-M: node rename-node-values*
-    [ rename-values ] change-in-d ;
-
-: rename-node-values ( nodes -- nodes' )
-    dup [ rename-node-values* drop ] each-node ;
-
-! Normalize
 GENERIC: normalize* ( node -- node' )
 
 SYMBOL: introduction-stack
@@ -125,10 +37,6 @@ SYMBOL: introduction-stack
 : pop-introductions ( n -- values )
     introduction-stack [ swap cut* swap ] change ;
 
-: add-renamings ( old new -- )
-    [ rename-values ] dip
-    rename-map get '[ _ set-at ] 2each ;
-
 M: #introduce normalize*
     out-d>> [ length pop-introductions ] keep add-renamings f ;
 
@@ -201,9 +109,8 @@ M: #call-recursive normalize*
 M: node normalize* ;
 
 : normalize ( nodes -- nodes' )
-    H{ } clone rename-map set
-    dup [ collect-label-info ] each-node
     dup count-introductions make-values
+    H{ } clone rename-map set
     [ (normalize) ] [ nip ] 2bi
     [ #introduce prefix ] unless-empty
     rename-node-values ;
diff --git a/basis/compiler/tree/normalization/renaming/renaming.factor b/basis/compiler/tree/normalization/renaming/renaming.factor
new file mode 100644
index 0000000000..3050df2611
--- /dev/null
+++ b/basis/compiler/tree/normalization/renaming/renaming.factor
@@ -0,0 +1,48 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces assocs kernel accessors sequences fry
+compiler.tree compiler.tree.combinators ;
+IN: compiler.tree.normalization.renaming
+
+SYMBOL: rename-map
+
+: rename-value ( value -- value' )
+    [ rename-map get at ] keep or ;
+
+: rename-values ( values -- values' )
+    rename-map get '[ [ _ at ] keep or ] map ;
+
+: add-renamings ( old new -- )
+    [ rename-values ] dip
+    rename-map get '[ _ set-at ] 2each ;
+
+GENERIC: rename-node-values* ( node -- node )
+
+M: #introduce rename-node-values* ;
+
+M: #shuffle rename-node-values*
+    [ rename-values ] change-in-d
+    [ [ rename-value ] assoc-map ] change-mapping ;
+
+M: #push rename-node-values* ;
+
+M: #r> rename-node-values*
+    [ rename-values ] change-in-r ;
+
+M: #terminate rename-node-values*
+    [ rename-values ] change-in-d
+    [ rename-values ] change-in-r ;
+
+M: #phi rename-node-values*
+    [ [ rename-values ] map ] change-phi-in-d ;
+
+M: #declare rename-node-values*
+    [ [ [ rename-value ] dip ] assoc-map ] change-declaration ;
+
+M: #alien-callback rename-node-values* ;
+
+M: node rename-node-values*
+    [ rename-values ] change-in-d ;
+
+: rename-node-values ( nodes -- nodes' )
+    dup [ rename-node-values* drop ] each-node ;
diff --git a/basis/compiler/tree/optimizer/optimizer.factor b/basis/compiler/tree/optimizer/optimizer.factor
index aafc7f137b..573ba5d2c9 100644
--- a/basis/compiler/tree/optimizer/optimizer.factor
+++ b/basis/compiler/tree/optimizer/optimizer.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces
+compiler.tree.recursive
 compiler.tree.normalization
 compiler.tree.propagation
 compiler.tree.cleanup
@@ -9,7 +10,6 @@ compiler.tree.tuple-unboxing
 compiler.tree.def-use
 compiler.tree.dead-code
 compiler.tree.strength-reduction
-compiler.tree.loop.detection
 compiler.tree.finalization
 compiler.tree.checker ;
 IN: compiler.tree.optimizer
@@ -17,10 +17,10 @@ IN: compiler.tree.optimizer
 SYMBOL: check-optimizer?
 
 : optimize-tree ( nodes -- nodes' )
+    analyze-recursive
     normalize
     propagate
     cleanup
-    detect-loops
     escape-analysis
     unbox-tuples
     compute-def-use
diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 4f93769b7f..4c0b4107a4 100644
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -6,6 +6,7 @@ classes.algebra classes.union sets quotations assocs combinators
 words namespaces
 compiler.tree
 compiler.tree.builder
+compiler.tree.recursive
 compiler.tree.normalization
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes ;
@@ -18,7 +19,7 @@ M: word splicing-nodes
     [ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
 
 M: quotation splicing-nodes
-    build-sub-tree normalize ;
+    build-sub-tree normalize analyze-recursive ;
 
 : propagate-body ( #call -- )
     body>> (propagate) ;
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index f04460f32a..a115ee53c2 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -1,5 +1,5 @@
 USING: kernel compiler.tree.builder compiler.tree
-compiler.tree.propagation
+compiler.tree.propagation compiler.tree.recursive
 compiler.tree.normalization tools.test math math.order
 accessors sequences arrays kernel.private vectors
 alien.accessors alien.c-types sequences.private
@@ -14,6 +14,7 @@ IN: compiler.tree.propagation.tests
 
 : final-info ( quot -- seq )
     build-tree
+    analyze-recursive
     normalize
     propagate
     compute-def-use
diff --git a/basis/compiler/tree/propagation/recursive/recursive.factor b/basis/compiler/tree/propagation/recursive/recursive.factor
index 649eaa763e..53dce813a3 100644
--- a/basis/compiler/tree/propagation/recursive/recursive.factor
+++ b/basis/compiler/tree/propagation/recursive/recursive.factor
@@ -70,7 +70,8 @@ M: #recursive propagate-around ( #recursive -- )
     [ generalize-return-interval ] map ;
 
 : return-infos ( node -- infos )
-    label>> return>> node-input-infos generalize-return ;
+    label>> [ return>> node-input-infos ] [ loop?>> ] bi
+    [ generalize-return ] unless ;
 
 M: #call-recursive propagate-before ( #call-recursive -- )
     [ ] [ return-infos ] [ node-output-infos ] tri
diff --git a/basis/compiler/tree/loop/detection/detection-tests.factor b/basis/compiler/tree/recursive/recursive-tests.factor
similarity index 75%
rename from basis/compiler/tree/loop/detection/detection-tests.factor
rename to basis/compiler/tree/recursive/recursive-tests.factor
index 5864dc368f..c66c182869 100644
--- a/basis/compiler/tree/loop/detection/detection-tests.factor
+++ b/basis/compiler/tree/recursive/recursive-tests.factor
@@ -1,5 +1,5 @@
-IN: compiler.tree.loop.detection.tests
-USING: compiler.tree.loop.detection tools.test
+IN: compiler.tree.recursive.tests
+USING: compiler.tree.recursive tools.test
 kernel combinators.short-circuit math sequences accessors
 compiler.tree
 compiler.tree.builder
@@ -10,7 +10,7 @@ compiler.tree.combinators ;
 [ { f t t t } ] [ t { f f t t } (tail-calls) ] unit-test
 [ { f f f t } ] [ t { f f t f } (tail-calls) ] unit-test
 
-\ detect-loops must-infer
+\ analyze-recursive must-infer
 
 : label-is-loop? ( nodes word -- ? )
     [
@@ -38,22 +38,22 @@ compiler.tree.combinators ;
     dup [ 1+ loop-test-1 ] [ drop ] if ; inline recursive
                           
 [ t ] [
-    [ loop-test-1 ] build-tree detect-loops
+    [ loop-test-1 ] build-tree analyze-recursive
     \ loop-test-1 label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ loop-test-1 1 2 3 ] build-tree detect-loops
+    [ loop-test-1 1 2 3 ] build-tree analyze-recursive
     \ loop-test-1 label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ [ loop-test-1 ] each ] build-tree detect-loops
+    [ [ loop-test-1 ] each ] build-tree analyze-recursive
     \ loop-test-1 label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ [ loop-test-1 ] each ] build-tree detect-loops
+    [ [ loop-test-1 ] each ] build-tree analyze-recursive
     \ (each-integer) label-is-loop?
 ] unit-test
 
@@ -61,7 +61,7 @@ compiler.tree.combinators ;
     dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive
 
 [ t ] [
-    [ loop-test-2 ] build-tree detect-loops
+    [ loop-test-2 ] build-tree analyze-recursive
     \ loop-test-2 label-is-not-loop?
 ] unit-test
 
@@ -69,7 +69,7 @@ compiler.tree.combinators ;
     dup [ [ loop-test-3 ] each ] [ drop ] if ; inline recursive
 
 [ t ] [
-    [ loop-test-3 ] build-tree detect-loops
+    [ loop-test-3 ] build-tree analyze-recursive
     \ loop-test-3 label-is-not-loop?
 ] unit-test
 
@@ -81,7 +81,7 @@ compiler.tree.combinators ;
     ] if ; inline recursive
 
 [ f ] [
-    [ [ [ ] map ] map ] build-tree detect-loops
+    [ [ [ ] map ] map ] build-tree analyze-recursive
     [
         dup #recursive? [ label>> loop?>> not ] [ drop f ] if
     ] contains-node?
@@ -98,22 +98,22 @@ DEFER: a
     blah [ b ] [ a ] if ; inline recursive
 
 [ t ] [
-    [ a ] build-tree detect-loops
+    [ a ] build-tree analyze-recursive
     \ a label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ a ] build-tree detect-loops
+    [ a ] build-tree analyze-recursive
     \ b label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ b ] build-tree detect-loops
+    [ b ] build-tree analyze-recursive
     \ a label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ a ] build-tree detect-loops
+    [ a ] build-tree analyze-recursive
     \ b label-is-loop?
 ] unit-test
 
@@ -126,12 +126,12 @@ DEFER: a'
     blah [ b' ] [ a' ] if ; inline recursive
 
 [ f ] [
-    [ a' ] build-tree detect-loops
+    [ a' ] build-tree analyze-recursive
     \ a' label-is-loop?
 ] unit-test
 
 [ f ] [
-    [ b' ] build-tree detect-loops
+    [ b' ] build-tree analyze-recursive
     \ b' label-is-loop?
 ] unit-test
 
@@ -140,11 +140,11 @@ DEFER: a'
 ! sound.
 
 [ t ] [
-    [ b' ] build-tree detect-loops
+    [ b' ] build-tree analyze-recursive
     \ a' label-is-loop?
 ] unit-test
 
 [ f ] [
-    [ a' ] build-tree detect-loops
+    [ a' ] build-tree analyze-recursive
     \ b' label-is-loop?
 ] unit-test
diff --git a/basis/compiler/tree/loop/detection/detection.factor b/basis/compiler/tree/recursive/recursive.factor
similarity index 80%
rename from basis/compiler/tree/loop/detection/detection.factor
rename to basis/compiler/tree/recursive/recursive.factor
index 1f9e42530a..d1e4c7c70e 100644
--- a/basis/compiler/tree/loop/detection/detection.factor
+++ b/basis/compiler/tree/recursive/recursive.factor
@@ -1,14 +1,27 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences namespaces assocs accessors fry
-compiler.tree deques search-deques ;
-IN: compiler.tree.loop.detection
+USING: kernel assocs namespaces accessors sequences deques
+search-deques compiler.tree compiler.tree.combinators ;
+IN: compiler.tree.recursive
+
+! Collect label info
+GENERIC: collect-label-info ( node -- )
+
+M: #return-recursive collect-label-info
+    dup label>> (>>return) ;
+
+M: #call-recursive collect-label-info
+    dup label>> calls>> push ;
+
+M: #recursive collect-label-info
+    label>> V{ } clone >>calls drop ;
+
+M: node collect-label-info drop ;
 
 ! A loop is a #recursive which only tail calls itself, and those
 ! calls are nested inside other loops only. We optimistically
 ! assume all #recursive nodes are loops, disqualifying them as
 ! we see evidence to the contrary.
-
 : (tail-calls) ( tail? seq -- seq' )
     reverse [ swap [ and ] keep ] map nip reverse ;
 
@@ -84,5 +97,6 @@ M: node collect-loop-info* 2drop ;
         ] [ drop ] if
     ] slurp-deque ;
 
-: detect-loops ( nodes -- nodes )
+: analyze-recursive ( nodes -- nodes )
+    dup [ collect-label-info ] each-node
     dup collect-loop-info disqualify-loops ;
diff --git a/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor b/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
index 858e40347f..81ba01f1e2 100644
--- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
+++ b/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
@@ -1,16 +1,18 @@
 IN: compiler.tree.tuple-unboxing.tests
 USING: tools.test compiler.tree.tuple-unboxing compiler.tree
-compiler.tree.builder compiler.tree.normalization
-compiler.tree.propagation compiler.tree.cleanup
-compiler.tree.escape-analysis compiler.tree.tuple-unboxing
-compiler.tree.checker compiler.tree.def-use kernel accessors
-sequences math math.private sorting math.order binary-search
-sequences.private slots.private ;
+compiler.tree.builder compiler.tree.recursive
+compiler.tree.normalization compiler.tree.propagation
+compiler.tree.cleanup compiler.tree.escape-analysis
+compiler.tree.tuple-unboxing compiler.tree.checker
+compiler.tree.def-use kernel accessors sequences math
+math.private sorting math.order binary-search sequences.private
+slots.private ;
 
 \ unbox-tuples must-infer
 
 : test-unboxing ( quot -- )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup

From 2bf532263d9519bc466c6f0af34c6c4ef7792bf8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 05:36:06 -0500
Subject: [PATCH 08/11] Oops

---
 basis/compiler/tree/propagation/inlining/inlining.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 4c0b4107a4..a161b8f356 100644
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -19,7 +19,7 @@ M: word splicing-nodes
     [ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
 
 M: quotation splicing-nodes
-    build-sub-tree normalize analyze-recursive ;
+    build-sub-tree analyze-recursive normalize ;
 
 : propagate-body ( #call -- )
     body>> (propagate) ;

From 54232f80ca0f12de85cd55dcdfd378146a5317ea Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 08:18:44 -0500
Subject: [PATCH 09/11] Adding identity optimization pass, tweak inlining
 heuristic

---
 .../tree/identities/identities.factor         | 98 +++++++++++++++++++
 .../compiler/tree/optimizer/optimizer.factor  |  2 +
 .../tree/propagation/inlining/inlining.factor | 11 ++-
 .../tree/propagation/propagation.factor       |  2 +
 basis/hints/hints.factor                      |  4 +-
 .../partial-dispatch/partial-dispatch.factor  | 22 +++--
 6 files changed, 130 insertions(+), 9 deletions(-)
 create mode 100644 basis/compiler/tree/identities/identities.factor

diff --git a/basis/compiler/tree/identities/identities.factor b/basis/compiler/tree/identities/identities.factor
new file mode 100644
index 0000000000..d6ed59cbaa
--- /dev/null
+++ b/basis/compiler/tree/identities/identities.factor
@@ -0,0 +1,98 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel sequences fry words math
+math.partial-dispatch combinators arrays hashtables
+compiler.tree
+compiler.tree.combinators
+compiler.tree.propagation.info ;
+IN: compiler.tree.identities
+
+: define-identities ( word identities -- )
+    [ integer-derived-ops ] dip
+    '[ _ "identities" set-word-prop ] each ;
+
+SYMBOL: X
+
+\ + {
+    { { X 0 } drop }
+    { { 0 X } nip }
+} define-identities
+
+\ - {
+    { { X 0 } drop }
+} define-identities
+
+\ * {
+    { { X 1 } drop }
+    { { 1 X } nip }
+    { { X 0 } nip }
+    { { 0 X } drop }
+} define-identities
+
+\ / {
+    { { X 1 } drop }
+} define-identities
+
+\ mod {
+    { { X 1 } 0 }
+} define-identities
+
+\ rem {
+    { { X 1 } 0 }
+} define-identities
+
+\ bitand {
+    { { X -1 } drop }
+    { { -1 X } nip }
+    { { X 0 } nip }
+    { { 0 X } drop }
+} define-identities
+
+\ bitor {
+    { { X 0 } drop }
+    { { 0 X } nip }
+    { { X -1 } nip }
+    { { -1 X } drop }
+} define-identities
+
+\ bitxor {
+    { { X 0 } drop }
+    { { 0 X } nip }
+} define-identities
+
+\ shift {
+    { { 0 X } drop }
+    { { X 0 } drop }
+} define-identities
+
+: matches? ( pattern infos -- ? )
+    [ over X eq? [ 2drop t ] [ literal>> = ] if ] 2all? ;
+
+: find-identity ( patterns infos -- result )
+    '[ first _ matches? ] find swap [ second ] when ;
+
+GENERIC: apply-identities* ( node -- node )
+
+: simplify-to-constant ( #call constant -- nodes )
+    [ [ in-d>> #drop ] [ out-d>> first ] bi ] dip swap #push
+    2array ;
+
+: select-input ( node n -- #shuffle )
+    [ [ in-d>> ] [ out-d>> ] bi ] dip
+    pick nth over first associate #shuffle ;
+
+M: #call apply-identities*
+    dup word>> "identities" word-prop [
+        over node-input-infos find-identity [
+            {
+                { \ drop [ 0 select-input ] }
+                { \ nip [ 1 select-input ] }
+                [ simplify-to-constant ]
+            } case
+        ] when*
+    ] when* ;
+
+M: node apply-identities* ;
+
+: apply-identities ( nodes -- nodes' )
+    [ apply-identities* ] map-nodes ;
diff --git a/basis/compiler/tree/optimizer/optimizer.factor b/basis/compiler/tree/optimizer/optimizer.factor
index 573ba5d2c9..3196253d45 100644
--- a/basis/compiler/tree/optimizer/optimizer.factor
+++ b/basis/compiler/tree/optimizer/optimizer.factor
@@ -7,6 +7,7 @@ compiler.tree.propagation
 compiler.tree.cleanup
 compiler.tree.escape-analysis
 compiler.tree.tuple-unboxing
+compiler.tree.identities
 compiler.tree.def-use
 compiler.tree.dead-code
 compiler.tree.strength-reduction
@@ -23,6 +24,7 @@ SYMBOL: check-optimizer?
     cleanup
     escape-analysis
     unbox-tuples
+    apply-identities
     compute-def-use
     remove-dead-code
     ! strength-reduce
diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index a161b8f356..48864d8782 100644
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -7,11 +7,19 @@ words namespaces
 compiler.tree
 compiler.tree.builder
 compiler.tree.recursive
+compiler.tree.combinators
 compiler.tree.normalization
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes ;
 IN: compiler.tree.propagation.inlining
 
+! We count nodes up-front; if there are relatively few nodes,
+! we are more eager to inline
+SYMBOL: node-count
+
+: count-nodes ( nodes -- )
+    0 swap [ drop 1+ ] each-node node-count set ;
+
 ! Splicing nodes
 GENERIC: splicing-nodes ( #call word/quot/f -- nodes )
 
@@ -114,12 +122,13 @@ DEFER: (flat-length)
     [ classes-known? 2 0 ? ]
     [
         {
+            [ drop node-count get 45 swap [-] 8 /i ]
             [ flat-length 24 swap [-] 4 /i ]
             [ "default" word-prop -4 0 ? ]
             [ "specializer" word-prop 1 0 ? ]
             [ method-body? 1 0 ? ]
         } cleave
-    ] bi* + + + + ;
+    ] bi* + + + + + ;
 
 : should-inline? ( #call word -- ? )
     inlining-rank 5 >= ;
diff --git a/basis/compiler/tree/propagation/propagation.factor b/basis/compiler/tree/propagation/propagation.factor
index f184418d43..d82ebed433 100755
--- a/basis/compiler/tree/propagation/propagation.factor
+++ b/basis/compiler/tree/propagation/propagation.factor
@@ -6,6 +6,7 @@ compiler.tree.propagation.copy
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes
 compiler.tree.propagation.simple
+compiler.tree.propagation.inlining
 compiler.tree.propagation.branches
 compiler.tree.propagation.recursive
 compiler.tree.propagation.constraints
@@ -18,4 +19,5 @@ IN: compiler.tree.propagation
     H{ } clone copies set
     H{ } clone constraints set
     H{ } clone value-infos set
+    dup count-nodes
     dup (propagate) ;
diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor
index 499267de7c..1138ad872a 100644
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@@ -91,7 +91,7 @@ IN: hints
 
 \ >string { sbuf } "specializer" set-word-prop
 
-\ >array { { string } { vector } } "specializer" set-word-prop
+\ >array { { vector } } "specializer" set-word-prop
 
 \ >vector { { array } { vector } } "specializer" set-word-prop
 
@@ -101,7 +101,7 @@ IN: hints
 
 \ memq? { array } "specializer" set-word-prop
 
-\ member? { fixnum string } "specializer" set-word-prop
+\ member? { array } "specializer" set-word-prop
 
 \ assoc-stack { vector } "specializer" set-word-prop
 
diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor
index 6def4966a2..b162406e5a 100644
--- a/basis/math/partial-dispatch/partial-dispatch.factor
+++ b/basis/math/partial-dispatch/partial-dispatch.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel kernel.private math math.private words
 sequences parser namespaces make assocs quotations arrays locals
-generic generic.math hashtables effects compiler.units ;
+generic generic.math hashtables effects compiler.units
+classes.algebra ;
 IN: math.partial-dispatch
 
 ! Partial dispatch.
@@ -96,19 +97,28 @@ SYMBOL: fast-math-ops
     [ drop math-class-max swap specific-method >boolean ] if ;
 
 : (derived-ops) ( word assoc -- words )
-    swap [ rot first eq? nip ] curry assoc-filter values ;
+    swap [ rot first eq? nip ] curry assoc-filter ;
 
 : derived-ops ( word -- words )
-    [ 1array ]
-    [ math-ops get (derived-ops) ]
-    bi append ;
+    [ 1array ] [ math-ops get (derived-ops) values ] bi append ;
 
 : fast-derived-ops ( word -- words )
-    fast-math-ops get (derived-ops) ;
+    fast-math-ops get (derived-ops) values ;
 
 : all-derived-ops ( word -- words )
     [ derived-ops ] [ fast-derived-ops ] bi append ;
 
+: integer-derived-ops ( word -- words )
+    [ math-ops get (derived-ops) ] [ fast-math-ops get (derived-ops) ] bi
+    [
+            [
+            drop
+            [ second integer class<= ]
+            [ third integer class<= ]
+            bi and
+        ] assoc-filter values
+    ] bi@ append ;
+
 : each-derived-op ( word quot -- )
     >r derived-ops r> each ; inline
 

From 91faff92de16f53bece8d78233c5e397265b2f18 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 08:18:57 -0500
Subject: [PATCH 10/11] Minor change to copy and subseq to improve type
 inference

---
 core/sequences/sequences.factor | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index dbb24c3168..6f755e5cb5 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -236,6 +236,10 @@ INSTANCE: repetition immutable-sequence
 
 <PRIVATE
 
+: check-length ( n -- n )
+    #! Ricing.
+    dup integer? [ "length not an integer" throw ] unless ; inline
+
 : ((copy)) ( dst i src j n -- dst i src j n )
     dup -roll [
         + swap nth-unsafe -roll [
@@ -248,8 +252,9 @@ INSTANCE: repetition immutable-sequence
     inline recursive
 
 : prepare-subseq ( from to seq -- dst i src j n )
+    #! The check-length call forces partial dispatch
     [ >r swap - r> new-sequence dup 0 ] 3keep
-    -rot drop roll length ; inline
+    -rot drop roll length check-length ; inline
 
 : check-copy ( src n dst -- )
     over 0 < [ bounds-error ] when
@@ -273,7 +278,8 @@ PRIVATE>
 : but-last ( seq -- headseq ) 1 head* ;
 
 : copy ( src i dst -- )
-    pick length >r 3dup check-copy spin 0 r>
+    #! The check-length call forces partial dispatch
+    pick length check-length >r 3dup check-copy spin 0 r>
     (copy) drop ; inline
 
 M: sequence clone-like

From 45425fccd73acb4a34191fe86200c71076029052 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 08:29:32 -0500
Subject: [PATCH 11/11] New benchmark: like nsieve but using a byte array

---
 .../nsieve-bytes/nsieve-bytes.factor          | 35 +++++++++++++++++++
 1 file changed, 35 insertions(+)
 create mode 100644 extra/benchmark/nsieve-bytes/nsieve-bytes.factor

diff --git a/extra/benchmark/nsieve-bytes/nsieve-bytes.factor b/extra/benchmark/nsieve-bytes/nsieve-bytes.factor
new file mode 100644
index 0000000000..11745e4463
--- /dev/null
+++ b/extra/benchmark/nsieve-bytes/nsieve-bytes.factor
@@ -0,0 +1,35 @@
+IN: benchmark.nsieve-bytes
+USING: math math.parser sequences sequences.private kernel
+byte-arrays make io ;
+
+: clear-flags ( step i seq -- )
+    2dup length >= [
+        3drop
+    ] [
+        0 2over set-nth-unsafe >r over + r> clear-flags
+    ] if ; inline recursive
+
+: (nsieve) ( count i seq -- count )
+    2dup length < [
+        2dup nth-unsafe 0 > [
+            over dup 2 * pick clear-flags
+            rot 1+ -rot ! increment count
+        ] when >r 1+ r> (nsieve)
+    ] [
+        2drop
+    ] if ; inline recursive
+
+: nsieve ( m -- count )
+    0 2 rot 1+ <byte-array> dup [ drop 1 ] change-each (nsieve) ;
+
+: nsieve. ( m -- )
+    [ "Primes up to " % dup # " " % nsieve # ] "" make print ;
+
+: nsieve-main ( n -- )
+    dup 2^ 10000 * nsieve.
+    dup 1 - 2^ 10000 * nsieve.
+    2 - 2^ 10000 * nsieve. ;
+
+: nsieve-main* ( -- ) 9 nsieve-main ;
+
+MAIN: nsieve-main*