Omit tuple dispatch engines from usage listings

db4
Slava Pestov 2008-04-12 19:05:06 -05:00
parent bb2453de0d
commit 615f7057e4
5 changed files with 28 additions and 15 deletions

View File

@ -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 )
[

View File

@ -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 -- )

View File

@ -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 ;

View File

@ -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

View File

@ -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* ;