Remove "compiled-status" word prop and simplify associated machinery
							parent
							
								
									b1d0066baa
								
							
						
					
					
						commit
						a9b4a724a4
					
				| 
						 | 
				
			
			@ -28,23 +28,14 @@ SYMBOL: compiled
 | 
			
		|||
: maybe-compile ( word -- )
 | 
			
		||||
    dup optimized>> [ drop ] [ queue-compile ] if ;
 | 
			
		||||
 | 
			
		||||
SYMBOLS: +optimized+ +unoptimized+ ;
 | 
			
		||||
: recompile-callers? ( word -- ? )
 | 
			
		||||
    changed-effects get key? ;
 | 
			
		||||
 | 
			
		||||
: ripple-up ( words -- )
 | 
			
		||||
    dup "compiled-status" word-prop +unoptimized+ eq?
 | 
			
		||||
    [ usage [ word? ] filter ] [ compiled-usage keys ] if
 | 
			
		||||
    [ queue-compile ] each ;
 | 
			
		||||
 | 
			
		||||
: ripple-up? ( status word -- ? )
 | 
			
		||||
    [
 | 
			
		||||
        [ nip changed-effects get key? ]
 | 
			
		||||
        [ "compiled-status" word-prop eq? not ] 2bi or
 | 
			
		||||
    ] keep "compiled-status" word-prop and ;
 | 
			
		||||
 | 
			
		||||
: save-compiled-status ( word status -- )
 | 
			
		||||
    [ over ripple-up? [ ripple-up ] [ drop ] if ]
 | 
			
		||||
    [ "compiled-status" set-word-prop ]
 | 
			
		||||
    2bi ;
 | 
			
		||||
: recompile-callers ( words -- )
 | 
			
		||||
    dup recompile-callers? [
 | 
			
		||||
        [ usage [ word? ] filter ] [ compiled-usage keys ] bi
 | 
			
		||||
        [ [ queue-compile ] each ] bi@
 | 
			
		||||
    ] [ drop ] if ;
 | 
			
		||||
 | 
			
		||||
: start ( word -- )
 | 
			
		||||
    "trace-compilation" get [ dup name>> print flush ] when
 | 
			
		||||
| 
						 | 
				
			
			@ -55,20 +46,19 @@ SYMBOLS: +optimized+ +unoptimized+ ;
 | 
			
		|||
: ignore-error? ( word error -- ? )
 | 
			
		||||
    [
 | 
			
		||||
        {
 | 
			
		||||
            [ inline? ]
 | 
			
		||||
            [ macro? ]
 | 
			
		||||
            [ "no-compile" word-prop ]
 | 
			
		||||
            [ inline? ]
 | 
			
		||||
            [ "special" word-prop ]
 | 
			
		||||
            [ "no-compile" word-prop ]
 | 
			
		||||
        } 1||
 | 
			
		||||
    ] [ error-type +compiler-warning+ eq? ] bi* and ;
 | 
			
		||||
 | 
			
		||||
: (fail) ( word compiled -- * )
 | 
			
		||||
    swap
 | 
			
		||||
    [ recompile-callers ]
 | 
			
		||||
    [ compiled-unxref ]
 | 
			
		||||
    [ compiled get set-at ]
 | 
			
		||||
    [ +unoptimized+ save-compiled-status ]
 | 
			
		||||
    tri
 | 
			
		||||
    return ;
 | 
			
		||||
    tri return ;
 | 
			
		||||
 | 
			
		||||
: not-compiled-def ( word error -- def )
 | 
			
		||||
    '[ _ _ not-compiled ] [ ] like ;
 | 
			
		||||
| 
						 | 
				
			
			@ -106,11 +96,10 @@ t compile-dependencies? set-global
 | 
			
		|||
    ] each ;
 | 
			
		||||
 | 
			
		||||
: finish ( word -- )
 | 
			
		||||
    [ +optimized+ save-compiled-status ]
 | 
			
		||||
    [ recompile-callers ]
 | 
			
		||||
    [ compiled-unxref ]
 | 
			
		||||
    [
 | 
			
		||||
        dup crossref?
 | 
			
		||||
        [
 | 
			
		||||
        dup crossref? [
 | 
			
		||||
            dependencies get
 | 
			
		||||
            generic-dependencies get
 | 
			
		||||
            compiled-xref
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -12,10 +12,11 @@ IN: macros
 | 
			
		|||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: define-macro ( word definition effect -- )
 | 
			
		||||
    real-macro-effect
 | 
			
		||||
    real-macro-effect {
 | 
			
		||||
        [ [ memoize-quot [ call ] append ] keep define-declared ]
 | 
			
		||||
        [ drop "macro" set-word-prop ]
 | 
			
		||||
    3bi ;
 | 
			
		||||
        [ 2drop changed-effect ]
 | 
			
		||||
    } 3cleave ;
 | 
			
		||||
 | 
			
		||||
SYNTAX: MACRO: (:) define-macro ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -99,7 +99,6 @@ IN: tools.deploy.shaker
 | 
			
		|||
                "boa-check"
 | 
			
		||||
                "coercer"
 | 
			
		||||
                "combination"
 | 
			
		||||
                "compiled-status"
 | 
			
		||||
                "compiled-generic-uses"
 | 
			
		||||
                "compiled-uses"
 | 
			
		||||
                "constraints"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -19,9 +19,6 @@ SYMBOL: changed-definitions
 | 
			
		|||
 | 
			
		||||
SYMBOL: changed-effects
 | 
			
		||||
 | 
			
		||||
: changed-effect ( word -- )
 | 
			
		||||
    dup changed-effects get set-in-unit ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: changed-generics
 | 
			
		||||
 | 
			
		||||
SYMBOL: outdated-generics
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -138,12 +138,15 @@ M: word subwords drop f ;
 | 
			
		|||
    >>def
 | 
			
		||||
    dup crossref? [ dup xref ] when drop ;
 | 
			
		||||
 | 
			
		||||
: changed-effect ( word -- )
 | 
			
		||||
    [ dup changed-effects get set-in-unit ]
 | 
			
		||||
    [ dup primitive? [ drop ] [ changed-definition ] if ] bi ;
 | 
			
		||||
 | 
			
		||||
: set-stack-effect ( effect word -- )
 | 
			
		||||
    2dup "declared-effect" word-prop = [ 2drop ] [
 | 
			
		||||
        swap
 | 
			
		||||
        [ drop changed-effect ]
 | 
			
		||||
        [ "declared-effect" set-word-prop ]
 | 
			
		||||
        [ drop dup primitive? [ drop ] [ changed-definition ] if ]
 | 
			
		||||
        [ nip changed-effect ]
 | 
			
		||||
        [ nip subwords [ changed-effect ] each ]
 | 
			
		||||
        [ swap "declared-effect" set-word-prop ]
 | 
			
		||||
        2tri
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -151,7 +154,11 @@ M: word subwords drop f ;
 | 
			
		|||
    [ nip swap set-stack-effect ] [ drop define ] 3bi ;
 | 
			
		||||
 | 
			
		||||
: make-inline ( word -- )
 | 
			
		||||
    t "inline" set-word-prop ;
 | 
			
		||||
    dup inline? [ drop ] [
 | 
			
		||||
        [ t "inline" set-word-prop ]
 | 
			
		||||
        [ changed-effect ]
 | 
			
		||||
        bi
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: make-recursive ( word -- )
 | 
			
		||||
    t "recursive" set-word-prop ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue