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