Merge branch 'master' of git://factorcode.org/git/factor

db4
Sam Anklesaria 2009-08-03 20:09:05 -05:00
commit 1145f49a47
13 changed files with 230 additions and 128 deletions

View File

@ -1,38 +1,42 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors compiler.cfg.builder compiler.cfg.linear-scan USING: accessors kernel make sequences tools.annotations tools.crossref ;
compiler.cfg.liveness compiler.cfg.mr compiler.cfg.optimizer QUALIFIED: compiler.cfg.builder
compiler.cfg.stacks.finalize compiler.cfg.stacks.global QUALIFIED: compiler.cfg.linear-scan
compiler.codegen compiler.tree.builder compiler.tree.optimizer QUALIFIED: compiler.cfg.mr
kernel make sequences tools.annotations tools.crossref ; QUALIFIED: compiler.cfg.optimizer
QUALIFIED: compiler.cfg.stacks.finalize
QUALIFIED: compiler.cfg.stacks.global
QUALIFIED: compiler.codegen
QUALIFIED: compiler.tree.builder
QUALIFIED: compiler.tree.optimizer
IN: bootstrap.compiler.timing IN: bootstrap.compiler.timing
: passes ( word -- seq ) : passes ( word -- seq )
def>> uses [ vocabulary>> "compiler." head? ] filter ; def>> uses [ vocabulary>> "compiler." head? ] filter ;
: high-level-passes ( -- seq ) \ optimize-tree passes ; : high-level-passes ( -- seq ) \ compiler.tree.optimizer:optimize-tree passes ;
: low-level-passes ( -- seq ) \ optimize-cfg passes ; : low-level-passes ( -- seq ) \ compiler.cfg.optimizer:optimize-cfg passes ;
: machine-passes ( -- seq ) \ build-mr passes ; : machine-passes ( -- seq ) \ compiler.cfg.mr:build-mr passes ;
: linear-scan-passes ( -- seq ) \ (linear-scan) passes ; : linear-scan-passes ( -- seq ) \ compiler.cfg.linear-scan:(linear-scan) passes ;
: all-passes ( -- seq ) : all-passes ( -- seq )
[ [
\ build-tree , \ compiler.tree.builder:build-tree ,
\ optimize-tree , \ compiler.tree.optimizer:optimize-tree ,
high-level-passes % high-level-passes %
\ build-cfg , \ compiler.cfg.builder:build-cfg ,
\ compute-global-sets , \ compiler.cfg.stacks.global:compute-global-sets ,
\ finalize-stack-shuffling , \ compiler.cfg.stacks.finalize:finalize-stack-shuffling ,
\ optimize-cfg , \ compiler.cfg.optimizer:optimize-cfg ,
low-level-passes % low-level-passes %
\ compute-live-sets , \ compiler.cfg.mr:build-mr ,
\ build-mr ,
machine-passes % machine-passes %
linear-scan-passes % linear-scan-passes %
\ generate , \ compiler.codegen:generate ,
] { } make ; ] { } make ;
all-passes [ [ reset ] [ add-timing ] bi ] each all-passes [ [ reset ] [ add-timing ] bi ] each

View File

@ -1,37 +0,0 @@
USING: accessors assocs compiler.cfg
compiler.cfg.critical-edges compiler.cfg.debugger
compiler.cfg.instructions compiler.cfg.predecessors
compiler.cfg.registers cpu.architecture kernel namespaces
sequences tools.test compiler.cfg.utilities ;
IN: compiler.cfg.critical-edges.tests
! Make sure we update phi nodes when splitting critical edges
: test-critical-edges ( -- )
cfg new 0 get >>entry
compute-predecessors
split-critical-edges ;
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 0 test-bb
V{
T{ ##peek f V int-regs 1 D 1 }
T{ ##branch }
} 1 test-bb
V{
T{ ##phi f V int-regs 2 H{ { 0 V int-regs 0 } { 1 V int-regs 1 } } }
T{ ##return }
} 2 test-bb
0 { 1 2 } edges
1 2 edge
[ ] [ test-critical-edges ] unit-test
[ t ] [ 0 get successors>> second successors>> first 2 get eq? ] unit-test
[ V int-regs 0 ] [ 2 get instructions>> first inputs>> 0 get successors>> second swap at ] unit-test

View File

@ -1,29 +0,0 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math accessors sequences locals assocs fry
compiler.cfg compiler.cfg.rpo compiler.cfg.utilities ;
IN: compiler.cfg.critical-edges
: critical-edge? ( from to -- ? )
[ successors>> length 1 > ] [ predecessors>> length 1 > ] bi* and ;
: new-key ( new-key old-key assoc -- )
[ delete-at* ] keep '[ swap _ set-at ] [ 2drop ] if ;
:: update-phis ( from to bb -- )
! Any phi nodes in 'to' which reference 'from'
! should now reference 'bb'.
to [ [ bb from ] dip inputs>> new-key ] each-phi ;
: split-critical-edge ( from to -- )
f <simple-block> [ insert-basic-block ] [ update-phis ] 3bi ;
: split-critical-edges ( cfg -- )
dup [
dup successors>> [
2dup critical-edge?
[ split-critical-edge ] [ 2drop ] if
] with each
] each-basic-block
cfg-changed
drop ;

View File

@ -33,18 +33,6 @@ HELP: new-action
HELP: page-action HELP: page-action
{ $class-description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "page" } " slot." } ; { $class-description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "page" } " slot." } ;
HELP: param
{ $values
{ "name" string }
{ "value" string }
}
{ $description "Outputs the value of a query parameter (if the current request is a GET or HEAD request) or a POST parameter (if the current request is a POST request)." }
{ $notes "Instead of using this word, it is better to use " { $link validate-params } " and then access parameters via " { $link "html.forms.values" } " words." } ;
HELP: params
{ $var-description "A variable holding an assoc of query parameters (if the current request is a GET or HEAD request) or POST parameters (if the current request is a POST request)." }
{ $notes "Instead of using this word, it is better to use " { $link validate-params } " and then access parameters via " { $link "html.forms.values" } " words." } ;
HELP: validate-integer-id HELP: validate-integer-id
{ $description "A utility word which validates an integer parameter named " { $snippet "id" } "." } { $description "A utility word which validates an integer parameter named " { $snippet "id" } "." }
{ $examples { $examples
@ -103,7 +91,7 @@ $nl
ARTICLE: "furnace.actions.config" "Furnace action configuration" ARTICLE: "furnace.actions.config" "Furnace action configuration"
"Actions have the following slots:" "Actions have the following slots:"
{ $table { $table
{ { $slot "rest" } { "A parameter name to map the rest of the URL, after the action name, to. If this is not set, then navigating to a URL where the action is not the last path component will return to the client with an error." } } { { $slot "rest" } { "A parameter name to map the rest of the URL, after the action name, to. If this is not set, then navigating to a URL where the action is not the last path component will return to the client with an error. A more general facility can be found in the " { $vocab-link "http.server.rewrite" } " vocabulary." } }
{ { $slot "init" } { "A quotation called at the beginning of a GET or HEAD request. Typically this quotation configures " { $link "html.forms" } " and parses query parameters." } } { { $slot "init" } { "A quotation called at the beginning of a GET or HEAD request. Typically this quotation configures " { $link "html.forms" } " and parses query parameters." } }
{ { $slot "authorize" } { "A quotation called at the beginning of a GET, HEAD or POST request. In GET requests, it is called after the " { $slot "init" } " quotation; in POST requests, it is called after the " { $slot "validate" } " quotation. By convention, this quotation performs custom authorization checks which depend on query parameters or POST parameters." } } { { $slot "authorize" } { "A quotation called at the beginning of a GET, HEAD or POST request. In GET requests, it is called after the " { $slot "init" } " quotation; in POST requests, it is called after the " { $slot "validate" } " quotation. By convention, this quotation performs custom authorization checks which depend on query parameters or POST parameters." } }
{ { $slot "display" } { "A quotation called after the " { $slot "init" } " quotation in a GET request. This quotation must return an HTTP " { $link response } "." } } { { $slot "display" } { "A quotation called after the " { $slot "init" } " quotation in a GET request. This quotation must return an HTTP " { $link response } "." } }
@ -144,10 +132,8 @@ ARTICLE: "furnace.actions.lifecycle" "Furnace action lifecycle"
"Any one of the above steps can perform validation; if " { $link validation-failed } " is called during a POST request, the client is sent back to the page containing the form submission, with current form values and validation errors passed in a " { $link "furnace.conversations" } "." ; "Any one of the above steps can perform validation; if " { $link validation-failed } " is called during a POST request, the client is sent back to the page containing the form submission, with current form values and validation errors passed in a " { $link "furnace.conversations" } "." ;
ARTICLE: "furnace.actions.impl" "Furnace actions implementation" ARTICLE: "furnace.actions.impl" "Furnace actions implementation"
"The following words are used by the action implementation and there is rarely any reason to call them directly:" "The following parametrized constructor should be called from constructors for subclasses of " { $link action } ":"
{ $subsection new-action } { $subsection new-action } ;
{ $subsection param }
{ $subsection params } ;
ARTICLE: "furnace.actions" "Furnace actions" ARTICLE: "furnace.actions" "Furnace actions"
"The " { $vocab-link "furnace.actions" } " vocabulary implements a type of responder, called an " { $emphasis "action" } ", which handles the form validation lifecycle." "The " { $vocab-link "furnace.actions" } " vocabulary implements a type of responder, called an " { $emphasis "action" } ", which handles the form validation lifecycle."

View File

@ -17,8 +17,6 @@ html.templates.chloe.syntax
html.templates.chloe.compiler ; html.templates.chloe.compiler ;
IN: furnace.actions IN: furnace.actions
SYMBOL: params
SYMBOL: rest SYMBOL: rest
TUPLE: action rest init authorize display validate submit ; TUPLE: action rest init authorize display validate submit ;
@ -60,9 +58,6 @@ TUPLE: action rest init authorize display validate submit ;
] [ drop <400> ] if ] [ drop <400> ] if
] with-exit-continuation ; ] with-exit-continuation ;
: param ( name -- value )
params get at ;
CONSTANT: revalidate-url-key "__u" CONSTANT: revalidate-url-key "__u"
: revalidate-url ( -- url/f ) : revalidate-url ( -- url/f )
@ -88,13 +83,12 @@ CONSTANT: revalidate-url-key "__u"
] [ drop <400> ] if ] [ drop <400> ] if
] with-exit-continuation ; ] with-exit-continuation ;
: handle-rest ( path action -- assoc ) : handle-rest ( path action -- )
rest>> dup [ [ "/" join ] dip associate ] [ 2drop f ] if ; rest>> dup [ [ "/" join ] dip set-param ] [ 2drop ] if ;
: init-action ( path action -- ) : init-action ( path action -- )
begin-form begin-form
handle-rest handle-rest ;
request get request-params assoc-union params set ;
M: action call-responder* ( path action -- response ) M: action call-responder* ( path action -- response )
[ init-action ] keep [ init-action ] keep

View File

@ -63,10 +63,6 @@ HELP: referrer
{ $values { "referrer/f" { $maybe string } } } { $values { "referrer/f" { $maybe string } } }
{ $description "Outputs the current request's referrer URL." } ; { $description "Outputs the current request's referrer URL." } ;
HELP: request-params
{ $values { "request" request } { "assoc" assoc } }
{ $description "Outputs the query parameters (if the current request is a GET or HEAD request) or the POST parameters (if the current request is a POST request)." } ;
HELP: resolve-base-path HELP: resolve-base-path
{ $values { "string" string } { "string'" string } } { $values { "string" string } { "string'" string } }
{ $description "Resolves a responder-relative URL." } ; { $description "Resolves a responder-relative URL." } ;
@ -121,6 +117,5 @@ ARTICLE: "furnace.misc" "Miscellaneous Furnace features"
{ $subsection exit-with } { $subsection exit-with }
"Other useful words:" "Other useful words:"
{ $subsection hidden-form-field } { $subsection hidden-form-field }
{ $subsection request-params }
{ $subsection client-state } { $subsection client-state }
{ $subsection user-agent } ; { $subsection user-agent } ;

View File

@ -91,13 +91,6 @@ M: object modify-form drop f ;
CONSTANT: nested-forms-key "__n" CONSTANT: nested-forms-key "__n"
: request-params ( request -- assoc )
dup method>> {
{ "GET" [ url>> query>> ] }
{ "HEAD" [ url>> query>> ] }
{ "POST" [ post-data>> params>> ] }
} case ;
: referrer ( -- referrer/f ) : referrer ( -- referrer/f )
#! Typo is intentional, it's in the HTTP spec! #! Typo is intentional, it's in the HTTP spec!
"referer" request get header>> at "referer" request get header>> at

View File

@ -0,0 +1,72 @@
IN: http.server.rewrite
USING: help.syntax help.markup http.server ;
HELP: rewrite
{ $class-description "The class of directory rewrite responders. The slots are as follows:"
{ $list
{ { $slot "default" } " - the responder to call if no file name is provided." }
{ { $slot "child" } " - the responder to call if a file name is provided." }
{ { $slot "param" } " - the name of a request parameter which will store the first path component of the file name passed to the responder." }
} } ;
HELP: <rewrite>
{ $values { "rewrite" rewrite } }
{ $description "Creates a new " { $link rewrite } " responder." }
{ $examples
{ $code
"<rewrite>"
" <display-post-action> >>default"
" <display-comment-action> >>child"
" \"comment_id\" >>param"
}
} ;
HELP: vhost-rewrite
{ $class-description "The class of virtual host rewrite responders. The slots are as follows:"
{ $list
{ { $slot "default" } " - the responder to call if no host name prefix is provided." }
{ { $slot "child" } " - the responder to call if a host name prefix is provided." }
{ { $slot "param" } " - the name of a request parameter which will store the first host name component of the host name passed to the responder." }
{ { $slot "suffix" } " - the domain name suffix which will be chopped off the end of the request's host name in order to produce the parameter." }
} } ;
HELP: <vhost-rewrite>
{ $values { "vhost-rewrite" vhost-rewrite } }
{ $description "Creates a new " { $link vhost-rewrite } " responder." }
{ $examples
{ $code
"<vhost-rewrite>"
" <show-blogs-action> >>default"
" <display-blog-action> >>child"
" \"blog_id\" >>param"
" \"blogs.vegan.net >>suffix"
}
} ;
ARTICLE: "http.server.rewrite.overview" "Rewrite responder overview"
"Rewrite responders take the file name and turn it into a request parameter named by the " { $slot "param" } " slot before delegating to a child responder. If a file name is provided, it calls the responder in the " { $slot "child" } " slot. If no file name is provided, they call the default responder in the " { $slot "default" } " slot."
$nl
"For example, suppose you want to have the following website schema:"
{ $list
{ { $snippet "/posts/" } " - show a list of posts" }
{ { $snippet "/posts/factor_language" } " - show thread with ID " { $snippet "factor_language" } }
{ { $snippet "/posts/factor_language/1" } " - show first comment in the thread with ID " { $snippet "factor_language" } }
{ { $snippet "/animals" } ", ... - a bunch of other actions" } }
"One way to achieve this would be to have a nesting of responders as follows:"
{ $list
{ "A dispatcher at the top level" }
{ "A " { $link rewrite } " as a child of the dispatcher under the name " { $snippet "posts" } ". The rewrite has the " { $slot "param" } " slot set to, say, " { $snippet "post_id" } ". The " { $slot "default" } " slot is set to a Furnace action which displays a list of posts." }
{ "The child slot is set to a second " { $link rewrite } " instance, with " { $snippet "param" } " set to " { $snippet "comment_id" } ", the " { $slot "default" } " slot set to an action which displays a post identified by the " { $snippet "post_id" } " parameter, and the " { $snippet "child" } " slot set to an action which displays the comment identified by the " { $snippet "comment_id" } " parameter." } }
"Note that parameters can be extracted from the request using the " { $link param } " word, but most of the time you want to use " { $vocab-link "furnace.actions" } " instead." ;
ARTICLE: "http.server.rewrite" "URL rewrite responders"
"The " { $vocab-link "http.server.rewrite" } " vocabulary defines two responder types which can help make website URLs more human-friendly."
{ $subsection "http.server.rewrite.overview" }
"Directory rewrite responders:"
{ $subsection rewrite }
{ $subsection <rewrite> }
"Virtual host rewrite responders -- these chop off the value in the " { $snippet "suffix" } " slot from the tail of the host name, and use the rest as the parameter value:"
{ $subsection vhost-rewrite }
{ $subsection <vhost-rewrite> } ;
ABOUT: "http.server.rewrite"

