! Copyright (C) 2010 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs classes compiler.units generalizations
kernel locals parser sequences words fry ;
IN: type-feedback

! This is a proof-of-concept implementation of type feedback in Factor
! I expect it to be really slow usually but provide a huge speedup
! on contrieved benchmarks.
! It works basically by generating hints

! When recompilation happens, the newly compiled word
! won't actually be called until the next time around
! until Factor supports on-stack replacement

: make-subword ( word quot effect -- word' )
    [ name>> "%" dup surround <uninterned-word> dup ] 2dip
    define-declared ;

CONSTANT: threshold 100

: add-hint? ( types table -- ? )
    [ inc-at ] [ at threshold = ] 2bi ;

: change-word-prop ( word prop quot -- )
    [ swap props>> ] dip change-at ; inline

: add-hint ( types impl -- )
    [ "specializer" [ swap suffix ] change-word-prop ]
    [ [ changed-effect ] with-compilation-unit ] bi ;

:: maybe-recompile ( n table impl -- )
    n ndup [ class ] n napply n narray :> types
    types table add-hint?
    [ types impl add-hint ] when ; inline

:: define-type-feedback ( word quot effect n -- )
    H{ } clone :> table
    word quot effect make-subword :> impl
    word table "type-feedback" set-word-prop
    word impl "implementation" set-word-prop
    word n "feedback-depth" set-word-prop
    word
    n table impl dup '[ _ _ _ maybe-recompile _ execute ]
    effect define-declared ;

SYNTAX: TYPE-FEEDBACK:
    (:) dup in>> length define-type-feedback ;


! A benchmark:
! TYPE-FEEDBACK: double-vector ( v -- v' ) dup v+ ;
! This version runs more than twice as fast, if run from the uninitialized
! state for 10000 executions on 5000 iota, compared to the normal version