New 'conditional dependency' mechanism for more accurate recording of recompilation information
							parent
							
								
									817bc02392
								
							
						
					
					
						commit
						c027046857
					
				| 
						 | 
				
			
			@ -49,8 +49,7 @@ SYMBOL: compiled
 | 
			
		|||
 | 
			
		||||
: start ( word -- )
 | 
			
		||||
    dup name>> compiler-message
 | 
			
		||||
    H{ } clone dependencies set
 | 
			
		||||
    H{ } clone generic-dependencies set
 | 
			
		||||
    init-dependencies
 | 
			
		||||
    clear-compiler-error ;
 | 
			
		||||
 | 
			
		||||
GENERIC: no-compile? ( word -- ? )
 | 
			
		||||
| 
						 | 
				
			
			@ -86,9 +85,9 @@ M: word combinator? inline? ;
 | 
			
		|||
    [ compiled-unxref ]
 | 
			
		||||
    [
 | 
			
		||||
        dup crossref? [
 | 
			
		||||
            dependencies get
 | 
			
		||||
            generic-dependencies get
 | 
			
		||||
            compiled-xref
 | 
			
		||||
            [ dependencies get generic-dependencies get compiled-xref ]
 | 
			
		||||
            [ conditional-dependencies get save-conditional-dependencies ]
 | 
			
		||||
            bi
 | 
			
		||||
        ] [ drop ] if
 | 
			
		||||
    ] tri ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -203,7 +202,9 @@ M: optimizing-compiler recompile ( words -- alist )
 | 
			
		|||
    "--- compile done" compiler-message ;
 | 
			
		||||
 | 
			
		||||
M: optimizing-compiler to-recompile ( -- words )
 | 
			
		||||
    changed-definitions get compiled-usages assoc-combine keys ;
 | 
			
		||||
    changed-definitions get compiled-usages
 | 
			
		||||
    changed-classes get outdated-class-usages
 | 
			
		||||
    append assoc-combine keys ;
 | 
			
		||||
 | 
			
		||||
M: optimizing-compiler process-forgotten-words
 | 
			
		||||
    [ delete-compiled-xref ] each ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2009, 2010 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: assocs classes.algebra compiler.units definitions graphs
 | 
			
		||||
grouping kernel namespaces sequences words fry
 | 
			
		||||
USING: arrays assocs classes.algebra compiler.units definitions
 | 
			
		||||
graphs grouping kernel namespaces sequences words fry
 | 
			
		||||
stack-checker.dependencies ;
 | 
			
		||||
IN: compiler.crossref
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -25,10 +25,21 @@ compiled-generic-crossref [ H{ } clone ] initialize
 | 
			
		|||
    [ "flushable" word-prop inlined-dependency flushed-dependency ? ] bi
 | 
			
		||||
    '[ nip _ dependency>= ] assoc-filter ;
 | 
			
		||||
 | 
			
		||||
: compiled-usages ( seq -- assocs )
 | 
			
		||||
: compiled-usages ( assoc -- assocs )
 | 
			
		||||
    [ drop word? ] assoc-filter
 | 
			
		||||
    [ [ drop (compiled-usages) ] { } assoc>map ] keep suffix ;
 | 
			
		||||
 | 
			
		||||
: dependencies-satisfied? ( word -- ? )
 | 
			
		||||
    "conditional-dependencies" word-prop [ satisfied? ] all? ;
 | 
			
		||||
 | 
			
		||||
: outdated-class-usages ( assoc -- assocs )
 | 
			
		||||
    [
 | 
			
		||||
        drop
 | 
			
		||||
        compiled-usage
 | 
			
		||||
        [ nip class-dependency dependency>= ] assoc-filter
 | 
			
		||||
        [ drop dependencies-satisfied? not ] assoc-filter
 | 
			
		||||
    ] { } assoc>map ;
 | 
			
		||||
 | 
			
		||||
: compiled-generic-usage ( word -- assoc )
 | 
			
		||||
    compiled-generic-crossref get at ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -49,10 +60,14 @@ compiled-generic-crossref [ H{ } clone ] initialize
 | 
			
		|||
: compiled-unxref ( word -- )
 | 
			
		||||
    [ "compiled-uses" compiled-crossref (compiled-unxref) ]
 | 
			
		||||
    [ "compiled-generic-uses" compiled-generic-crossref (compiled-unxref) ]
 | 
			
		||||
    bi ;
 | 
			
		||||
    [ f "conditional-dependencies" set-word-prop ]
 | 
			
		||||
    tri ;
 | 
			
		||||
 | 
			
		||||
