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? : ( engine -- word ) tuple-dispatch-engine-word-name f - { - [ 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 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* ;