core: trim using lists with lint.vocabs tool

[factor.git] / core / classes / tuple / parser / parser.factor

diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor
index 1bc10677246595a4eff9ef511bf19f44a962115d..eedfe0cc0a725ecdcf4ed3feb457357028c0c85e 100644 (file)
--- a/core/classes/tuple/parser/parser.factor
+++ b/core/classes/tuple/parser/parser.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sets namespaces make sequences parser
-lexer combinators words classes.parser classes.tuple arrays
-slots math assocs parser.notes classes classes.algebra ;
+USING: accessors arrays assocs classes.parser classes.tuple
+combinators kernel lexer make parser parser.notes sequences sets
+slots ;
 IN: classes.tuple.parser
 
 : slot-names ( slots -- seq )
@@ -54,8 +54,7 @@ ERROR: invalid-slot-name name ;
 : 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 ] }
@@ -64,12 +63,16 @@ ERROR: invalid-slot-name name ;
     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 ;
 
 : check-slot-name ( class slots name -- name )
-    2dup swap slot-named* nip [ 2nip ] [ nip bad-slot-name ] if ;
+    2dup swap slot-named [ 2nip ] [ nip bad-slot-name ] if ;
 
 : parse-slot-value ( class slots -- )
     scan-token check-slot-name scan-object 2array , scan-token {
@@ -88,19 +91,19 @@ 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 ;