hints: fix regression with declarations

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index db0dd65a8372d039a0c427e6a628db52ff06cfff..9a77ee4017f7fb44e2fd9e9ecac56458b8835ff4 100644 (file)
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -4,6 +4,7 @@ compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger
 compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker
 compiler.cfg arrays locals byte-arrays kernel.private math
 slots.private vectors sbufs strings math.partial-dispatch
+hashtables assocs combinators.short-circuit
 strings.private accessors compiler.cfg.instructions ;
 IN: compiler.cfg.builder.tests
 
@@ -204,4 +205,7 @@ IN: compiler.cfg.builder.tests
         [ [ ##box-alien? ] contains-insn? ]
         [ [ ##box-float? ] contains-insn? ] bi
     ] unit-test
-] when
\ No newline at end of file
+] when
+
+! Regression. Make sure everything is inlined correctly
+[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test
\ No newline at end of file

diff --git a/basis/hints/hints-tests.factor b/basis/hints/hints-tests.factor
new file mode 100644 (file)
index 0000000..894e1db
--- /dev/null
+++ b/basis/hints/hints-tests.factor
@@ -0,0 +1,12 @@
+USING: math hashtables accessors kernel words hints
+compiler.tree.debugger tools.test ;
+IN: hints.tests
+
+! Regression
+GENERIC: blahblah ( a b c -- )
+
+M: hashtable blahblah 2nip [ 1 + ] change-count drop ;
+
+HINTS: M\ hashtable blahblah { object fixnum object } { object word object } ;
+
+[ t ] [ M\ hashtable blahblah { count>> (>>count) } inlined? ] unit-test

diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor
index 73142cf7473d5deac09049b5f650278e87527846..f49d2e4229c88a84dcfa89946f61b04e180c738e 100644 (file)
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@@ -37,8 +37,8 @@ M: object specializer-declaration class ;
         [ [ specializer-declaration ] map swap '[ _ declare @ ] ] 2bi
     ] with { } map>assoc ;
 
-: specialize-quot ( quot word specializer -- quot' )
-    [ drop nip def>> ] [ nip specializer-cases ] 3bi alist>quot ;
+: specialize-quot ( quot specializer -- quot' )
+    [ drop ] [ specializer-cases ] 2bi alist>quot ;
 
 ! compiler.tree.propagation.inlining sets this to f
 SYMBOL: specialize-method?
@@ -52,8 +52,8 @@ t specialize-method? set-global
 
 : specialize-method ( quot method -- quot' )
     [ specialize-method? get [ method-declaration prepend ] [ drop ] if ]
-    [ dup "method-generic" word-prop specializer ] bi
-    [ specialize-quot ] [ drop ] if* ;
+    [ "method-generic" word-prop ] bi
+    specializer [ specialize-quot ] when* ;
 
 : standard-method? ( method -- ? )
     dup method-body? [
@@ -64,7 +64,7 @@ t specialize-method? set-global
     [ def>> ] keep
     dup generic? [ drop ] [
         [ dup standard-method? [ specialize-method ] [ drop ] if ]
-        [ dup specializer [ specialize-quot ] [ drop ] if* ]
+        [ specializer [ specialize-quot ] when* ]
         bi
     ] if ;