: delete-compiled-xref ( word -- )
 | 
			
		||||
    [ compiled-unxref ]
 | 
			
		||||
    [ compiled-crossref get delete-at ]
 | 
			
		||||
    [ compiled-generic-crossref get delete-at ]
 | 
			
		||||
    tri ;
 | 
			
		||||
 | 
			
		||||
: save-conditional-dependencies ( word deps -- )
 | 
			
		||||
    >array f like "conditional-dependencies" set-word-prop ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -76,8 +76,6 @@ M: object fake-float? drop f ;
 | 
			
		|||
 | 
			
		||||
[ f ] [ 1.0 my-fake-inline-3 ] unit-test
 | 
			
		||||
 | 
			
		||||
[ f ] [ 1.0 my-baked-inline-3 ] unit-test
 | 
			
		||||
 | 
			
		||||
[ f ] [ 1.0 my-inline-4 ] unit-test
 | 
			
		||||
 | 
			
		||||
[ f ] [ 1.0 my-inline-5 ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,4 +1,4 @@
 | 
			
		|||
! Copyright (C) 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2008, 2010 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: kernel accessors sequences combinators fry
 | 
			
		||||
classes.algebra namespaces assocs words math math.private
 | 
			
		||||
| 
						 | 
				
			
			@ -51,9 +51,15 @@ GENERIC: cleanup* ( node -- node/nodes )
 | 
			
		|||
    [ in-d>> #drop ]
 | 
			
		||||
    bi prefix ;
 | 
			
		||||
 | 
			
		||||
: record-predicate-folding ( #call -- )
 | 
			
		||||
    [ node-input-infos first class>> ]
 | 
			
		||||
    [ word>> "predicating" word-prop ]
 | 
			
		||||
    [ node-output-infos first literal>> ] tri
 | 
			
		||||
    [ depends-on-class<= ] [ depends-on-classes-disjoint ] if ;
 | 
			
		||||
 | 
			
		||||
: record-folding ( #call -- )
 | 
			
		||||
    dup word>> predicate?
 | 
			
		||||
    [ [ node-input-infos first class>> ] [ word>> ] bi depends-on-generic ]
 | 
			
		||||
    [ record-predicate-folding ]
 | 
			
		||||
    [ word>> inlined-dependency depends-on ]
 | 
			
		||||
    if ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -63,15 +69,18 @@ GENERIC: cleanup* ( node -- node/nodes )
 | 
			
		|||
! Method inlining
 | 
			
		||||
: add-method-dependency ( #call -- )
 | 
			
		||||
    dup method>> word? [
 | 
			
		||||
        [ class>> ] [ word>> ] bi depends-on-generic
 | 
			
		||||
        [ [ class>> ] [ word>> ] bi depends-on-generic ]
 | 
			
		||||
        [ [ class>> ] [ word>> ] [ method>> ] tri depends-on-method ]
 | 
			
		||||
        bi
 | 
			
		||||
    ] [ drop ] if ;
 | 
			
		||||
 | 
			
		||||
: cleanup-inlining ( #call -- nodes )
 | 
			
		||||
    [
 | 
			
		||||
: record-inlining ( #call -- )
 | 
			
		||||
    dup method>>
 | 
			
		||||
    [ add-method-dependency ]
 | 
			
		||||
        [ word>> inlined-dependency depends-on ] if
 | 
			
		||||
    ] [ body>> cleanup ] bi ;
 | 
			
		||||
    [ word>> inlined-dependency depends-on ] if ;
 | 
			
		||||
 | 
			
		||||
: cleanup-inlining ( #call -- nodes )
 | 
			
		||||
    [ record-inlining ] [ body>> cleanup ] bi ;
 | 
			
		||||
 | 
			
		||||
! Removing overflow checks
 | 
			
		||||
: (remove-overflow-check?) ( #call -- ? )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -9,14 +9,6 @@ compiler.tree.propagation.info
 | 
			
		|||
compiler.tree.dead-code.liveness ;
 | 
			
		||||
IN: compiler.tree.dead-code.simple
 | 
			
		||||
 | 
			
		||||
GENERIC: flushable? ( word -- ? )
 | 
			
		||||
 | 
			
		||||
M: predicate flushable? drop t ;
 | 
			
		||||
 | 
			
		||||
M: word flushable? "flushable" word-prop ;
 | 
			
		||||
 | 
			
		||||
M: method-body flushable? "method-generic" word-prop flushable? ;
 | 
			
		||||
 | 
			
		||||
: flushable-call? ( #call -- ? )
 | 
			
		||||
    dup word>> dup flushable? [
 | 
			
		||||
        "input-classes" word-prop dup [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -318,7 +318,7 @@ generic-comparison-ops [
 | 
			
		|||
    dup literal>> class?
 | 
			
		||||
    [
 | 
			
		||||
        literal>>
 | 
			
		||||
        [ inlined-dependency depends-on ]
 | 
			
		||||
        [ class-dependency depends-on ]
 | 
			
		||||
        [ predicate-output-infos ]
 | 
			
		||||
        bi
 | 
			
		||||
    ] [ 2drop object-info ] if
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -36,7 +36,7 @@ M: #declare propagate-before
 | 
			
		|||
    #! classes mentioned in the declaration are redefined, since
 | 
			
		||||
    #! now we're making assumptions but their definitions.
 | 
			
		||||
    declaration>> [
 | 
			
		||||
        [ inlined-dependency depends-on ]
 | 
			
		||||
        [ class-dependency depends-on ]
 | 
			
		||||
        [ <class-info> swap refine-value-info ]
 | 
			
		||||
        bi
 | 
			
		||||
    ] assoc-each ;
 | 
			
		||||
| 
						 | 
				
			
			@ -110,8 +110,9 @@ M: #declare propagate-before
 | 
			
		|||
    #! is redefined, since now we're making assumptions but the
 | 
			
		||||
    #! class definition itself.
 | 
			
		||||
    [ in-d>> first value-info ]
 | 
			
		||||
    [ "predicating" word-prop dup inlined-dependency depends-on ] bi*
 | 
			
		||||
    predicate-output-infos 1array ;
 | 
			
		||||
    [ "predicating" word-prop ] bi*
 | 
			
		||||
    [ nip class-dependency depends-on ]
 | 
			
		||||
    [ predicate-output-infos 1array ] 2bi ;
 | 
			
		||||
 | 
			
		||||
: default-output-value-infos ( #call word -- infos )
 | 
			
		||||
    "default-output-classes" word-prop
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -163,7 +163,7 @@ ERROR: bad-partial-eval quot word ;
 | 
			
		|||
 | 
			
		||||
: inline-new ( class -- quot/f )
 | 
			
		||||
    dup tuple-class? [
 | 
			
		||||
        dup inlined-dependency depends-on
 | 
			
		||||
        dup class-dependency depends-on
 | 
			
		||||
        [ all-slots [ initial>> literalize ] map ]
 | 
			
		||||
        [ tuple-layout '[ _ <tuple-boa> ] ]
 | 
			
		||||
        bi append >quotation
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,19 +1,19 @@
 | 
			
		|||
! Copyright (C) 2009 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2009, 2010 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: assocs classes.algebra fry kernel math namespaces
 | 
			
		||||
sequences words ;
 | 
			
		||||
USING: assocs accessors classes.algebra fry generic kernel math
 | 
			
		||||
namespaces sequences words ;
 | 
			
		||||
IN: stack-checker.dependencies
 | 
			
		||||
 | 
			
		||||
! Words that the current quotation depends on
 | 
			
		||||
SYMBOL: dependencies
 | 
			
		||||
 | 
			
		||||
SYMBOLS: inlined-dependency flushed-dependency called-dependency ;
 | 
			
		||||
SYMBOLS: inlined-dependency class-dependency flushed-dependency called-dependency ;
 | 
			
		||||
 | 
			
		||||
: index>= ( obj1 obj2 seq -- ? )
 | 
			
		||||
    [ index ] curry bi@ >= ;
 | 
			
		||||
 | 
			
		||||
: dependency>= ( how1 how2 -- ? )
 | 
			
		||||
    { called-dependency flushed-dependency inlined-dependency }
 | 
			
		||||
    { called-dependency class-dependency flushed-dependency inlined-dependency }
 | 
			
		||||
    index>= ;
 | 
			
		||||
 | 
			
		||||
: strongest-dependency ( how1 how2 -- how )
 | 
			
		||||
| 
						 | 
				
			
			@ -36,6 +36,45 @@ SYMBOL: generic-dependencies
 | 
			
		|||
    generic-dependencies get dup
 | 
			
		||||
    [ [ ?class-or ] change-at ] [ 3drop ] if ;
 | 
			
		||||
 | 
			
		||||
! Conditional dependencies are re-evaluated when classes change;
 | 
			
		||||
! if any fail, the word is recompiled
 | 
			
		||||
SYMBOL: conditional-dependencies
 | 
			
		||||
 | 
			
		||||
GENERIC: satisfied? ( dependency -- ? )
 | 
			
		||||
 | 
			
		||||
: conditional-dependency ( ... class -- )
 | 
			
		||||
    boa conditional-dependencies get
 | 
			
		||||
    dup [ push ] [ 2drop ] if ; inline
 | 
			
		||||
 | 
			
		||||
TUPLE: depends-on-class<= class1 class2 ;
 | 
			
		||||
 | 
			
		||||
: depends-on-class<= ( class1 class2 -- )
 | 
			
		||||
    \ depends-on-class<= conditional-dependency ;
 | 
			
		||||
 | 
			
		||||
M: depends-on-class<= satisfied?
 | 
			
		||||
    [ class1>> ] [ class2>> ] bi class<= ;
 | 
			
		||||
 | 
			
		||||
TUPLE: depends-on-classes-disjoint class1 class2 ;
 | 
			
		||||
 | 
			
		||||
: depends-on-classes-disjoint ( class1 class2 -- )
 | 
			
		||||
    \ depends-on-classes-disjoint conditional-dependency ;
 | 
			
		||||
 | 
			
		||||
M: depends-on-classes-disjoint satisfied?
 | 
			
		||||
    [ class1>> ] [ class2>> ] bi classes-intersect? not ;
 | 
			
		||||
 | 
			
		||||
TUPLE: depends-on-method class generic method ;
 | 
			
		||||
 | 
			
		||||
: depends-on-method ( class generic method -- )
 | 
			
		||||
    \ depends-on-method conditional-dependency ;
 | 
			
		||||
 | 
			
		||||
M: depends-on-method satisfied?
 | 
			
		||||
    [ [ class>> ] [ generic>> ] bi method-for-class ] [ method>> ] bi eq? ;
 | 
			
		||||
 | 
			
		||||
: init-dependencies ( -- )
 | 
			
		||||
    H{ } clone dependencies set
 | 
			
		||||
    H{ } clone generic-dependencies set
 | 
			
		||||
    V{ } clone conditional-dependencies set ;
 | 
			
		||||
 | 
			
		||||
: without-dependencies ( quot -- )
 | 
			
		||||
    [
 | 
			
		||||
        dependencies off
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -140,7 +140,7 @@ IN: stack-checker.transforms
 | 
			
		|||
! Constructors
 | 
			
		||||
\ boa [
 | 
			
		||||
    dup tuple-class? [
 | 
			
		||||
        dup inlined-dependency depends-on
 | 
			
		||||
        dup class-dependency depends-on
 | 
			
		||||
        [ "boa-check" word-prop [ ] or ]
 | 
			
		||||
        [ tuple-layout '[ _ <tuple-boa> ] ]
 | 
			
		||||
        bi append
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,4 +1,4 @@
 | 
			
		|||
! Copyright (C) 2007, 2009 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2007, 2010 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: arrays accessors io.backend io.streams.c init fry
 | 
			
		||||
namespaces math make assocs kernel parser parser.notes lexer
 | 
			
		||||
| 
						 | 
				
			
			@ -128,6 +128,7 @@ IN: tools.deploy.shaker
 | 
			
		|||
                "combination"
 | 
			
		||||
                "compiled-generic-uses"
 | 
			
		||||
                "compiled-uses"
 | 
			
		||||
                "conditional-dependencies"
 | 
			
		||||
                "constant"
 | 
			
		||||
                "constraints"
 | 
			
		||||
                "custom-inlining"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -45,6 +45,8 @@ PREDICATE: class < word "class" word-prop ;
 | 
			
		|||
 | 
			
		||||
PREDICATE: predicate < word "predicating" word-prop >boolean ;
 | 
			
		||||
 | 
			
		||||
M: predicate flushable? drop t ;
 | 
			
		||||
 | 
			
		||||
M: predicate forget*
 | 
			
		||||
    [ call-next-method ] [ f "predicating" set-word-prop ] bi ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -28,8 +28,9 @@ TUPLE: check-mixin-class class ;
 | 
			
		|||
 | 
			
		||||
: redefine-mixin-class ( class members -- )
 | 
			
		||||
    [ (define-union-class) ]
 | 
			
		||||
    [ drop changed-class ]
 | 
			
		||||
    [ drop t "mixin" set-word-prop ]
 | 
			
		||||
    2bi ;
 | 
			
		||||
    2tri ;
 | 
			
		||||
 | 
			
		||||
: if-mixin-member? ( class mixin true false -- )
 | 
			
		||||
    [ check-mixin-class 2dup members member-eq? ] 2dip if ; inline
 | 
			
		||||
| 
						 | 
				
			
			@ -80,12 +81,10 @@ M: mixin-class class-forgotten remove-mixin-instance ;
 | 
			
		|||
    dup mixin-class? [
 | 
			
		||||
        drop
 | 
			
		||||
    ] [
 | 
			
		||||
        {
 | 
			
		||||
        [ { } redefine-mixin-class ]
 | 
			
		||||
        [ H{ } clone "instances" set-word-prop ]
 | 
			
		||||
            [ changed-definition ]
 | 
			
		||||
        [ update-classes ]
 | 
			
		||||
        } cleave
 | 
			
		||||
        tri
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
! Definition protocol implementation ensures that removing an
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -223,7 +223,7 @@ M: tuple-class update-class
 | 
			
		|||
        2drop
 | 
			
		||||
        [
 | 
			
		||||
            [ update-tuples-after ]
 | 
			
		||||
            [ changed-definition ]
 | 
			
		||||
            [ changed-class ]
 | 
			
		||||
            bi
 | 
			
		||||
        ] each-subclass
 | 
			
		||||
    ]
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -32,7 +32,7 @@ PRIVATE>
 | 
			
		|||
 | 
			
		||||
: define-union-class ( class members -- )
 | 
			
		||||
    [ (define-union-class) ]
 | 
			
		||||
    [ drop changed-definition ]
 | 
			
		||||
    [ drop changed-class ]
 | 
			
		||||
    [ drop update-classes ]
 | 
			
		||||
    2tri ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -124,6 +124,7 @@ M: object bump-effect-counter* drop f ;
 | 
			
		|||
    dup new-definitions get first update
 | 
			
		||||
    dup new-definitions get second update
 | 
			
		||||
    dup changed-definitions get update
 | 
			
		||||
    dup changed-classes get update
 | 
			
		||||
    dup dup changed-vocabs update ;
 | 
			
		||||
 | 
			
		||||
: process-forgotten-definitions ( -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -164,6 +165,7 @@ PRIVATE>
 | 
			
		|||
: with-nested-compilation-unit ( quot -- )
 | 
			
		||||
    [
 | 
			
		||||
        H{ } clone changed-definitions set
 | 
			
		||||
        H{ } clone changed-classes set
 | 
			
		||||
        H{ } clone changed-effects set
 | 
			
		||||
        H{ } clone outdated-generics set
 | 
			
		||||
        H{ } clone outdated-tuples set
 | 
			
		||||
| 
						 | 
				
			
			@ -174,6 +176,7 @@ PRIVATE>
 | 
			
		|||
: with-compilation-unit ( quot -- )
 | 
			
		||||
    [
 | 
			
		||||
        H{ } clone changed-definitions set
 | 
			
		||||
        H{ } clone changed-classes set
 | 
			
		||||
        H{ } clone changed-effects set
 | 
			
		||||
        H{ } clone outdated-generics set
 | 
			
		||||
        H{ } clone forgotten-definitions set
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -15,6 +15,11 @@ SYMBOL: changed-definitions
 | 
			
		|||
: changed-definition ( defspec -- )
 | 
			
		||||
    dup changed-definitions get set-in-unit ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: changed-classes
 | 
			
		||||
 | 
			
		||||
: changed-class ( class -- )
 | 
			
		||||
    dup changed-classes get set-in-unit ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: changed-effects
 | 
			
		||||
 | 
			
		||||
SYMBOL: outdated-generics
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -104,6 +104,9 @@ GENERIC: update-generic ( class generic -- )
 | 
			
		|||
PREDICATE: method-body < word
 | 
			
		||||
    "method-generic" word-prop >boolean ;
 | 
			
		||||
 | 
			
		||||
M: method-body flushable?
 | 
			
		||||
    "method-generic" word-prop flushable? ;
 | 
			
		||||
 | 
			
		||||
M: method-body stack-effect
 | 
			
		||||
    "method-generic" word-prop stack-effect ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -182,6 +182,10 @@ M: parsing-word definer drop \ SYNTAX: \ ; ;
 | 
			
		|||
: deprecated? ( obj -- ? )
 | 
			
		||||
    dup word? [ "deprecated" word-prop ] [ drop f ] if ;
 | 
			
		||||
 | 
			
		||||
GENERIC: flushable? ( word -- ? )
 | 
			
		||||
 | 
			
		||||
M: word flushable? "flushable" word-prop ;
 | 
			
		||||
 | 
			
		||||
! Definition protocol
 | 
			
		||||
M: word where "loc" word-prop ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue