core/optimizer/known-words/known-words.factor

   1 ! Copyright (C) 2005, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: optimizer.known-words
   4 USING: alien arrays generic hashtables inference.dataflow
   5 inference.class kernel assocs math math.private kernel.private
   6 sequences words parser vectors strings sbufs io namespaces
   7 assocs quotations sequences.private io.binary io.crc32
   8 io.buffers io.streams.string layouts splitting math.intervals
   9 math.floats.private math.vectors tuples tuples.private classes
  10 optimizer.def-use optimizer.backend optimizer.pattern-match
  11 float-arrays combinators.private ;
  12
  13 ! the output of <tuple> and <tuple-boa> has the class which is
  14 ! its second-to-last input
  15 { <tuple> <tuple-boa> } [
  16     [
  17         node-in-d dup length 2 - swap nth dup value?
  18         [ value-literal ] [ drop tuple ] if 1array f
  19     ] "output-classes" set-word-prop
  20 ] each
  21
  22 ! the output of clone has the same type as the input
  23 { clone (clone) } [
  24     [
  25         node-in-d [ value-class* ] map f
  26     ] "output-classes" set-word-prop
  27 ] each
  28
  29 ! not [ A ] [ B ] if ==> [ B ] [ A ] if
  30 : flip-branches? ( #call -- ? ) sole-consumer #if? ;
  31
  32 : (flip-branches) ( #if -- )
  33     dup node-children reverse swap set-node-children ;
  34
  35 : flip-branches ( #call -- #if )
  36     #! If a not is followed by an #if, flip branches and
  37     #! remove the not.
  38     dup sole-consumer (flip-branches) [ ] splice-quot ;
  39
  40 \ not {
  41     { [ dup flip-branches? ] [ flip-branches ] }
  42 } define-optimizers
  43
  44 ! eq? on objects of disjoint types is always f
  45 : disjoint-eq? ( node -- ? )
  46     node-input-classes first2 2dup and
  47     [ classes-intersect? not ] [ 2drop f ] if ;
  48
  49 \ eq? {
  50     { [ dup disjoint-eq? ] [ [ f ] inline-literals ] }
  51 } define-optimizers
  52
  53 ! if the result of eq? is t and the second input is a literal,
  54 ! the first input is equal to the second
  55 \ eq? [
  56     dup node-in-d second dup value? [
  57         swap [
  58             value-literal 0 `input literal,
  59             general-t 0 `output class,
  60         ] set-constraints
  61     ] [
  62         2drop
  63     ] if
  64 ] "constraints" set-word-prop
  65
  66 ! eq? on the same object is always t
  67 { eq? bignum= float= number= = } {
  68     { { @ @ } [ 2drop t ] }
  69 } define-identities
  70
  71 ! type applied to an object of a known type can be folded
  72 : known-type? ( node -- ? )
  73     node-class-first types length 1 number= ;
  74
  75 : fold-known-type ( node -- node )
  76     dup node-class-first types inline-literals ;
  77
  78 \ type [
  79     { [ dup known-type? ] [ fold-known-type ] }
  80 ] define-optimizers
  81
  82 ! if the result of type is n, then the object has type n
  83 { tag type } [
  84     [
  85         num-types get swap [
  86             [
  87                 [ type>class 0 `input class, ] keep
  88                 0 `output literal,
  89             ] set-constraints
  90         ] curry each
  91     ] "constraints" set-word-prop
  92 ] each
  93
  94 ! Specializers
  95 { 1+ 1- sq neg recip sgn truncate } [
  96     { number } "specializer" set-word-prop
  97 ] each
  98
  99 \ 2/ { fixnum } "specializer" set-word-prop
 100
 101 { min max } [
 102     { number number } "specializer" set-word-prop
 103 ] each
 104
 105 { vneg norm-sq norm normalize } [
 106     { { float-array array } } "specializer" set-word-prop
 107 ] each
 108
 109 \ n*v { * { float-array array } } "specializer" set-word-prop
 110 \ v*n { { float-array array } * } "specializer" set-word-prop
 111 \ n/v { * { float-array array } } "specializer" set-word-prop
 112 \ v/n { { float-array array } * } "specializer" set-word-prop
 113
 114 { v+ v- v* v/ vmax vmin v. } [
 115     { { float-array array } { float-array array } }
 116     "specializer" set-word-prop
 117 ] each
 118
 119 { first first2 first3 first4 }
 120 [ { array } "specializer" set-word-prop ] each
 121
 122 { peek pop* pop push } [
 123     { vector } "specializer" set-word-prop
 124 ] each
 125
 126 \ push-all
 127 { { string array } { sbuf vector } }
 128 "specializer" set-word-prop
 129
 130 \ append
 131 { { string array } { string array } }
 132 "specializer" set-word-prop
 133
 134 \ subseq
 135 { fixnum fixnum { string array } }
 136 "specializer" set-word-prop
 137
 138 \ reverse-here
 139 { { string array } }
 140 "specializer" set-word-prop
 141
 142 \ mismatch
 143 { string string }
 144 "specializer" set-word-prop
 145
 146 \ find-last-sep { string sbuf } "specializer" set-word-prop
 147
 148 \ >string { sbuf } "specializer" set-word-prop
 149
 150 \ >array { { string vector } } "specializer" set-word-prop
 151
 152 \ crc32 { string } "specializer" set-word-prop
 153
 154 \ split, { string string } "specializer" set-word-prop
 155
 156 \ memq? { array } "specializer" set-word-prop
 157
 158 \ member? { fixnum string } "specializer" set-word-prop
 159
 160 \ assoc-stack { vector } "specializer" set-word-prop
 161
 162 \ >le { { fixnum bignum } fixnum } "specializer" set-word-prop
 163
 164 \ >be { { fixnum bignum } fixnum } "specializer" set-word-prop
 165
 166 \ (buffer-until) { fixnum fixnum simple-alien string } "specializer" set-word-prop