stack-checker.dependencies: add tuple layout dependencies for use by 'new' and 'boa'
parent
09ead56652
commit
6cc68e889e
|
@ -163,10 +163,12 @@ ERROR: bad-partial-eval quot word ;
|
|||
|
||||
: inline-new ( class -- quot/f )
|
||||
dup tuple-class? [
|
||||
dup depends-on-conditionally
|
||||
[ all-slots [ initial>> literalize ] map ]
|
||||
[ tuple-layout '[ _ <tuple-boa> ] ]
|
||||
bi append >quotation
|
||||
dup tuple-layout
|
||||
[ depends-on-tuple-layout ]
|
||||
[ drop all-slots [ initial>> literalize ] [ ] map-as ]
|
||||
[ nip ]
|
||||
2tri
|
||||
'[ @ _ <tuple-boa> ]
|
||||
] [ drop f ] if ;
|
||||
|
||||
\ new [ inline-new ] 1 define-partial-eval
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs accessors classes.algebra fry generic kernel math
|
||||
namespaces sequences words ;
|
||||
FROM: classes.tuple.private => tuple-layout ;
|
||||
IN: stack-checker.dependencies
|
||||
|
||||
! Words that the current quotation depends on
|
||||
|
@ -79,6 +80,15 @@ TUPLE: depends-on-method class generic method ;
|
|||
M: depends-on-method satisfied?
|
||||
[ [ class>> ] [ generic>> ] bi method-for-class ] [ method>> ] bi eq? ;
|
||||
|
||||
TUPLE: depends-on-tuple-layout class layout ;
|
||||
|
||||
: depends-on-tuple-layout ( class layout -- )
|
||||
[ drop depends-on-conditionally ]
|
||||
[ \ depends-on-tuple-layout add-conditional-dependency ] 2bi ;
|
||||
|
||||
M: depends-on-tuple-layout satisfied?
|
||||
[ class>> tuple-layout ] [ layout>> ] bi eq? ;
|
||||
|
||||
TUPLE: depends-on-flushable word ;
|
||||
|
||||
: depends-on-flushable ( word -- )
|
||||
|
|
|
@ -140,10 +140,10 @@ IN: stack-checker.transforms
|
|||
! Constructors
|
||||
\ boa [
|
||||
dup tuple-class? [
|
||||
dup depends-on-conditionally
|
||||
[ "boa-check" word-prop [ ] or ]
|
||||
[ tuple-layout '[ _ <tuple-boa> ] ]
|
||||
bi append
|
||||
dup tuple-layout
|
||||
[ depends-on-tuple-layout ]
|
||||
[ [ "boa-check" word-prop [ ] or ] dip ] 2bi
|
||||
'[ @ _ <tuple-boa> ]
|
||||
] [ drop f ] if
|
||||
] 1 define-transform
|
||||
|
||||
|
|
Loading…
Reference in New Issue