View File

@ -0,0 +1,48 @@
USING: accessors arrays http.server http.server.rewrite kernel
namespaces tools.test urls ;
IN: http.server.rewrite.tests
TUPLE: rewrite-test-default ;
M: rewrite-test-default call-responder*
drop "DEFAULT!" 2array ;
TUPLE: rewrite-test-child ;
M: rewrite-test-child call-responder*
drop "rewritten-param" param 2array ;
V{ } clone responder-nesting set
H{ } clone params set
<rewrite>
rewrite-test-child new >>child
rewrite-test-default new >>default
"rewritten-param" >>param
"rewrite" set
[ { { } "DEFAULT!" } ] [ { } "rewrite" get call-responder ] unit-test
[ { { } "xxx" } ] [ { "xxx" } "rewrite" get call-responder ] unit-test
[ { { "blah" } "xxx" } ] [ { "xxx" "blah" } "rewrite" get call-responder ] unit-test
<vhost-rewrite>
rewrite-test-child new >>child
rewrite-test-default new >>default
"rewritten-param" >>param
"blogs.vegan.net" >>suffix
"rewrite" set
[ { { } "DEFAULT!" } ] [
URL" http://blogs.vegan.net" url set
{ } "rewrite" get call-responder
] unit-test
[ { { } "DEFAULT!" } ] [
URL" http://www.blogs.vegan.net" url set
{ } "rewrite" get call-responder
] unit-test
[ { { } "erg" } ] [
URL" http://erg.blogs.vegan.net" url set
{ } "rewrite" get call-responder
] unit-test

View File

@ -0,0 +1,33 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors http.server http.server.dispatchers kernel
namespaces sequences splitting urls ;
IN: http.server.rewrite
TUPLE: rewrite param child default ;
: <rewrite> ( -- rewrite )
rewrite new ;
M: rewrite call-responder*
over empty? [ default>> ] [
[ [ first ] [ param>> ] bi* set-param ]
[ [ rest ] [ child>> ] bi* ]
2bi
] if
call-responder* ;
TUPLE: vhost-rewrite suffix param child default ;
: <vhost-rewrite> ( -- vhost-rewrite )
vhost-rewrite new ;
: sub-domain? ( vhost-rewrite url -- subdomain ? )
swap suffix>> dup [
[ host>> canonical-host ] [ "." prepend ] bi* ?tail
] [ 2drop f f ] if ;
M: vhost-rewrite call-responder*
dup url get sub-domain?
[ over param>> set-param child>> ] [ drop default>> ] if
call-responder ;

View File

@ -1,4 +1,5 @@
USING: help.markup help.syntax io.streams.string quotations strings urls http vocabs.refresh math io.servers.connection ; USING: help.markup help.syntax io.streams.string quotations strings urls
http vocabs.refresh math io.servers.connection assocs ;
IN: http.server IN: http.server
HELP: trivial-responder HELP: trivial-responder
@ -52,12 +53,33 @@ HELP: httpd
HELP: http-insomniac HELP: http-insomniac
{ $description "Starts a thread which rotates the logs and e-mails a summary of HTTP requests every 24 hours. See " { $link "logging.insomniac" } "." } ; { $description "Starts a thread which rotates the logs and e-mails a summary of HTTP requests every 24 hours. See " { $link "logging.insomniac" } "." } ;
HELP: request-params
{ $values { "request" request } { "assoc" assoc } }
{ $description "Outputs the query parameters (if the current request is a GET or HEAD request) or the POST parameters (if the current request is a POST request)." } ;
HELP: param
{ $values
{ "name" string }
{ "value" string }
}
{ $description "Outputs the value of a query parameter (if the current request is a GET or HEAD request) or a POST parameter (if the current request is a POST request)." }
{ $notes "Instead of using this word, it is better to use " { $vocab-link "furnace.actions" } " and the associated validation machinery, which allows you to access values using " { $link "html.forms.values" } " words." } ;
HELP: params
{ $var-description "A variable holding an assoc of query parameters (if the current request is a GET or HEAD request) or POST parameters (if the current request is a POST request)." }
{ $notes "Instead of using this word, it is better to use " { $vocab-link "furnace.actions" } " and the associated validation machinery, which allows you to access values using " { $link "html.forms.values" } " words." } ;
ARTICLE: "http.server.requests" "HTTP request variables" ARTICLE: "http.server.requests" "HTTP request variables"
"The following variables are set by the HTTP server at the beginning of a request." "The following variables are set by the HTTP server at the beginning of a request."
{ $subsection request } { $subsection request }
{ $subsection url } { $subsection url }
{ $subsection post-request? } { $subsection post-request? }
{ $subsection responder-nesting } { $subsection responder-nesting }
{ $subsection params }
"Utility words:"
{ $subsection param }
{ $subsection set-param }
{ $subsection request-params }
"Additional vocabularies may be set by vocabularies such as " { $vocab-link "html.forms" } " and " { $vocab-link "furnace.sessions" } "." ; "Additional vocabularies may be set by vocabularies such as " { $vocab-link "html.forms" } " and " { $vocab-link "furnace.sessions" } "." ;
ARTICLE: "http.server.responders" "HTTP server responders" ARTICLE: "http.server.responders" "HTTP server responders"

View File

@ -3,7 +3,8 @@
USING: kernel accessors sequences arrays namespaces splitting USING: kernel accessors sequences arrays namespaces splitting
vocabs.loader destructors assocs debugger continuations vocabs.loader destructors assocs debugger continuations
combinators vocabs.refresh tools.time math math.parser present combinators vocabs.refresh tools.time math math.parser present
io vectors vectors hashtables
io
io.sockets io.sockets
io.sockets.secure io.sockets.secure
io.encodings io.encodings
@ -212,8 +213,25 @@ LOG: httpd-header NOTICE
: split-path ( string -- path ) : split-path ( string -- path )
"/" split harvest ; "/" split harvest ;
: request-params ( request -- assoc )
dup method>> {
{ "GET" [ url>> query>> ] }
{ "HEAD" [ url>> query>> ] }
{ "POST" [ post-data>> params>> ] }
} case ;
SYMBOL: params
: param ( name -- value )
params get at ;
: set-param ( value name -- )
params get set-at ;
: init-request ( request -- ) : init-request ( request -- )
[ request set ] [ url>> url set ] bi [ request set ]
[ url>> url set ]
[ request-params >hashtable params set ] tri
V{ } clone responder-nesting set ; V{ } clone responder-nesting set ;
: dispatch-request ( request -- response ) : dispatch-request ( request -- response )

View File

@ -414,8 +414,11 @@ PRIVATE>
: reduce ( seq identity quot -- result ) : reduce ( seq identity quot -- result )
swapd each ; inline swapd each ; inline
: map-integers ( len quot exemplar -- newseq )
[ over ] dip [ [ collect ] keep ] new-like ; inline
: map-as ( seq quot exemplar -- newseq ) : map-as ( seq quot exemplar -- newseq )
[ over length ] dip [ [ map-into ] keep ] new-like ; inline [ (each) ] dip map-integers ; inline
: map ( seq quot -- newseq ) : map ( seq quot -- newseq )
over map-as ; inline over map-as ; inline
@ -442,7 +445,7 @@ PRIVATE>
[ -rot ] dip 2each ; inline [ -rot ] dip 2each ; inline
: 2map-as ( seq1 seq2 quot exemplar -- newseq ) : 2map-as ( seq1 seq2 quot exemplar -- newseq )
[ (2each) ] dip map-as ; inline [ (2each) ] dip map-integers ; inline
: 2map ( seq1 seq2 quot -- newseq ) : 2map ( seq1 seq2 quot -- newseq )
pick 2map-as ; inline pick 2map-as ; inline
@ -454,7 +457,7 @@ PRIVATE>
(3each) each ; inline (3each) each ; inline
: 3map-as ( seq1 seq2 seq3 quot exemplar -- newseq ) : 3map-as ( seq1 seq2 seq3 quot exemplar -- newseq )
[ (3each) ] dip map-as ; inline [ (3each) ] dip map-integers ; inline
: 3map ( seq1 seq2 seq3 quot -- newseq ) : 3map ( seq1 seq2 seq3 quot -- newseq )
[ pick ] dip swap 3map-as ; inline [ pick ] dip swap 3map-as ; inline