From 615f7057e4a60112c73964c5240831a870f143ef Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 12 Apr 2008 19:05:06 -0500
Subject: [PATCH] Omit tuple dispatch engines from usage listings
---
core/compiler/compiler.factor | 2 +-
core/compiler/units/units.factor | 4 ++--
.../standard/engines/tuple/tuple.factor | 18 ++++++++----------
core/generic/standard/standard-tests.factor | 13 ++++++++++++-
core/words/words.factor | 6 +++++-
5 files changed, 28 insertions(+), 15 deletions(-)
diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor
index 6f75ca873d..806ea914bb 100755
--- a/core/compiler/compiler.factor
+++ b/core/compiler/compiler.factor
@@ -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 )
[
diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index a780e0a745..58300b721a 100755
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -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 -- )
diff --git a/core/generic/standard/engines/tuple/tuple.factor b/core/generic/standard/engines/tuple/tuple.factor
index 69d73aa872..a13cbc092d 100644
--- a/core/generic/standard/engines/tuple/tuple.factor
+++ b/core/generic/standard/engines/tuple/tuple.factor
@@ -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 ;
diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor
index a906acd324..9eb39cf16e 100644
--- a/core/generic/standard/standard-tests.factor
+++ b/core/generic/standard/standard-tests.factor
@@ -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
diff --git a/core/words/words.factor b/core/words/words.factor
index e1d2f11356..3466544eef 100755
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -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* ;