tools.test: Make the flag public. Finish porting tester changes to fuzzer.

[factor.git] / unmaintained / modules / rpc-server / rpc-server.factor

diff --git a/unmaintained/modules/rpc-server/rpc-server.factor b/unmaintained/modules/rpc-server/rpc-server.factor
index d8181703720f141478641d32aab0e8be88b97a76..d82f13f7153518fd13ffae404f18ff7ea8b7983f 100644 (file)
--- a/unmaintained/modules/rpc-server/rpc-server.factor
+++ b/unmaintained/modules/rpc-server/rpc-server.factor
@@ -1,37 +1,31 @@
-USING: accessors assocs continuations effects io
-io.encodings.binary io.servers.connection kernel
-memoize namespaces parser sets sequences serialize
-threads vocabs vocabs.parser words ;
-
+! Copyright (C) 2009 Sam Anklesaria.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs combinators continuations effects
+io.encodings.binary io.servers.connection kernel namespaces
+sequences serialize sets threads vocabs vocabs.parser init io ;
 IN: modules.rpc-server
 
-SYMBOL: serving-vocabs V{ } clone serving-vocabs set-global
-
-: do-rpc ( args word -- bytes )
-   [ execute ] curry with-datastack object>bytes ; inline
-
-MEMO: mem-do-rpc ( args word -- bytes ) do-rpc ; inline
-
-: process ( vocabspec -- ) vocab-words [ deserialize ] dip deserialize
-   swap at "executer" get execute( args word -- bytes ) write flush ;
-
-: (serve) ( -- ) deserialize dup serving-vocabs get-global index
-   [ process ] [ drop ] if ;
-
-: start-serving-vocabs ( -- ) [
-   <threaded-server> 5000 >>insecure binary >>encoding [ (serve) ] >>handler
-   start-server ] in-thread ;
-
-: (service) ( -- ) serving-vocabs get-global empty? [ start-serving-vocabs ] when
-   current-vocab serving-vocabs get-global adjoin
-   "get-words" create-in
-   current-vocab name>> [ vocab vocab-words [ stack-effect ] { } assoc-map-as ] curry
-   (( -- words )) define-inline ;
-
-SYNTAX: service \ do-rpc  "executer" set (service) ;
-SYNTAX: mem-service \ mem-do-rpc "executer" set (service) ;
-
-load-vocab-hook [
-   [ dup words>> values
-   \ mem-do-rpc "memoize" word-prop [ delete-at ] curry each ]
-append ] change-global
\ No newline at end of file
+<PRIVATE
+TUPLE: rpc-request args vocabspec wordname ;
+SYMBOL: serving-vocabs serving-vocabs [ V{ } clone ] initialize
+
+: getter ( -- ) deserialize dup serving-vocabs get-global index
+        [ vocab-words [ stack-effect ] { } assoc-map-as ]
+        [ \ no-vocab boa ] if serialize flush ;
+
+: doer ( -- ) deserialize dup vocabspec>> serving-vocabs get-global index
+        [ [ args>> ] [ wordname>> ] [ vocabspec>> vocab-words ] tri at [ execute ] curry with-datastack ]
+        [ vocabspec>> \ no-vocab boa ] if serialize flush ;
+
+PRIVATE>
+SYNTAX: service current-vocab name>> serving-vocabs get-global adjoin ;
+
+: start-rpc-server ( -- )
+    binary <threaded-server>
+    "rpcs" >>name 9012 >>insecure
+    [ deserialize {
+      { "getter" [ getter ] }
+      {  "doer" [ doer ] }
+      { "loader" [ deserialize vocab serialize flush ] } 
+    } case ] >>handler
+    start-server ;