! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors classes classes.algebra classes.parser classes.tuple combinators combinators.short-circuit fry generic.parser kernel math namespaces quotations sequences slots splitting words compiler.cfg.instructions compiler.cfg.instructions.syntax compiler.cfg.value-numbering.graph ; IN: compiler.cfg.value-numbering.expressions TUPLE: constant-expr < expr value ; C: constant-expr M: constant-expr equal? over constant-expr? [ [ value>> ] bi@ 2dup [ float? ] both? [ fp-bitwise= ] [ { [ [ class ] bi@ = ] [ = ] } 2&& ] if ] [ 2drop f ] if ; TUPLE: reference-expr < expr value ; C: reference-expr M: reference-expr equal? over reference-expr? [ [ value>> ] bi@ eq? ] [ 2drop f ] if ; : constant>vn ( constant -- vn ) expr>vn ; inline GENERIC: >expr ( insn -- expr ) M: insn >expr drop next-input-expr ; M: ##load-immediate >expr val>> ; M: ##load-reference >expr obj>> ; M: ##load-constant >expr obj>> ; << : input-values ( slot-specs -- slot-specs' ) [ type>> { use literal constant } memq? ] filter ; : expr-class ( insn -- expr ) name>> "##" ?head drop "-expr" append create-class-in ; : define-expr-class ( insn expr slot-specs -- ) [ nip expr ] dip [ name>> ] map define-tuple-class ; : >expr-quot ( expr slot-specs -- quot ) [ [ name>> reader-word 1quotation ] [ type>> { { use [ [ vreg>vn ] ] } { literal [ [ ] ] } { constant [ [ constant>vn ] ] } } case ] bi append ] map cleave>quot swap suffix \ boa suffix ; : define->expr-method ( insn expr slot-specs -- ) [ 2drop \ >expr create-method-in ] [ >expr-quot nip ] 3bi define ; : handle-pure-insn ( insn -- ) [ ] [ expr-class ] [ "insn-slots" word-prop input-values ] tri [ define-expr-class ] [ define->expr-method ] 3bi ; insn-classes get [ pure-insn class<= ] filter [ handle-pure-insn ] each >>