]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/io/servers/servers.factor
factor: trim using lists
[factor.git] / basis / io / servers / servers.factor
old mode 100755 (executable)
new mode 100644 (file)
index af1923d..8aa2f7f
@@ -1,12 +1,10 @@
 ! Copyright (C) 2003, 2010 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar combinators
-combinators.short-circuit concurrency.combinators
-concurrency.count-downs concurrency.flags
-concurrency.semaphores continuations debugger destructors fry
-io io.sockets io.sockets.secure io.streams.duplex io.styles
-io.timeouts kernel logging make math math.parser namespaces
-present prettyprint random sequences sets strings threads ;
+USING: accessors arrays calendar concurrency.flags
+concurrency.semaphores continuations destructors io io.sockets
+io.sockets.secure io.streams.duplex io.styles io.timeouts kernel
+logging make math namespaces present prettyprint random
+sequences sets strings threads ;
 IN: io.servers
 
 TUPLE: threaded-server < identity-tuple
@@ -33,19 +31,11 @@ ERROR: server-already-running threaded-server ;
 
 <PRIVATE
 
-: must-be-running ( threaded-server -- threaded-server )
-    dup running-servers get in? [ server-not-running ] unless ;
+: add-running-server ( threaded-server running-servers -- )
+    dupd ?adjoin [ drop ] [ server-already-running ] if ;
 
-: must-not-be-running ( threaded-server -- threaded-server )
-    dup running-servers get in? [ server-already-running ] when ;
-
-: add-running-server ( threaded-server -- )
-    must-not-be-running
-    running-servers get adjoin ;
-
-: remove-running-server ( threaded-server -- )
-    must-be-running
-    running-servers get delete ;
+: remove-running-server ( threaded-server running-servers -- )
+    dupd ?delete [ drop ] [ server-not-running ] if ;
 
 PRIVATE>
 
@@ -77,7 +67,7 @@ M: inet6 >insecure 1array ;
 M: local >insecure 1array ;
 M: integer >insecure internet-server 1array ;
 M: string >insecure internet-server 1array ;
-M: array >insecure [ >insecure ] map ;
+M: array >insecure [ >insecure ] map concat ;
 M: f >insecure ;
 
 : >secure ( addrspec -- addrspec' )
@@ -101,7 +91,7 @@ M: f >insecure ;
 
 : log-connection ( remote local -- )
     [ accepted-connection ]
-    [ [ remote-address set ] [ local-address set ] bi* ]
+    [ [ remote-address namespaces:set ] [ local-address namespaces:set ] bi* ]
     2bi ;
 
 M: threaded-server handle-client* handler>> call( -- ) ;
@@ -181,7 +171,7 @@ PRIVATE>
             [ ] [ name>> ] bi
             [
                 set-servers
-                dup add-running-server
+                dup running-servers get add-running-server
                 dup servers>>
                 [
                     [ '[ _ _ [ start-accept-loop ] with-disposal ] ]
@@ -196,7 +186,7 @@ PRIVATE>
 
 : stop-server ( threaded-server -- )
     dup server-running? [
-        [ remove-running-server ]
+        [ running-servers get remove-running-server ]
         [
             [
                 [ secure-context>> [ &dispose drop ] when* ]
@@ -219,7 +209,7 @@ PRIVATE>
     '[
         [ _ threaded-server _ with-variable ]
         [ _ stop-server ]
-        [ ] cleanup
+        finally
     ] call ; inline
 
 <PRIVATE