instance? optimizes null checks
							parent
							
								
									24ad579631
								
							
						
					
					
						commit
						750a96935f
					
				| 
						 | 
				
			
			@ -976,3 +976,21 @@ M: tuple-with-read-only-slot clone
 | 
			
		|||
    ! Should actually be 0 23 2^ 1 - [a,b]
 | 
			
		||||
    [ string-nth ] final-info first interval>> 0 23 2^ [a,b] =
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Optimization on instance?
 | 
			
		||||
[ f ] [ [ { number } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
 | 
			
		||||
 | 
			
		||||
UNION: ?fixnum fixnum POSTPONE: f ;
 | 
			
		||||
[ t ] [ [ { ?fixnum } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
 | 
			
		||||
[ t ] [ [ { fixnum } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
 | 
			
		||||
 | 
			
		||||
! Actually check to make sure that the generated code works properly
 | 
			
		||||
: instance-test-1 ( x -- ? ) { ?fixnum } declare fixnum instance? ;
 | 
			
		||||
: instance-test-2 ( x -- ? ) { number } declare fixnum instance? ;
 | 
			
		||||
: instance-test-3 ( x -- ? ) { POSTPONE: f } declare \ f instance? ;
 | 
			
		||||
 | 
			
		||||
[ t ] [ 1 instance-test-1 ] unit-test
 | 
			
		||||
[ f ] [ f instance-test-1 ] unit-test
 | 
			
		||||
[ t ] [ 1 instance-test-2 ] unit-test
 | 
			
		||||
[ f ] [ 1.1 instance-test-2 ] unit-test
 | 
			
		||||
[ t ] [ f instance-test-3 ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -141,6 +141,19 @@ IN: compiler.tree.propagation.transforms
 | 
			
		|||
    } case
 | 
			
		||||
] "custom-inlining" set-word-prop
 | 
			
		||||
 | 
			
		||||
:: inline-instance ( node -- quot/f )
 | 
			
		||||
    node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj klass )
 | 
			
		||||
    klass class? [
 | 
			
		||||
        {
 | 
			
		||||
            [ klass \ f = not ]
 | 
			
		||||
            [ obj class>> \ f class-not class-and klass class<= ]
 | 
			
		||||
        } 0&&
 | 
			
		||||
        [ [ drop >boolean ] ]
 | 
			
		||||
        [ klass "predicate" word-prop '[ drop @ ] ] if
 | 
			
		||||
    ] [ f ] if ;
 | 
			
		||||
 | 
			
		||||
\ instance? [ inline-instance ] "custom-inlining" set-word-prop
 | 
			
		||||
 | 
			
		||||
ERROR: bad-partial-eval quot word ;
 | 
			
		||||
 | 
			
		||||
: check-effect ( quot word -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -173,11 +186,6 @@ ERROR: bad-partial-eval quot word ;
 | 
			
		|||
 | 
			
		||||
\ new [ inline-new ] 1 define-partial-eval
 | 
			
		||||
 | 
			
		||||
\ instance? [
 | 
			
		||||
    dup class?
 | 
			
		||||
    [ "predicate" word-prop ] [ drop f ] if
 | 
			
		||||
] 1 define-partial-eval
 | 
			
		||||
 | 
			
		||||
! Shuffling
 | 
			
		||||
: nths-quot ( indices -- quot )
 | 
			
		||||
    [ [ '[ _ swap nth ] ] map ] [ length ] bi
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue