Merge branch 'master' of git://factorcode.org/git/factor
						commit
						7aff7d6cb6
					
				| 
						 | 
				
			
			@ -174,6 +174,8 @@ M: no-method error.
 | 
			
		|||
 | 
			
		||||
M: bad-slot-value summary drop "Bad store to specialized slot" ;
 | 
			
		||||
 | 
			
		||||
M: bad-slot-name summary drop "Bad slot name in object literal" ;
 | 
			
		||||
 | 
			
		||||
M: no-math-method summary
 | 
			
		||||
    drop "No suitable arithmetic method" ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -179,35 +179,35 @@ STRUCT: T-class
 | 
			
		|||
            { offset 0 }
 | 
			
		||||
            { class integer }
 | 
			
		||||
            { initial 0 } 
 | 
			
		||||
            { c-type "int" }
 | 
			
		||||
            { type "int" }
 | 
			
		||||
        }
 | 
			
		||||
        T{ struct-slot-spec
 | 
			
		||||
            { name "x" }
 | 
			
		||||
            { offset 4 }
 | 
			
		||||
            { class object }
 | 
			
		||||
            { initial f } 
 | 
			
		||||
            { c-type { "char" 4 } }
 | 
			
		||||
            { type { "char" 4 } }
 | 
			
		||||
        }
 | 
			
		||||
        T{ struct-slot-spec
 | 
			
		||||
            { name "y" }
 | 
			
		||||
            { offset 8 }
 | 
			
		||||
            { class object }
 | 
			
		||||
            { initial f } 
 | 
			
		||||
            { c-type { "short" 2 } }
 | 
			
		||||
            { type { "short" 2 } }
 | 
			
		||||
        }
 | 
			
		||||
        T{ struct-slot-spec
 | 
			
		||||
            { name "z" }
 | 
			
		||||
            { offset 12 }
 | 
			
		||||
            { class fixnum }
 | 
			
		||||
            { initial 5 } 
 | 
			
		||||
            { c-type "char" }
 | 
			
		||||
            { type "char" }
 | 
			
		||||
        }
 | 
			
		||||
        T{ struct-slot-spec
 | 
			
		||||
            { name "float" }
 | 
			
		||||
            { offset 16 }
 | 
			
		||||
            { class object }
 | 
			
		||||
            { initial f } 
 | 
			
		||||
            { c-type { "float" 2 } }
 | 
			
		||||
            { type { "float" 2 } }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
] [ a-struct struct-slots ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -99,9 +99,17 @@ GENERIC# boa>object 1 ( class slots -- tuple )
 | 
			
		|||
M: tuple-class boa>object
 | 
			
		||||
    swap prefix >tuple ;
 | 
			
		||||
 | 
			
		||||
ERROR: bad-slot-name class slot ;
 | 
			
		||||
 | 
			
		||||
: check-slot-exists ( class initials slot-spec/f index/f name -- class initials slot-spec index )
 | 
			
		||||
    over [ drop ] [ nip nip nip bad-slot-name ] if ;
 | 
			
		||||
 | 
			
		||||
: slot-named-checked ( class initials name slots -- class initials slot-spec )
 | 
			
		||||
    over [ slot-named* ] dip check-slot-exists drop ;
 | 
			
		||||
 | 
			
		||||
: assoc>object ( class slots values -- tuple )
 | 
			
		||||
    [ [ [ initial>> ] map ] keep ] dip
 | 
			
		||||
    swap [ [ slot-named* drop ] curry dip ] curry assoc-map
 | 
			
		||||
    swap [ [ slot-named-checked ] curry dip ] curry assoc-map
 | 
			
		||||
    [ dup <enum> ] dip update boa>object ;
 | 
			
		||||
 | 
			
		||||
: parse-tuple-literal-slots ( class slots -- tuple )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue