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