steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler: tweak generated code

db4
Slava Pestov 2009-09-04 03:01:18 -05:00
parent e11d1e37f5
commit 4a2823b2eb
5 changed files with 28 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
basis/compiler/cfg/def-use/def-use.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs classes combinators compiler.units fry USING: accessors assocs arrays classes combinators
generalizations generic kernel locals namespaces quotations compiler.units fry generalizations generic kernel locals
sequences sets slots words compiler.cfg.instructions namespaces quotations sequences sets slots words
compiler.cfg.instructions.syntax compiler.cfg.rpo ; compiler.cfg.instructions compiler.cfg.instructions.syntax
compiler.cfg.rpo ;
IN: compiler.cfg.def-use IN: compiler.cfg.def-use
GENERIC: defs-vreg ( insn -- vreg/f ) GENERIC: defs-vreg ( insn -- vreg/f )
@ -15,10 +16,12 @@ M: ##phi uses-vregs inputs>> values ;
<PRIVATE <PRIVATE
: slot-array-quot ( slots -- quot ) : slot-array-quot ( slots -- quot )
[ [ drop f ] ] [ [ reader-word 1quotation ] map dup length {
[ reader-word 1quotation ] map { 0 [ drop [ drop f ] ] }
dup length '[ _ cleave _ narray ] { 1 [ first [ 1array ] compose ] }
] if-empty ; { 2 [ first2 '[ _ _ bi 2array ] ] }
[ '[ _ cleave _ narray ] ]
} case ;
: define-defs-vreg-method ( insn -- ) : define-defs-vreg-method ( insn -- )
[ \ defs-vreg create-method ] [ \ defs-vreg create-method ]

5
basis/compiler/cfg/instructions/syntax/syntax.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: classes.tuple classes.tuple.parser kernel words USING: classes.tuple classes.tuple.parser kernel words
make fry sequences parser accessors effects namespaces make fry sequences parser accessors effects namespaces
combinators splitting classes.parser lexer ; combinators splitting classes.parser lexer quotations ;
IN: compiler.cfg.instructions.syntax IN: compiler.cfg.instructions.syntax
SYMBOLS: def use temp literal constant ; SYMBOLS: def use temp literal constant ;
@ -67,7 +67,8 @@ TUPLE: insn-slot-spec type name rep ;
[ name>> ] map "insn#" suffix define-tuple-class ; [ name>> ] map "insn#" suffix define-tuple-class ;
: define-insn-ctor ( class specs -- ) : define-insn-ctor ( class specs -- )
[ dup '[ f _ boa , ] ] dip [ name>> ] map f <effect> define-declared ; [ dup '[ _ ] [ f ] [ boa , ] surround ] dip
[ name>> ] map f <effect> define-declared ;
: define-insn ( class superclass specs -- ) : define-insn ( class superclass specs -- )
parse-insn-slot-specs { parse-insn-slot-specs {

13
basis/compiler/cfg/representations/preferred/preferred.factor
View File

@ -17,7 +17,7 @@ GENERIC: uses-vreg-reps ( insn -- reps )
{ {
{ f [ [ rep>> ] ] } { f [ [ rep>> ] ] }
{ scalar-rep [ [ rep>> scalar-rep-of ] ] } { scalar-rep [ [ rep>> scalar-rep-of ] ] }
[ '[ _ nip ] ] [ [ drop ] swap suffix ]
} case ; } case ;
: define-defs-vreg-rep-method ( insn -- ) : define-defs-vreg-rep-method ( insn -- )
@ -26,7 +26,16 @@ GENERIC: uses-vreg-reps ( insn -- reps )
bi define ; bi define ;
: reps-getter-quot ( reps -- quot ) : reps-getter-quot ( reps -- quot )
[ rep>> rep-getter-quot ] map dup length '[ _ cleave _ narray ] ; dup [ rep>> { f scalar-rep } memq? not ] all? [
[ rep>> ] map [ drop ] swap suffix
] [
[ rep>> rep-getter-quot ] map dup length {
{ 0 [ drop [ drop f ] ] }
{ 1 [ first [ 1array ] compose ] }
{ 2 [ first2 '[ _ _ bi 2array ] ] }
[ '[ _ cleave _ narray ] ]
} case
] if ;
: define-uses-vreg-reps-method ( insn -- ) : define-uses-vreg-reps-method ( insn -- )
[ \ uses-vreg-reps create-method ] [ \ uses-vreg-reps create-method ]

2
basis/compiler/cfg/value-numbering/expressions/expressions.factor
View File

@ -64,7 +64,7 @@ M: ##load-reference >expr obj>> <reference> ;
{ constant [ [ constant>vn ] ] } { constant [ [ constant>vn ] ] }
} case } case
] bi append ] bi append
] map swap '[ _ cleave _ boa ] ; ] map cleave>quot swap suffix \ boa suffix ;
: define->expr-method ( insn expr slot-specs -- ) : define->expr-method ( insn expr slot-specs -- )
[ 2drop \ >expr create-method-in ] [ >expr-quot nip ] 3bi define ; [ 2drop \ >expr create-method-in ] [ >expr-quot nip ] 3bi define ;

5
basis/compiler/codegen/codegen.factor
View File

@ -100,9 +100,8 @@ M: _spill-area-size generate-insn drop ;
: codegen-method-body ( class word -- quot ) : codegen-method-body ( class word -- quot )
[ [
"insn-slots" word-prop "insn-slots" word-prop
[ insn-slot-quot ] map [ insn-slot-quot ] map cleave>quot
] dip ] dip suffix ;
'[ _ cleave _ execute ] ;
SYNTAX: CODEGEN: SYNTAX: CODEGEN:
scan-word [ \ generate-insn create-method-in ] keep scan-word scan-word [ \ generate-insn create-method-in ] keep scan-word