! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes.parser classes.tuple
-combinators kernel lexer make parser parser.notes sequences
-sets slots ;
+combinators kernel lexer make parser parser.notes sequences sets
+slots ;
IN: classes.tuple.parser
: slot-names ( slots -- seq )
: parse-tuple-slots ( -- )
";" parse-tuple-slots-delim ;
-: parse-tuple-definition ( -- class superclass slots )
- scan-new-class
+: (parse-tuple-definition) ( word -- class superclass slots )
scan-token {
{ ";" [ tuple f ] }
{ "<" [ scan-word [ parse-tuple-slots ] { } make ] }
dup check-duplicate-slots
3dup check-slot-shadowing ;
+: parse-tuple-definition ( -- class superclass slots )
+ scan-new-class (parse-tuple-definition) ;
+
+
ERROR: bad-literal-tuple ;
ERROR: bad-slot-name class slot ;
: parse-slot-values ( class slots -- values )
[ (parse-slot-values) ] { } make ;
-GENERIC# boa>object 1 ( class slots -- tuple )
+GENERIC#: boa>object 1 ( class slots -- tuple )
M: tuple-class boa>object
- swap prefix >tuple ;
+ swap slots>tuple ;
: 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 ;
+ over [ drop ] [ 3nip 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 <enum> ] keep ] dip
+ [ [ [ initial>> ] map <enumerated> ] keep ] dip
swap [ [ slot-named-checked ] curry dip ] curry assoc-map
assoc-union! seq>> boa>object ;