modules compilation fixes
parent
f432ea8208
commit
a5e7b34f63
|
@ -1,3 +1,3 @@
|
|||
USING: modules.rpc-server vocabs ;
|
||||
IN: modules.remote-loading service
|
||||
IN: modules.remote-loading mem-service
|
||||
: get-vocab ( vocabstr -- vocab ) vocab ;
|
|
@ -1,24 +1,31 @@
|
|||
USING: accessors assocs effects generalizations io
|
||||
io.encodings.binary io.servers.connection kernel modules.util
|
||||
namespaces parser sets sequences serialize threads vocabs
|
||||
USING: accessors assocs continuations effects io
|
||||
io.encodings.binary io.servers.connection kernel
|
||||
memoize 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 ;
|
||||
: do-rpc ( args word -- results ) [ execute ] curry with-datastack ; inline
|
||||
|
||||
MEMO: mem-do-rpc ( args word -- results ) do-rpc ; inline
|
||||
|
||||
: process ( vocabspec -- ) vocab-words [ deserialize ] dip deserialize
|
||||
swap at "executer" get execute( args word -- results ) serialize flush ;
|
||||
|
||||
: (serve) ( -- ) deserialize dup serving-vocabs get-global index
|
||||
[ process ] [ f ] if ;
|
||||
[ process ] [ drop ] 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
|
||||
: (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 ;
|
||||
|
||||
SYNTAX: service \ do-rpc "executer" set (service) ;
|
||||
SYNTAX: mem-service \ mem-do-rpc "executer" set (service) ;
|
|
@ -1,5 +1,5 @@
|
|||
USING: accessors compiler.units combinators fry generalizations io
|
||||
io.encodings.binary io.sockets kernel modules.util namespaces
|
||||
io.encodings.binary io.sockets kernel namespaces
|
||||
parser sequences serialize vocabs vocabs.parser words ;
|
||||
IN: modules.rpc
|
||||
|
||||
|
@ -8,12 +8,12 @@ DEFER: get-words
|
|||
: remote-quot ( addrspec vocabspec effect str -- quot )
|
||||
'[ _ 5000 <inet> binary
|
||||
[
|
||||
_ serialize _ in>> length narray serialize _ serialize flush deserialize-args
|
||||
_ serialize _ in>> length narray serialize _ serialize flush deserialize dup length firstn
|
||||
] with-client
|
||||
] ;
|
||||
|
||||
: define-remote ( addrspec vocabspec effect str -- ) [
|
||||
[ remote-quot ] 2keep create-in -rot define-declared
|
||||
[ remote-quot ] 2keep create-in -rot define-declared word make-inline
|
||||
] with-compilation-unit ;
|
||||
|
||||
: with-in ( vocab quot -- vocab ) over
|
||||
|
|
|
@ -1,4 +0,0 @@
|
|||
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
|
|
@ -45,11 +45,11 @@ M: lex-hash at*
|
|||
: parse* ( parser -- ast )
|
||||
compile
|
||||
[ execute [ error-stack get first throw ] unless* ] with-global-lexer
|
||||
ast>> ;
|
||||
ast>> ; inline
|
||||
|
||||
: create-bnf ( name parser -- )
|
||||
reset-tokenizer [ lexer get skip-blank parse* dup ignore? [ drop ] [ parsed ] if ] curry
|
||||
define-syntax ;
|
||||
define-syntax word make-inline ;
|
||||
|
||||
SYNTAX: ON-BNF:
|
||||
CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf
|
||||
|
|
Loading…
Reference in New Issue