<commit_before>USING: kernel sequences namespaces make math assocs words arrays
tools.annotations vocabs sorting prettyprint io micros
math.statistics accessors ;
IN: wordtimer

SYMBOL: *wordtimes*
SYMBOL: *calling*

: reset-word-timer ( -- ) 
  H{ } clone *wordtimes* set-global
  H{ } clone *calling* set-global ;
    
: lookup-word-time ( wordname -- utime n )
  *wordtimes* get-global [ drop { 0 0 } ] cache first2 ;

: update-times ( utime current-utime current-numinvokes -- utime' invokes' )
  rot [ + ] curry [ 1+ ] bi* ;

: register-time ( utime word -- )
  name>>
  [ lookup-word-time update-times 2array ] keep *wordtimes* get-global set-at ;

: calling ( word -- )
  dup *calling* get-global set-at ; inline

: finished ( word -- )
  *calling* get-global delete-at ; inline

: called-recursively? ( word -- t/f )
  *calling* get-global at ; inline
    
: timed-call ( quot word -- )
  [ calling ] [ >r micro-time r> register-time ] [ finished ] tri ; inline

: time-unless-recursing ( quot word -- )
  dup called-recursively? not
  [ timed-call ] [ drop call ] if ; inline
    
: (add-timer) ( word quot -- quot' )
  [ swap time-unless-recursing ] 2curry ; 

: add-timer ( word -- )
  dup [ (add-timer) ] annotate ;

: add-timers ( vocab -- )
  words [ add-timer ] each ;

: reset-vocab ( vocab -- )
  words [ reset ] each ;

: dummy-word ( -- ) ;

: time-dummy-word ( -- n )
  [ 100000 [ [ dummy-word ] micro-time , ] times ] { } make median ;

: subtract-overhead ( {oldtime,n} overhead -- {newtime,n} )
  [ first2 ] dip
  swap [ * - ] keep 2array ;
  
: change-global ( variable quot -- )
  global swap change-at ;

: (correct-for-timing-overhead) ( timingshash -- timingshash )
  time-dummy-word [ subtract-overhead ] curry assoc-map ;  

: correct-for-timing-overhead ( -- )
  *wordtimes* [ (correct-for-timing-overhead) ] change-global ;
    
: print-word-timings ( -- )
  *wordtimes* get-global [ swap suffix ] { } assoc>map natural-sort reverse pprint ;

: wordtimer-call ( quot -- )
  reset-word-timer 
  [ call ] micro-time >r
  correct-for-timing-overhead
  "total time:" write r> pprint nl
  print-word-timings nl ;

: profile-vocab ( vocab quot -- )
  "annotating vocab..." print flush
  over [ reset-vocab ] [ add-timers ] bi
  reset-word-timer
  "executing quotation..." print flush
  [ call ] micro-time >r
  "resetting annotations..." print flush
  reset-vocab
  correct-for-timing-overhead<commit_msg>Update wordtimer for micros removal<commit_after>USING: kernel sequences namespaces make math assocs words arrays
tools.annotations vocabs sorting prettyprint io system
math.statistics accessors ;
IN: wordtimer

SYMBOL: *wordtimes*
SYMBOL: *calling*

: reset-word-timer ( -- ) 
  H{ } clone *wordtimes* set-global
  H{ } clone *calling* set-global ;
    
: lookup-word-time ( wordname -- utime n )
  *wordtimes* get-global [ drop { 0 0 } ] cache first2 ;

: update-times ( utime current-utime current-numinvokes -- utime' invokes' )
  rot [ + ] curry [ 1+ ] bi* ;

: register-time ( utime word -- )
  name>>
  [ lookup-word-time update-times 2array ] keep *wordtimes* get-global set-at ;

: calling ( word -- )
  dup *calling* get-global set-at ; inline

: finished ( word -- )
  *calling* get-global delete-at ; inline

: called-recursively? ( word -- t/f )
  *calling* get-global at ; inline
    
: timed-call ( quot word -- )
  [ calling ] [ >r benchmark r> register-time ] [ finished ] tri ; inline

: time-unless-recursing ( quot word -- )
  dup called-recursively? not
  [ timed-call ] [ drop call ] if ; inline
    
: (add-timer) ( word quot -- quot' )
  [ swap time-unless-recursing ] 2curry ; 

: add-timer ( word -- )
  dup [ (add-timer) ] annotate ;

: add-timers ( vocab -- )
  words [ add-timer ] each ;

: reset-vocab ( vocab -- )
  words [ reset ] each ;

: dummy-word ( -- ) ;

: time-dummy-word ( -- n )
  [ 100000 [ [ dummy-word ] benchmark , ] times ] { } make median ;

: subtract-overhead ( {oldtime,n} overhead -- {newtime,n} )
  [ first2 ] dip
  swap [ * - ] keep 2array ;
  
: change-global ( variable quot -- )
  global swap change-at ;

: (correct-for-timing-overhead) ( timingshash -- timingshash )
  time-dummy-word [ subtract-overhead ] curry assoc-map ;  

: correct-for-timing-overhead ( -- )
  *wordtimes* [ (correct-for-timing-overhead) ] change-global ;
    
: print-word-timings ( -- )
  *wordtimes* get-global [ swap suffix ] { } assoc>map natural-sort reverse pprint ;

: wordtimer-call ( quot -- )
  reset-word-timer 
  benchmark >r
  correct-for-timing-overhead
  "total time:" write r> pprint nl
  print-word-timings nl ;

: profile-vocab ( vocab quot -- )
  "annotating vocab..." print flush
  over [ reset-vocab ] [ add-timers ] bi
  reset-word-timer
  "executing quotation..." print flush
  benchmark >r
  "resetting annotations..." print flush
  reset-vocab
  correct-for-timing-overhead
{'fraction_non_alphanumeric': 0.14520773344302756, 'fraction_numerical': 0.005758946935417524, 'mean_word_length': 2.8141176470588234, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4647020', 'n_tokens_mistral': 1738, 'n_tokens_neox': 1681, 'n_words': 425}