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 classes.algebra
4 combinators fry generic.parser kernel math namespaces
5 quotations sequences slots words make sets
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
15 GENERIC: >expr ( insn -- expr )
17 : input-values ( slot-specs -- slot-specs' )
18 [ type>> { use literal } member-eq? ] filter ;
20 : slot->expr-quot ( slot-spec -- quot )
21 [ name>> reader-word 1quotation ]
24 { use [ [ vreg>vn ] ] }
29 : narray-quot ( length -- quot )
34 - 1 - , [ swap [ set-array-nth ] keep ] %
39 : >expr-quot ( insn slot-specs -- quot )
41 [ literalize , \ swap , ]
43 [ [ slot->expr-quot ] map cleave>quot % ]
44 [ length 1 + narray-quot % ]
49 : define->expr-method ( insn slot-specs -- )
50 [ drop \ >expr create-method-in ] [ >expr-quot ] 2bi define ;
53 [ foldable-insn class<= ] filter
54 { ##copy ##load-integer ##load-reference } diff
56 dup "insn-slots" word-prop input-values
62 TUPLE: integer-expr value ;
64 C: <integer-expr> integer-expr
66 TUPLE: reference-expr value ;
68 C: <reference-expr> reference-expr
70 M: reference-expr equal?
71 over reference-expr? [
74 [ fp-bitwise= ] [ eq? ] if
77 M: reference-expr hashcode*
78 nip value>> dup float? [ double>bits ] [ identity-hashcode ] if ;
80 M: insn >expr drop input-expr-counter counter neg ;
82 M: ##copy >expr "Fail" throw ;
84 M: ##load-integer >expr val>> <integer-expr> ;
86 M: ##load-reference >expr obj>> <reference-expr> ;
88 ! TODO experiment with sorting, in case that identifies more
92 inputs>> values [ vreg>vn ] map
93 basic-block get number>> prefix