From: Doug Coleman Date: Sat, 11 Feb 2023 01:58:34 +0000 (-0600) Subject: factor: use in-out word X-Git-Tag: 0.99~568 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=0b4f50150f72b52e339abf94a2ed8a189728c223 factor: use in-out word --- diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor index 8b597a58b4..6bbdbc36cb 100644 --- a/basis/combinators/smart/smart.factor +++ b/basis/combinators/smart/smart.factor @@ -14,7 +14,7 @@ GENERIC: infer-known* ( known -- effect ) ] [ infer-known* ] if ; IDENTITY-MEMO: inputs/outputs ( quot -- in out ) - infer [ in>> ] [ out>> ] bi 2length ; + infer in-out 2length ; : inputs ( quot -- n ) inputs/outputs drop ; inline @@ -24,7 +24,7 @@ IDENTITY-MEMO: inputs/outputs ( quot -- in out ) peek-d infer-known [ [ pop-d 1array #drop, ] - [ [ in>> ] [ out>> ] bi [ length apply-object ] bi@ ] bi* + [ in-out [ length apply-object ] bi@ ] bi* ] [ \ inputs/outputs dup required-stack-effect apply-word/effect pop-d pop-d swap diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index c2c0f2e0be..ab1b267547 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -26,7 +26,7 @@ MACRO: match-choose ( alist -- quot ) MATCH-VARS: ?a ?b ?c ; : pretty-shuffle ( effect -- word/f ) - [ in>> ] [ out>> ] bi 2array { + in-out 2array { { { { } { } } [ ] } { { { ?a } { ?a } } [ ] } { { { ?a ?b } { ?a ?b } } [ ] } diff --git a/basis/help/help.factor b/basis/help/help.factor index f99b0eb6d5..0ab8a74765 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -14,7 +14,7 @@ GENERIC: word-help* ( word -- content ) : inputs-and-outputs ( content word -- content' word ) over [ dup array? [ { $values } head? ] [ drop f ] if ] find drop [ '[ _ cut unclip rest ] dip [ - stack-effect [ in>> ] [ out>> ] bi + stack-effect in-out [ [ dup pair? [ first ] when ] map ] bi@ [ '[ ?first _ member? ] filter ] bi-curry@ \ $inputs \ $outputs @@ -37,7 +37,7 @@ PRIVATE> inputs-and-outputs fix-shuffle drop ; : effect-help ( effect -- content ) - [ in>> ] [ out>> ] bi [ + in-out [ [ dup pair? [ first2 dup effect? [ \ $quotation swap 2array ] when diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index a6084b2da6..2b1a19f882 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -71,7 +71,7 @@ SYMBOL: vocab-articles : effect-values ( word -- seq ) stack-effect - [ in>> ] [ out>> ] bi append + in-out append [ dup pair? [ first ] when effect>string ] map members ; : effect-effects ( word -- seq ) diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index 2ad5a55d0b..f743d42e7d 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -223,7 +223,7 @@ SYMBOL: redirects request [ [ [ - [ in>> ] [ out>> ] bi + in-out [ ?https-tunnel ] with-streams* ] [ diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor index 1ba6276c7c..7dc493b2f6 100644 --- a/basis/io/streams/duplex/duplex.factor +++ b/basis/io/streams/duplex/duplex.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See https://factorcode.org/license.txt for BSD license. -USING: kernel continuations destructors io io.encodings -io.encodings.private io.timeouts io.ports io.styles summary -accessors delegate delegate.protocols ; +USING: accessors delegate delegate.protocols destructors effects +io io.encodings io.ports io.styles io.timeouts kernel ; IN: io.streams.duplex TUPLE: duplex-stream in out ; @@ -16,7 +15,7 @@ CONSULT: formatted-output-stream-protocol duplex-stream out>> ; INSTANCE: duplex-stream input-stream INSTANCE: duplex-stream output-stream -: >duplex-stream< ( stream -- in out ) [ in>> ] [ out>> ] bi ; inline +: >duplex-stream< ( stream -- in out ) in-out ; inline M: duplex-stream stream-element-type >duplex-stream< diff --git a/basis/regexp/disambiguate/disambiguate.factor b/basis/regexp/disambiguate/disambiguate.factor index 2d16ab0cd9..20b52ea611 100644 --- a/basis/regexp/disambiguate/disambiguate.factor +++ b/basis/regexp/disambiguate/disambiguate.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Daniel Ehrenberg. ! See https://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs kernel math math.bits regexp.ast -regexp.classes regexp.transition-tables sequences sets ; +USING: accessors arrays assocs effects kernel math math.bits +regexp.ast regexp.classes regexp.transition-tables sequences +sets ; IN: regexp.disambiguate TUPLE: parts in out ; @@ -26,7 +27,7 @@ TUPLE: parts in out ; [ nip in>> ] [ out>> append ] 2bi parts boa ; : meaningful-integers ( partition table -- integers ) - [ [ in>> ] [ out>> ] bi ] dip + [ in-out ] dip '[ [ _ at ] map intersect-all ] bi@ diff ; : class-integers ( classes integers -- table ) diff --git a/basis/stack-checker/inlining/inlining.factor b/basis/stack-checker/inlining/inlining.factor index d89d7be630..291e05c9a5 100644 --- a/basis/stack-checker/inlining/inlining.factor +++ b/basis/stack-checker/inlining/inlining.factor @@ -126,7 +126,7 @@ M: declared-effect (undeclared-known) known>> (undeclared-known) ; [ check-call-height ] [ check-call-site-stack ] bi ; : adjust-stack-effect ( effect -- effect' ) - [ in>> ] [ out>> ] bi + in-out meta-d length pick length [-] object '[ _ prepend ] bi@ ; diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 606927dee4..b19357cec9 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -2,7 +2,7 @@ ! See https://factorcode.org/license.txt for BSD license. USING: accessors alien arrays assocs byte-arrays calendar classes classes.error combinators combinators.short-circuit -continuations eval hashtables help.markup interpolate io +continuations effects eval hashtables help.markup interpolate io io.directories io.encodings.utf8 io.files io.pathnames io.streams.string kernel math math.parser namespaces prettyprint quotations sequences sets sorting splitting strings system @@ -173,7 +173,7 @@ M: object add-using : $values. ( word -- ) "declared-effect" word-prop [ - [ in>> ] [ out>> ] bi + in-out 2dup [ empty? ] both? [ 2drop ] [ diff --git a/extra/help/lint/coverage/coverage.factor b/extra/help/lint/coverage/coverage.factor index ddfbcc6b7f..82cce19c5c 100644 --- a/extra/help/lint/coverage/coverage.factor +++ b/extra/help/lint/coverage/coverage.factor @@ -98,7 +98,7 @@ M: word-help-coverage summary : ?remove-$values ( word spec -- spec ) \ $values over member? [ swap "declared-effect" word-prop [ - [ in>> ] [ out>> ] bi append [ + in-out append [ \ $values swap remove ] [ drop ] if-empty ] when* ] [ nip ] if ; diff --git a/extra/math/dual/dual.factor b/extra/math/dual/dual.factor index 46a71701e4..7ade1e3f5b 100644 --- a/extra/math/dual/dual.factor +++ b/extra/math/dual/dual.factor @@ -49,7 +49,7 @@ MACRO: chain-rule ( word -- e ) : set-dual-help ( dword word -- ) [ [ - stack-effect [ in>> ] [ out>> ] bi append + stack-effect in-out append [ dual ] { } map>assoc { $values } prepend ] [ [ diff --git a/extra/smalltalk/compiler/compiler-tests.factor b/extra/smalltalk/compiler/compiler-tests.factor index 40adbc8dc9..4f37fa6012 100644 --- a/extra/smalltalk/compiler/compiler-tests.factor +++ b/extra/smalltalk/compiler/compiler-tests.factor @@ -10,7 +10,7 @@ IN: smalltalk.compiler.tests ] with-compilation-unit ; : test-inference ( ast -- in# out# ) - test-compilation infer [ in>> ] [ out>> ] bi 2length ; + test-compilation infer in-out 2length ; { 2 1 } [ T{ ast-block f