distributed module system w/ qualified + from syntax

extra/modules/authors.txt

@@ -0,0 +1 @@
+Sam Anklesaria

extra/modules/remote-loading/remote-loading.factor

@@ -0,0 +1,3 @@
+USING: modules.rpc-server vocabs ;
+IN: modules.remote-loading service
+: get-vocab ( vocabstr -- vocab ) vocab ;

extra/modules/rpc-server/rpc-server.factor

@@ -0,0 +1,24 @@
+USING: accessors assocs effects generalizations io
+io.encodings.binary io.servers.connection kernel modules.util
+namespaces parser sets sequences serialize threads vocabs
+vocabs.parser words tools.walker ;
+
+IN: modules.rpc-server
+
+SYMBOL: serving-vocabs V{ } clone serving-vocabs set-global
+
+: process ( vocabspec -- ) vocab-words [ deserialize-args ] dip deserialize
+   swap at [ execute ] keep stack-effect out>> length narray serialize flush ;
+
+: (serve) ( -- ) deserialize dup serving-vocabs get-global index
+   [ process ] [ f ] if ;
+
+: start-serving-vocabs ( -- ) [
+   <threaded-server> 5000 >>insecure binary >>encoding [ (serve) ] >>handler
+   start-server ] in-thread ;
+
+SYNTAX: service serving-vocabs get-global empty? [ start-serving-vocabs ] when
+   current-vocab serving-vocabs get-global adjoin
+   "get-words" create-in
+   in get [ vocab vocab-words [ stack-effect ] { } assoc-map-as ] curry
+   (( -- words )) define-inline ;

extra/modules/rpc/rpc-docs.factor

@@ -0,0 +1,9 @@
+USING: help.syntax help.markup ;
+IN: modules.rpc
+ARTICLE: { "modules" "protocol" } "RPC Protocol"
+{ $list
+   "Send vocab as string"
+   "Send arglist"
+   "Send word as string"
+   "Receive result list"
+} ;

extra/modules/rpc/rpc.factor

@@ -0,0 +1,26 @@
+USING: accessors compiler.units combinators fry generalizations io
+io.encodings.binary io.sockets kernel modules.util namespaces
+parser sequences serialize vocabs vocabs.parser words ;
+IN: modules.rpc
+
+DEFER: get-words
+
+: remote-quot ( addrspec vocabspec effect str -- quot )
+   '[ _ 5000 <inet> binary
+      [
+         _ serialize _ in>> length narray serialize _ serialize flush deserialize-args
+      ] with-client
+    ] ;
+
+: define-remote ( addrspec vocabspec effect str -- ) [
+      [ remote-quot ] 2keep create-in -rot define-declared
+   ] with-compilation-unit ;
+
+: with-in ( vocab quot -- vocab ) over
+   [ '[ _ set-in @ ] in get swap dip set-in ] dip vocab ; inline
+
+: remote-vocab ( addrspec vocabspec -- vocab )
+   dup "-remote" append [ 
+      [ (( -- words )) [ "get-words" remote-quot ] keep call-effect ] 2keep
+      [ rot first2 swap define-remote ] 2curry each
+   ] with-in ;

extra/modules/summary.txt

@@ -0,0 +1 @@
+Distributed module system + syntax

extra/modules/using/tests/test-server.factor

@@ -0,0 +1,3 @@
+USING: modules.rpc-server ;
+IN: modules.test-server service
+: rpc-hello ( -- str ) "hello world" ;

extra/modules/using/tests/tests.factor

@@ -0,0 +1,4 @@
+USING: modules.using ;
+IN: modules.using.tests
+USING: prettyprint localhost::modules.test-server ;
+rpc-hello .

extra/modules/using/using-docs.factor

@@ -0,0 +1,14 @@
+USING: modules.using modules.rpc-server help.syntax help.markup strings ;
+IN: modules
+
+HELP: service
+{ $syntax "IN: module service" }
+{ $description "Starts a server for requests for remote procedure calls." } ;
+
+ARTICLE: { "modules" "remote-loading" } "Using the remote-loading vocabulary"
+"If loaded, starts serving vocabularies, accessable through a " { $link POSTPONE: USING: } " form" ;
+
+HELP: USING:
+{ $syntax "USING: rpc-server::module fetch-sever::module { module qualified-name } { module => word ... } ... ;" }
+{ $description "Adds vocabularies to the front of the search path.  Vocabularies can be fetched remotely, if preceded by a valid hostname.  Name pairs facilitate imports like in the "
+{ $link POSTPONE: QUALIFIED: } " or " { $link POSTPONE: FROM: } " forms." } ;

extra/modules/using/using.factor

@@ -0,0 +1,36 @@
+USING: assocs kernel modules.remote-loading modules.rpc
+namespaces peg peg.ebnf peg-lexer sequences vocabs vocabs.parser
+strings ;
+IN: modules.using
+
+: >qualified ( vocab prefix -- assoc )
+    [ vocab-words ] [ 58 suffix ] bi* [ swap [ prepend ] dip ] curry assoc-map ;
+
+: >partial-vocab ( words assoc -- assoc )
+    [ dupd at [ no-word-error ] unless* ] curry { } map>assoc ;
+
+: remote-load ( addr vocabspec -- voab ) [ "modules.remote-loading" remote-vocab (use+) ] dip get-vocab ;
+
+: load'em ( vocab words/? -- ) [ swap >partial-vocab ] when* use get push ;
+
+EBNF: modulize
+tokenpart = (!(':').)+ => [[ >string ]]
+s = ':' => [[ drop ignore ]]
+rpc = tokenpart s s tokenpart => [[ first2 remote-vocab ]]
+remote = tokenpart s tokenpart => [[ first2 remote-load ]]
+plain = tokenpart => [[ load-vocab ]]
+module = rpc | remote | plain
+;EBNF
+
+ON-BNF: USING:
+tokenizer = <foreign factor>
+sym = !(";"|"}"|"=>").
+modspec = sym => [[ modulize ]]
+qualified = modspec sym => [[ first2 >qualified ]]
+unqualified = modspec => [[ vocab-words ]]
+words = ("=>" sym+ )? => [[ [ f ] [ second ] if-empty ]]
+long = "{" ( qualified | unqualified ) words "}" => [[ rest first2 load'em ignore ]]
+short = modspec => [[ use+ ignore ]]
+wordSpec = long | short
+using = wordSpec+ ";" => [[ drop ignore ]]
+;ON-BNF

extra/modules/util/util.factor

@@ -0,0 +1,4 @@
+USING: generalizations kernel namespaces sequences serialize ;
+IN: modules.util
+: deserialize-args ( -- ) deserialize dup length firstn ; inline
+: change-global ( var quot -- ) [ [ get-global ] keep ] dip dip set-global ; inline