steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-09-16 16:08:51 -07:00
parent 20611abe7f 18608cb4bb
commit 7aff7d6cb6
3 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/debugger/debugger.factor
View File

@ -174,6 +174,8 @@ M: no-method error.
M: bad-slot-value summary drop "Bad store to specialized slot" ; 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 M: no-math-method summary
drop "No suitable arithmetic method" ; drop "No suitable arithmetic method" ;

10
basis/functors/functors-tests.factor
View File

@ -179,35 +179,35 @@ STRUCT: T-class
{ offset 0 } { offset 0 }
{ class integer } { class integer }
{ initial 0 } { initial 0 }
{ c-type "int" } { type "int" }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "x" } { name "x" }
{ offset 4 } { offset 4 }
{ class object } { class object }
{ initial f } { initial f }
{ c-type { "char" 4 } } { type { "char" 4 } }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "y" } { name "y" }
{ offset 8 } { offset 8 }
{ class object } { class object }
{ initial f } { initial f }
{ c-type { "short" 2 } } { type { "short" 2 } }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "z" } { name "z" }
{ offset 12 } { offset 12 }
{ class fixnum } { class fixnum }
{ initial 5 } { initial 5 }
{ c-type "char" } { type "char" }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "float" } { name "float" }
{ offset 16 } { offset 16 }
{ class object } { class object }
{ initial f } { initial f }
{ c-type { "float" 2 } } { type { "float" 2 } }
} }
} }
] [ a-struct struct-slots ] unit-test ] [ a-struct struct-slots ] unit-test

10
core/classes/tuple/parser/parser.factor
View File

@ -99,9 +99,17 @@ GENERIC# boa>object 1 ( class slots -- tuple )
M: tuple-class boa>object M: tuple-class boa>object
swap prefix >tuple ; 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 ) : assoc>object ( class slots values -- tuple )
[ [ [ initial>> ] map ] keep ] dip [ [ [ 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 ; [ dup <enum> ] dip update boa>object ;
: parse-tuple-literal-slots ( class slots -- tuple ) : parse-tuple-literal-slots ( class slots -- tuple )