modules compilation fixes

db4
Sam Anklesaria 2009-04-26 18:56:24 -05:00
parent f432ea8208
commit a5e7b34f63
5 changed files with 21 additions and 18 deletions

View File

@ -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 ;

View File

@ -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 ;
(( -- words )) define-inline ;
SYNTAX: service \ do-rpc "executer" set (service) ;
SYNTAX: mem-service \ mem-do-rpc "executer" set (service) ;

View File

@ -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

View File

@ -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

View File

@ -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