Omit tuple dispatch engines from usage listings
parent
bb2453de0d
commit
615f7057e4
|
@ -20,7 +20,7 @@ IN: compiler
|
||||||
: finish-compile ( word effect dependencies -- )
|
: finish-compile ( word effect dependencies -- )
|
||||||
>r dupd save-effect r>
|
>r dupd save-effect r>
|
||||||
over compiled-unxref
|
over compiled-unxref
|
||||||
over crossref? [ compiled-xref ] [ 2drop ] if ;
|
over compiled-crossref? [ compiled-xref ] [ 2drop ] if ;
|
||||||
|
|
||||||
: compile-succeeded ( word -- effect dependencies )
|
: compile-succeeded ( word -- effect dependencies )
|
||||||
[
|
[
|
||||||
|
|
|
@ -66,7 +66,7 @@ GENERIC: definitions-changed ( assoc obj -- )
|
||||||
|
|
||||||
: compile ( words -- )
|
: compile ( words -- )
|
||||||
recompile-hook get call
|
recompile-hook get call
|
||||||
dup [ drop crossref? ] assoc-contains?
|
dup [ drop compiled-crossref? ] assoc-contains?
|
||||||
modify-code-heap ;
|
modify-code-heap ;
|
||||||
|
|
||||||
SYMBOL: outdated-tuples
|
SYMBOL: outdated-tuples
|
||||||
|
@ -82,7 +82,7 @@ SYMBOL: update-tuples-hook
|
||||||
: finish-compilation-unit ( -- )
|
: finish-compilation-unit ( -- )
|
||||||
call-recompile-hook
|
call-recompile-hook
|
||||||
call-update-tuples-hook
|
call-update-tuples-hook
|
||||||
dup [ drop crossref? ] assoc-contains? modify-code-heap
|
dup [ drop compiled-crossref? ] assoc-contains? modify-code-heap
|
||||||
updated-definitions notify-definition-observers ;
|
updated-definitions notify-definition-observers ;
|
||||||
|
|
||||||
: with-compilation-unit ( quot -- )
|
: with-compilation-unit ( quot -- )
|
||||||
|
|
|
@ -63,14 +63,14 @@ M: trivial-tuple-dispatch-engine engine>quot
|
||||||
] "" make ;
|
] "" make ;
|
||||||
|
|
||||||
PREDICATE: tuple-dispatch-engine-word < word
|
PREDICATE: tuple-dispatch-engine-word < word
|
||||||
"tuple-dispatch-engine" word-prop ;
|
"tuple-dispatch-generic" word-prop generic? ;
|
||||||
|
|
||||||
M: tuple-dispatch-engine-word stack-effect
|
M: tuple-dispatch-engine-word stack-effect
|
||||||
"tuple-dispatch-generic" word-prop
|
"tuple-dispatch-generic" word-prop
|
||||||
[ extra-values ] [ stack-effect clone ] bi
|
[ extra-values ] [ stack-effect ] bi
|
||||||
[ length + ] change-in ;
|
dup [ clone [ length + ] change-in ] [ 2drop f ] if ;
|
||||||
|
|
||||||
M: tuple-dispatch-engine-word crossref?
|
M: tuple-dispatch-engine-word compiled-crossref?
|
||||||
drop t ;
|
drop t ;
|
||||||
|
|
||||||
: remember-engine ( word -- )
|
: remember-engine ( word -- )
|
||||||
|
@ -78,12 +78,10 @@ M: tuple-dispatch-engine-word crossref?
|
||||||
|
|
||||||
: <tuple-dispatch-engine-word> ( engine -- word )
|
: <tuple-dispatch-engine-word> ( engine -- word )
|
||||||
tuple-dispatch-engine-word-name f <word>
|
tuple-dispatch-engine-word-name f <word>
|
||||||
{
|
[ generic get "tuple-dispatch-generic" set-word-prop ]
|
||||||
[ t "tuple-dispatch-engine" set-word-prop ]
|
[ remember-engine ]
|
||||||
[ generic get "tuple-dispatch-generic" set-word-prop ]
|
[ ]
|
||||||
[ remember-engine ]
|
tri ;
|
||||||
[ ]
|
|
||||||
} cleave ;
|
|
||||||
|
|
||||||
: define-tuple-dispatch-engine-word ( engine quot -- word )
|
: define-tuple-dispatch-engine-word ( engine quot -- word )
|
||||||
>r <tuple-dispatch-engine-word> dup r> define ;
|
>r <tuple-dispatch-engine-word> dup r> define ;
|
||||||
|
|
|
@ -2,7 +2,8 @@ IN: generic.standard.tests
|
||||||
USING: tools.test math math.functions math.constants
|
USING: tools.test math math.functions math.constants
|
||||||
generic.standard strings sequences arrays kernel accessors
|
generic.standard strings sequences arrays kernel accessors
|
||||||
words float-arrays byte-arrays bit-arrays parser namespaces
|
words float-arrays byte-arrays bit-arrays parser namespaces
|
||||||
quotations inference vectors growable ;
|
quotations inference vectors growable hashtables sbufs
|
||||||
|
prettyprint ;
|
||||||
|
|
||||||
GENERIC: lo-tag-test
|
GENERIC: lo-tag-test
|
||||||
|
|
||||||
|
@ -268,3 +269,13 @@ M: growable call-next-hooker call-next-method "growable " prepend ;
|
||||||
[ "vector growable sequence" ] [
|
[ "vector growable sequence" ] [
|
||||||
V{ } my-var [ call-next-hooker ] with-variable
|
V{ } my-var [ call-next-hooker ] with-variable
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
GENERIC: no-stack-effect-decl
|
||||||
|
|
||||||
|
M: hashtable no-stack-effect-decl ;
|
||||||
|
M: vector no-stack-effect-decl ;
|
||||||
|
M: sbuf no-stack-effect-decl ;
|
||||||
|
|
||||||
|
[ ] [ \ no-stack-effect-decl see ] unit-test
|
||||||
|
|
||||||
|
[ ] [ \ no-stack-effect-decl word-def . ] unit-test
|
||||||
|
|
|
@ -71,6 +71,10 @@ M: word crossref?
|
||||||
word-vocabulary >boolean
|
word-vocabulary >boolean
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
GENERIC: compiled-crossref? ( word -- ? )
|
||||||
|
|
||||||
|
M: word compiled-crossref? crossref? ;
|
||||||
|
|
||||||
GENERIC# (quot-uses) 1 ( obj assoc -- )
|
GENERIC# (quot-uses) 1 ( obj assoc -- )
|
||||||
|
|
||||||
M: object (quot-uses) 2drop ;
|
M: object (quot-uses) 2drop ;
|
||||||
|
@ -97,7 +101,7 @@ SYMBOL: compiled-crossref
|
||||||
compiled-crossref global [ H{ } assoc-like ] change-at
|
compiled-crossref global [ H{ } assoc-like ] change-at
|
||||||
|
|
||||||
: compiled-xref ( word dependencies -- )
|
: compiled-xref ( word dependencies -- )
|
||||||
[ drop crossref? ] assoc-subset
|
[ drop compiled-crossref? ] assoc-subset
|
||||||
2dup "compiled-uses" set-word-prop
|
2dup "compiled-uses" set-word-prop
|
||||||
compiled-crossref get add-vertex* ;
|
compiled-crossref get add-vertex* ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue