Better optimizers for new, boa
parent
f7b7001f39
commit
fb8723bce1
|
@ -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
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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{
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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? ;
|
||||
|
|
Loading…
Reference in New Issue