extra/compiler/cfg/gvn/expressions/expressions.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov, 2011 Alex Vondrak.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs accessors arrays classes.algebra
   4 combinators generic.parser kernel math namespaces
   5 quotations sequences slots words make sets
   6 compiler.cfg
   7 compiler.cfg.instructions
   8 compiler.cfg.instructions.syntax
   9 compiler.cfg.gvn.graph ;
  10 FROM: sequences.private => set-array-nth ;
  11 IN: compiler.cfg.gvn.expressions
  12
  13 <<
  14
  15 GENERIC: >expr ( insn -- expr )
  16
  17 : input-values ( slot-specs -- slot-specs' )
  18     [ type>> { use literal } member-eq? ] filter ;
  19
  20 : slot->expr-quot ( slot-spec -- quot )
  21     [ name>> reader-word 1quotation ]
  22     [
  23         type>> {
  24             { use [ [ vreg>vn ] ] }
  25             { literal [ [ ] ] }
  26         } case
  27     ] bi append ;
  28
  29 : narray-quot ( length -- quot )
  30     [
  31         [ , [ f <array> ] % ]
  32         [
  33             dup <iota> [
  34                 - 1 - , [ swap [ set-array-nth ] keep ] %
  35             ] with each
  36         ] bi
  37     ] [ ] make ;
  38
  39 : >expr-quot ( insn slot-specs -- quot )
  40     [
  41         [ literalize , \ swap , ]
  42         [
  43             [ [ slot->expr-quot ] map cleave>quot % ]
  44             [ length 1 + narray-quot % ]
  45             bi
  46         ] bi*
  47     ] [ ] make ;
  48
  49 : define->expr-method ( insn slot-specs -- )
  50     [ drop \ >expr create-method-in ] [ >expr-quot ] 2bi define ;
  51
  52 insn-classes get
  53 [ foldable-insn class<= ] filter
  54 { ##copy ##load-integer ##load-reference } diff
  55 [
  56     dup "insn-slots" word-prop input-values
  57     define->expr-method
  58 ] each
  59
  60 >>
  61
  62 TUPLE: integer-expr value ;
  63
  64 C: <integer-expr> integer-expr
  65
  66 TUPLE: reference-expr value ;
  67
  68 C: <reference-expr> reference-expr
  69
  70 M: reference-expr equal?
  71     over reference-expr? [
  72         [ value>> ] bi@
  73         2dup [ float? ] both?
  74         [ fp-bitwise= ] [ eq? ] if
  75     ] [ 2drop f ] if ;
  76
  77 M: reference-expr hashcode*
  78     nip value>> dup float? [ double>bits ] [ identity-hashcode ] if ;
  79
  80 M: insn >expr drop input-expr-counter counter neg ;
  81
  82 M: ##copy >expr "Fail" throw ;
  83
  84 M: ##load-integer >expr val>> <integer-expr> ;
  85
  86 M: ##load-reference >expr obj>> <reference-expr> ;
  87
  88 ! TODO experiment with sorting, in case that identifies more
  89 ! phi equivalences
  90
  91 M: ##phi >expr
  92     inputs>> values [ vreg>vn ] map
  93     basic-block get number>> prefix
  94     ##phi prefix ;