Better optimizers for new, boa

db4
Slava Pestov 2008-06-30 03:10:43 -05:00
parent f7b7001f39
commit fb8723bce1
8 changed files with 68 additions and 36 deletions

View File

@ -477,7 +477,9 @@ USE: vocabs
] with-compilation-unit
] unit-test
[ "USE: words T{ word }" eval ] [ error>> T{ no-method f word new } = ] must-fail-with
[ "USE: words T{ word }" eval ]
[ error>> T{ no-method f word slots>tuple } = ]
must-fail-with
! Accessors not being forgotten...
[ [ ] ] [
@ -621,3 +623,11 @@ must-fail-with
[ 0 { } foo ]
[ T{ bad-slot-value f { } string } = ]
must-fail-with
[ T{ declared-types f 0 "" } ] [ declared-types new ] unit-test
: blah ( -- vec ) vector new ;
\ blah must-infer
[ V{ } ] [ blah ] unit-test

View File

@ -16,6 +16,18 @@ ERROR: not-a-tuple object ;
<PRIVATE
: (tuple) ( layout -- tuple )
#! In non-optimized code, this word simply calls the
#! <tuple> primitive. In optimized code, an intrinsic
#! is generated which allocates a tuple but does not set
#! any of its slots. This means that any code that uses
#! (tuple) must fill in the slots before the next
#! call to GC.
#!
#! This word is only used in the expansion of <tuple-boa>,
#! where this invariant is guaranteed to hold.
<tuple> ;
: tuple-layout ( class -- layout )
"layout" word-prop ;
@ -52,9 +64,11 @@ PRIVATE>
] 2each
] if-bootstrapping ; inline
: slots>tuple ( seq class -- tuple )
GENERIC: slots>tuple ( seq class -- tuple )
M: tuple-class slots>tuple
check-slots
new [
tuple-layout <tuple> [
[ tuple-size ]
[ [ set-array-nth ] curry ]
bi 2each
@ -119,6 +133,12 @@ ERROR: bad-superclass class ;
: define-boa-check ( class -- )
dup boa-check-quot "boa-check" set-word-prop ;
: tuple-prototype ( class -- prototype )
[ all-slots [ initial>> ] map ] keep slots>tuple ;
: define-tuple-prototype ( class -- )
dup tuple-prototype "prototype" set-word-prop ;
: generate-tuple-slots ( class slots -- slot-specs )
over superclass-size 2 + make-slots deprecated-slots ;
@ -172,6 +192,7 @@ M: tuple-class update-class
[ define-tuple-layout ]
[ define-tuple-slots ]
[ define-tuple-predicate ]
[ define-tuple-prototype ]
[ define-boa-check ]
} cleave ;
@ -235,8 +256,11 @@ M: tuple-class reset-class
] with each
] [
[ call-next-method ]
[ { "layout" "slots" "slot-names" } reset-props ]
bi
[
{
"layout" "slots" "slot-names" "boa-check" "prototype"
} reset-props
] bi
] bi ;
M: tuple-class rank-class drop 0 ;
@ -258,7 +282,8 @@ M: tuple hashcode*
] 2curry each
] recursive-hashcode ;
M: tuple-class new tuple-layout <tuple> ;
M: tuple-class new
"prototype" word-prop (clone) ;
M: tuple-class boa
[ "boa-check" word-prop call ]

View File

@ -437,14 +437,11 @@ IN: cpu.ppc.intrinsics
{ +clobber+ { "n" } }
} define-intrinsic
\ <tuple> [
\ (tuple) [
tuple "layout" get size>> 2 + cells %allot
! Store layout
"layout" get 12 load-indirect
12 11 cell STW
! Zero out the rest of the tuple
f v>operand 12 LI
"layout" get size>> [ 12 11 rot 2 + cells STW ] each
! Store tagged ptr in reg
"tuple" get tuple %store-tagged
] H{

View File

@ -291,15 +291,11 @@ IN: cpu.x86.intrinsics
{ +clobber+ { "n" } }
} define-intrinsic
\ <tuple> [
\ (tuple) [
tuple "layout" get size>> 2 + cells [
! Store layout
"layout" get "scratch" get load-literal
1 object@ "scratch" operand MOV
! Zero out the rest of the tuple
"layout" get size>> [
2 + object@ f v>operand MOV
] each
! Store tagged ptr in reg
"tuple" get tuple %store-tagged
] %allot

View File

@ -550,6 +550,9 @@ set-primitive-effect
\ <tuple> { tuple-layout } { tuple } <effect> set-primitive-effect
\ <tuple> make-flushable
\ (tuple) { tuple-layout } { tuple } <effect> set-primitive-effect
\ (tuple) make-flushable
\ <tuple-layout> { word fixnum array fixnum } { tuple-layout } <effect> set-primitive-effect
\ <tuple-layout> make-foldable

View File

@ -95,12 +95,13 @@ M: duplicated-slots-error summary
] 1 define-transform
: [tuple-boa] ( layout -- quot )
[ [ <tuple> ] curry ]
[ [ (tuple) ] curry ]
[
size>> 1 - [ 3 + ] map <reversed>
[ [ set-slot ] curry [ keep ] curry ] map concat
]
bi append ;
] bi
[ f over 2 set-slot ]
3append ;
\ <tuple-boa> [ [tuple-boa] ] 1 define-transform

View File

@ -13,10 +13,6 @@ $nl
ABOUT: "mirrors"
HELP: object-slots
{ $values { "obj" object } { "seq" "a sequence of " { $link slot-spec } " instances" } }
{ $description "Outputs a sequence of slot specifiers for the object." } ;
HELP: mirror
{ $class-description "An associative structure which wraps an object and presents itself as a mapping from slot names to the object's slot values. Mirrors are used to build reflective developer tools."
$nl

View File

@ -12,7 +12,7 @@ optimizer.backend optimizer.pattern-match optimizer.inlining
float-arrays sequences.private combinators byte-arrays
byte-vectors ;
{ <tuple> <tuple-boa> } [
{ <tuple> <tuple-boa> (tuple) } [
[
dup node-in-d peek node-literal
dup tuple-layout? [ class>> ] [ drop tuple ] if
@ -25,6 +25,23 @@ byte-vectors ;
dup class? [ drop tuple ] unless 1array f
] "output-classes" set-word-prop
! if the input to new is a literal tuple class, we can expand it
: literal-new? ( #call -- ? )
dup in-d>> first node-literal tuple-class? ;
: new-quot ( class -- quot )
dup all-slots 1 tail ! delegate slot
[ [ initial>> literalize , ] each literalize , \ boa , ] [ ] make ;
: expand-new ( #call -- node )
dup dup in-d>> first node-literal
[ +inlined+ depends-on ] [ new-quot ] bi
f splice-quot ;
\ new {
{ [ dup literal-new? ] [ expand-new ] }
} define-optimizers
! the output of clone has the same type as the input
{ clone (clone) } [
[
@ -128,19 +145,6 @@ byte-vectors ;
] if
] "constraints" set-word-prop
! if the input to new is a literal tuple class, we can expand it
: literal-new? ( #call -- ? )
dup in-d>> first node-literal tuple-class? ;
: expand-new ( #call -- node )
dup dup in-d>> first node-literal
[ +inlined+ depends-on ] [ tuple-layout [ nip <tuple> ] curry ] bi
f splice-quot ;
\ new {
{ [ dup literal-new? ] [ expand-new ] }
} define-optimizers
! open-code instance? checks on predicate classes
: literal-predicate-class? ( #call -- ? )
dup in-d>> second node-literal predicate-class? ;