factor: trim using lists

[factor.git] / basis / cocoa / subclassing / subclassing.factor

diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index 3b88a8868c071fab8c487afa19f43f02e8bf960b..ad735cb98dace4ade593d678de3647febe219a14 100644 (file)
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -1,11 +1,9 @@
 ! Copyright (C) 2006, 2010 Slava Pestov, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.parser alien.strings arrays
-assocs combinators compiler hashtables kernel lexer libc
-locals.parser locals.types math namespaces parser sequences
-words cocoa.messages cocoa.runtime locals compiler.units
-io.encodings.utf8 continuations make fry effects stack-checker
-stack-checker.errors ;
+USING: accessors alien alien.parser alien.strings arrays assocs
+cocoa.messages cocoa.runtime combinators compiler.units fry
+io.encodings.utf8 kernel lexer locals.parser locals.types
+make namespaces parser sequences words ;
 IN: cocoa.subclassing
 
 : init-method ( method -- sel imp types )
@@ -43,12 +41,12 @@ IN: cocoa.subclassing
 : prepare-method ( ret types quot -- type imp )
     [ [ encode-types ] 2keep ] dip
     '[ _ _ cdecl _ alien-callback ]
-    (( -- callback )) define-temp ;
+    ( -- callback ) define-temp ;
 
 : prepare-methods ( methods -- methods )
     [
         [ first4 prepare-method 3array ] map
-    ] with-compilation-unit ;
+    ] with-nested-compilation-unit ;
 
 :: (redefine-objc-method) ( class method -- )
     method init-method :> ( sel imp types )
@@ -58,7 +56,7 @@ IN: cocoa.subclassing
     ] [
         class sel imp types add-method
     ] if* ;
-    
+
 : redefine-objc-methods ( methods name -- )
     dup class-exists? [
         objc_getClass '[ [ _ ] dip (redefine-objc-method) ] each
@@ -66,16 +64,24 @@ IN: cocoa.subclassing
 
 :: define-objc-class ( name superclass protocols methods -- )
     methods prepare-methods :> methods
-    name "cocoa.classes" create drop
+    name "cocoa.classes" create-word drop
     methods name redefine-objc-methods
     name [ methods protocols superclass name (define-objc-class) ] import-objc-class ;
 
-SYNTAX: CLASS:
+TUPLE: cocoa-protocol name ;
+C: <cocoa-protocol> cocoa-protocol
+
+SYNTAX: COCOA-PROTOCOL:
+    scan-token <cocoa-protocol> suffix! ;
+
+SYMBOL: ;CLASS>
+
+SYNTAX: <CLASS:
     scan-token
     "<" expect
     scan-token
-    "[" parse-tokens
-    \ ] parse-until define-objc-class ;
+    \ ;CLASS> parse-until [ cocoa-protocol? ] partition
+    [ [ name>> ] map ] dip define-objc-class ;
 
 : (parse-selector) ( -- )
     scan-token {
@@ -92,11 +98,11 @@ SYNTAX: CLASS:
     [ sift { "self" "selector" } prepend ] tri* ;
 
 : parse-method-body ( names -- quot )
-    [ [ make-local ] map ] H{ } make-assoc
+    [ [ make-local ] map ] H{ } make
     (parse-lambda) <lambda> ?rewrite-closures first ;
 
 SYNTAX: METHOD:
     scan-c-type
     parse-selector
-    parse-method-body [ swap ] 2dip 4array
+    parse-method-body [ swap ] 2dip 4array ";" expect
     suffix! ;