diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index db0dd65a83..9a77ee4017 100644 --- 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 index 0000000000..894e1dbdc8 --- /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 73142cf747..f49d2e4229 100644 --- 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 ;