Improving method inlining change, but there's still a bug
							parent
							
								
									19a44d65df
								
							
						
					
					
						commit
						f1d7a4e663
					
				| 
						 | 
				
			
			@ -47,36 +47,29 @@ M: callable splicing-nodes splicing-body ;
 | 
			
		|||
        ] if
 | 
			
		||||
    ] [ 2drop undo-inlining ] if ;
 | 
			
		||||
 | 
			
		||||
ERROR: bad-splitting class generic ;
 | 
			
		||||
 | 
			
		||||
:: split-code ( class generic -- quot/f )
 | 
			
		||||
    class generic method-for-class :> method
 | 
			
		||||
    method [
 | 
			
		||||
    class generic method-for-class
 | 
			
		||||
    [ class generic bad-splitting ] unless
 | 
			
		||||
    [
 | 
			
		||||
        dup class instance?
 | 
			
		||||
        [ method execute ]
 | 
			
		||||
        [ generic execute ]
 | 
			
		||||
        [ generic no-method ] if
 | 
			
		||||
    ] and ;
 | 
			
		||||
    ] ;
 | 
			
		||||
 | 
			
		||||
: class-min ( class1 class2 -- class/f ? )
 | 
			
		||||
    2dup class<= [ drop t ] [
 | 
			
		||||
        2dup swap class<=
 | 
			
		||||
        [ nip t ] [ 2drop f f ] if
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
:: find-method-call ( class generic -- subclass/f ? )
 | 
			
		||||
    object generic method-classes 
 | 
			
		||||
    [| last-class new-class |
 | 
			
		||||
:: find-method-call ( class generic -- subclass/f )
 | 
			
		||||
    generic method-classes [ f ] [
 | 
			
		||||
        f swap [| last-class new-class |
 | 
			
		||||
            class new-class classes-intersect? [
 | 
			
		||||
            class new-class class<=
 | 
			
		||||
            [ object f ] [
 | 
			
		||||
                last-class new-class class-min
 | 
			
		||||
            ] if
 | 
			
		||||
                last-class [ f f ] [ new-class t ] if
 | 
			
		||||
            ] [ last-class t ] if
 | 
			
		||||
    ] all? ;
 | 
			
		||||
        ] all? swap and
 | 
			
		||||
    ] if-empty ;
 | 
			
		||||
 | 
			
		||||
:: split-method-call ( class generic -- quot/f )
 | 
			
		||||
    class object = [ f ] [
 | 
			
		||||
    class generic find-method-call
 | 
			
		||||
        [ generic split-code ] [ drop f ] if
 | 
			
		||||
    ] if ;
 | 
			
		||||
    [ generic split-code ] [ f ] if* ;
 | 
			
		||||
 | 
			
		||||
: inlining-standard-method ( #call word -- class/f method/f )
 | 
			
		||||
    dup "methods" word-prop assoc-empty? [ 2drop f f ] [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -142,14 +142,18 @@ IN: compiler.tree.propagation.transforms
 | 
			
		|||
] "custom-inlining" set-word-prop
 | 
			
		||||
 | 
			
		||||
:: inline-instance ( node -- quot/f )
 | 
			
		||||
    node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj klass )
 | 
			
		||||
    klass class? [
 | 
			
		||||
    node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj class )
 | 
			
		||||
    class class? [
 | 
			
		||||
        {
 | 
			
		||||
            [ klass \ f = not ]
 | 
			
		||||
            [ obj class>> \ f class-not class-and klass class<= ]
 | 
			
		||||
        } 0&&
 | 
			
		||||
        [ [ drop >boolean ] ]
 | 
			
		||||
        [ klass "predicate" word-prop '[ drop @ ] ] if
 | 
			
		||||
            [ class \ f = not ]
 | 
			
		||||
            [ obj class>> \ f class-not class-and class class<= ]
 | 
			
		||||
        } 0&& [
 | 
			
		||||
            ! TODO: replace this with an implicit null check when
 | 
			
		||||
            ! profitable, once Factor gets OSR implemented
 | 
			
		||||
            [ drop >boolean ]
 | 
			
		||||
        ] [
 | 
			
		||||
            class "predicate" word-prop '[ drop @ ]
 | 
			
		||||
        ] if
 | 
			
		||||
    ] [ f ] if ;
 | 
			
		||||
 | 
			
		||||
\ instance? [ inline-instance ] "custom-inlining" set-word-prop
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue