From 2c257f399ca9f9c7f23f838cb67ef560290c428f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 18 Jul 2015 22:16:11 -0700 Subject: [PATCH] factor: Rename MACRO: and MACRO: to have quot as the output in stack effects. --- basis/alien/enums/enums.factor | 2 +- basis/calendar/format/macros/macros.factor | 4 +-- basis/checksums/md5/md5.factor | 2 +- basis/classes/struct/struct.factor | 4 +-- basis/combinators/random/random.factor | 10 +++---- .../intrinsics/simd/backend/backend.factor | 28 +++++++++---------- basis/compiler/tree/debugger/debugger.factor | 2 +- .../combinators/combinators.factor | 6 ++-- basis/formatting/formatting.factor | 4 +-- basis/generalizations/generalizations.factor | 28 +++++++++---------- basis/interpolate/interpolate.factor | 2 +- basis/inverse/inverse.factor | 4 +-- basis/match/match.factor | 2 +- basis/math/bitwise/bitwise.factor | 2 +- basis/math/polynomials/polynomials.factor | 2 +- .../conversion/conversion-tests.factor | 2 +- .../math/vectors/conversion/conversion.factor | 2 +- basis/nmake/nmake.factor | 2 +- basis/opengl/opengl.factor | 6 ++-- .../generalizations/generalizations.factor | 20 ++++++------- basis/shuffle/shuffle.factor | 2 +- .../transforms/transforms-tests.factor | 2 +- basis/tools/test/test.factor | 2 +- basis/unix/unix.factor | 4 +-- basis/xmode/utilities/utilities.factor | 2 +- extra/alien/data/map/map.factor | 8 +++--- extra/alien/fortran/fortran.factor | 4 +-- extra/brainfuck/brainfuck.factor | 2 +- extra/bunny/outlined/outlined.factor | 2 +- extra/combinators/extras/extras.factor | 6 ++-- extra/combinators/tuple/tuple.factor | 2 +- extra/cuda/libraries/libraries.factor | 2 +- extra/cursors/cursors.factor | 6 ++-- extra/gml/macros/macros.factor | 2 +- extra/mason/child/child.factor | 2 +- extra/math/dual/dual.factor | 4 +-- extra/twitter/twitter.factor | 2 +- extra/variants/variants.factor | 4 +-- 38 files changed, 96 insertions(+), 96 deletions(-) diff --git a/basis/alien/enums/enums.factor b/basis/alien/enums/enums.factor index d833e96e4d..10ca2ba070 100644 --- a/basis/alien/enums/enums.factor +++ b/basis/alien/enums/enums.factor @@ -21,7 +21,7 @@ M: word enum>number "enum-value" word-prop ; { } map-as [ ] suffix '[ _ case ] ; PRIVATE> -MACRO: number>enum ( enum-c-type -- ) +MACRO: number>enum ( enum-c-type -- quot ) lookup-c-type members>> enum-boxer ; M: enum-c-type c-type-boxed-class drop object ; diff --git a/basis/calendar/format/macros/macros.factor b/basis/calendar/format/macros/macros.factor index 6d6dd3ae23..901fe2267c 100644 --- a/basis/calendar/format/macros/macros.factor +++ b/basis/calendar/format/macros/macros.factor @@ -2,7 +2,7 @@ USING: macros kernel words quotations io sequences combinators continuations ; IN: calendar.format.macros -MACRO: formatted ( spec -- ) +MACRO: formatted ( spec -- quot ) [ { { [ dup word? ] [ 1quotation ] } @@ -11,7 +11,7 @@ MACRO: formatted ( spec -- ) } cond ] map [ cleave ] curry ; -MACRO: attempt-all-quots ( quots -- ) +MACRO: attempt-all-quots ( quots -- quot ) dup length 1 = [ first ] [ unclip swap [ nip attempt-all-quots ] curry diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index 13edf0ed50..4541210954 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -84,7 +84,7 @@ CONSTANT: d 3 b state nth-unsafe w+ ] change-nth-unsafe ; inline -MACRO: with-md5-round ( ops quot -- ) +MACRO: with-md5-round ( ops quot -- quot ) '[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ; : (process-md5-block-F) ( block state -- ) diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index b7a68163c6..07ad7df82d 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -138,11 +138,11 @@ M: struct-bit-slot-spec (writer-quot) : (unboxer-quot) ( class -- quot ) drop [ >c-ptr ] ; -MACRO: read-struct-slot ( slot -- ) +MACRO: read-struct-slot ( slot -- quot ) dup type>> add-depends-on-c-type (reader-quot) ; -MACRO: write-struct-slot ( slot -- ) +MACRO: write-struct-slot ( slot -- quot ) dup type>> add-depends-on-c-type (writer-quot) ; PRIVATE> diff --git a/basis/combinators/random/random.factor b/basis/combinators/random/random.factor index 5a66b878cf..661ed3f08d 100644 --- a/basis/combinators/random/random.factor +++ b/basis/combinators/random/random.factor @@ -37,7 +37,7 @@ M: bad-probabilities summary cond>quot ] [ bad-probabilities ] if ; -MACRO: (casep) ( assoc -- ) (casep>quot) ; +MACRO: (casep) ( assoc -- quot ) (casep>quot) ; : casep>quot ( assoc -- quot ) (casep>quot) [ random-unit ] prepend ; @@ -62,11 +62,11 @@ MACRO: (casep) ( assoc -- ) (casep>quot) ; PRIVATE> -MACRO: casep ( assoc -- ) casep>quot ; +MACRO: casep ( assoc -- quot ) casep>quot ; -MACRO: casep* ( assoc -- ) direct>conditional casep>quot ; +MACRO: casep* ( assoc -- quot ) direct>conditional casep>quot ; -MACRO: call-random ( seq -- ) call-random>casep casep>quot ; +MACRO: call-random ( seq -- quot ) call-random>casep casep>quot ; -MACRO: execute-random ( seq -- ) +MACRO: execute-random ( seq -- quot ) [ 1quotation ] map call-random>casep casep>quot ; diff --git a/basis/compiler/cfg/intrinsics/simd/backend/backend.factor b/basis/compiler/cfg/intrinsics/simd/backend/backend.factor index 5a526ec579..94fa2778f2 100644 --- a/basis/compiler/cfg/intrinsics/simd/backend/backend.factor +++ b/basis/compiler/cfg/intrinsics/simd/backend/backend.factor @@ -84,22 +84,22 @@ M:: pair >vector-op-cond ( pair #pick #dup -- quotpair ) #dup '[ % _ nnip ] 2array ; -MACRO: v-vector-op ( trials -- ) +MACRO: v-vector-op ( trials -- quot ) [ 1 2 >vector-op-cond ] map '[ f f _ cond ] ; -MACRO: vl-vector-op ( trials -- ) +MACRO: vl-vector-op ( trials -- quot ) [ 1 3 >vector-op-cond ] map '[ f f _ cond ] ; -MACRO: vvl-vector-op ( trials -- ) +MACRO: vvl-vector-op ( trials -- quot ) [ 1 4 >vector-op-cond ] map '[ f f _ cond ] ; -MACRO: vv-vector-op ( trials -- ) +MACRO: vv-vector-op ( trials -- quot ) [ 1 3 >vector-op-cond ] map '[ f f _ cond ] ; -MACRO: vv-cc-vector-op ( trials -- ) +MACRO: vv-cc-vector-op ( trials -- quot ) [ 2 4 >vector-op-cond ] map '[ f f _ cond ] ; -MACRO: vvvv-vector-op ( trials -- ) +MACRO: vvvv-vector-op ( trials -- quot ) [ 1 5 >vector-op-cond ] map '[ f f _ cond ] ; ! Intrinsic code emission -MACRO: check-elements ( quots -- ) +MACRO: check-elements ( quots -- quot ) [ length '[ _ firstn ] ] [ '[ _ spread ] ] [ length 1 - \ and [ ] like ] @@ -107,7 +107,7 @@ MACRO: check-elements ( quots -- ) ERROR: bad-simd-intrinsic node ; -MACRO: if-literals-match ( quots -- ) +MACRO: if-literals-match ( quots -- quot ) [ length ] [ ] [ length ] tri ! n quots n '[ @@ -142,18 +142,18 @@ CONSTANT: [quaternary] params-quot trials op-quot literal-preds '[ [ _ dip _ @ ds-push ] _ if-literals-match ] ; -MACRO: emit-v-vector-op ( trials -- ) +MACRO: emit-v-vector-op ( trials -- quot ) [unary] [ v-vector-op ] { [ representation? ] } [emit-vector-op] ; -MACRO: emit-vl-vector-op ( trials literal-pred -- ) +MACRO: emit-vl-vector-op ( trials literal-pred -- quot ) [ [unary/param] [ vl-vector-op ] { [ representation? ] } ] dip prefix [emit-vector-op] ; -MACRO: emit-vv-vector-op ( trials -- ) +MACRO: emit-vv-vector-op ( trials -- quot ) [binary] [ vv-vector-op ] { [ representation? ] } [emit-vector-op] ; -MACRO: emit-vvl-vector-op ( trials literal-pred -- ) +MACRO: emit-vvl-vector-op ( trials literal-pred -- quot ) [ [binary/param] [ vvl-vector-op ] { [ representation? ] } ] dip prefix [emit-vector-op] ; -MACRO: emit-vvvv-vector-op ( trials -- ) +MACRO: emit-vvvv-vector-op ( trials -- quot ) [quaternary] [ vvvv-vector-op ] { [ representation? ] } [emit-vector-op] ; -MACRO:: emit-vv-or-vl-vector-op ( var-trials imm-trials literal-pred -- ) +MACRO:: emit-vv-or-vl-vector-op ( var-trials imm-trials literal-pred -- quot ) literal-pred imm-trials literal-pred var-trials '[ dup node-input-infos 2 tail-slice* first literal>> @ diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index a57c2c276c..e8a7716334 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -23,7 +23,7 @@ IN: compiler.tree.debugger GENERIC: node>quot ( node -- ) -MACRO: match-choose ( alist -- ) +MACRO: match-choose ( alist -- quot ) [ '[ _ ] ] assoc-map '[ _ match-cond ] ; MATCH-VARS: ?a ?b ?c ; diff --git a/basis/concurrency/combinators/combinators.factor b/basis/concurrency/combinators/combinators.factor index e7c42bc644..c0be95b277 100644 --- a/basis/concurrency/combinators/combinators.factor +++ b/basis/concurrency/combinators/combinators.factor @@ -70,11 +70,11 @@ PRIVATE> PRIVATE> -MACRO: parallel-cleave ( quots -- ) +MACRO: parallel-cleave ( quots -- quot ) (parallel-cleave) '[ _ cleave _ spread ] ; -MACRO: parallel-spread ( quots -- ) +MACRO: parallel-spread ( quots -- quot ) (parallel-cleave) '[ _ spread _ spread ] ; -MACRO: parallel-napply ( quot n -- ) +MACRO: parallel-napply ( quot n -- quot ) [ [future] ] dip dup (parallel-spread) '[ _ _ napply _ spread ] ; diff --git a/basis/formatting/formatting.factor b/basis/formatting/formatting.factor index e166708673..708480aed4 100644 --- a/basis/formatting/formatting.factor +++ b/basis/formatting/formatting.factor @@ -102,7 +102,7 @@ text = (formats|plain-text)* => [[ ]] PRIVATE> -MACRO: printf ( format-string -- ) +MACRO: printf ( format-string -- quot ) printf-quot '[ @ output-stream get [ stream-write ] curry _ napply ] ; @@ -197,7 +197,7 @@ text = (formats|plain-text)* => [[ ]] PRIVATE> -MACRO: strftime ( format-string -- ) +MACRO: strftime ( format-string -- quot ) parse-strftime [ dup string? [ '[ _ swap push-all ] diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 5f3c160290..91b42d5a83 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -14,39 +14,39 @@ IN: generalizations ALIAS: n*quot (n*quot) -MACRO: call-n ( n -- ) +MACRO: call-n ( n -- quot ) [ call ] '[ _ cleave ] ; : repeat ( n obj quot -- ) swapd times ; inline >> -MACRO: nsum ( n -- ) +MACRO: nsum ( n -- quot ) 1 - [ + ] n*quot ; ERROR: nonpositive-npick n ; -MACRO: npick ( n -- ) +MACRO: npick ( n -- quot ) { { [ dup 0 <= ] [ nonpositive-npick ] } { [ dup 1 = ] [ drop [ dup ] ] } [ 1 - [ dup ] [ '[ _ dip swap ] ] repeat ] } cond ; -MACRO: nover ( n -- ) +MACRO: nover ( n -- quot ) dup 1 + '[ _ npick ] n*quot ; : ndup ( n -- ) [ '[ _ npick ] ] keep call-n ; inline -MACRO: dupn ( n -- ) +MACRO: dupn ( n -- quot ) [ [ drop ] ] [ 1 - [ dup ] n*quot ] if-zero ; -MACRO: nrot ( n -- ) +MACRO: nrot ( n -- quot ) 1 - [ ] [ '[ _ dip swap ] ] repeat ; -MACRO: -nrot ( n -- ) +MACRO: -nrot ( n -- quot ) 1 - [ ] [ '[ swap _ dip ] ] repeat ; : ndrop ( n -- ) @@ -70,11 +70,11 @@ MACRO: -nrot ( n -- ) : nbi ( quot1 quot2 n -- ) [ nip nkeep ] [ drop nip call ] 3bi ; inline -MACRO: ncleave ( quots n -- ) +MACRO: ncleave ( quots n -- quot ) [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi compose ; -MACRO: nspread ( quots n -- ) +MACRO: nspread ( quots n -- quot ) over empty? [ 2drop [ ] ] [ [ [ but-last ] dip ] [ [ last ] dip ] 2bi @@ -82,13 +82,13 @@ MACRO: nspread ( quots n -- ) '[ [ _ _ nspread ] _ ndip @ ] ] if ; -MACRO: spread* ( n -- ) +MACRO: spread* ( n -- quot ) [ [ ] ] [ [1,b) [ '[ [ [ _ ndip ] curry ] dip compose ] ] map [ ] concat-as [ call ] compose ] if-zero ; -MACRO: nspread* ( m n -- ) +MACRO: nspread* ( m n -- quot ) [ drop [ ] ] [ [ * 0 ] [ drop neg ] 2bi rest >array dup length iota @@ -98,7 +98,7 @@ MACRO: nspread* ( m n -- ) [ ] concat-as [ call ] compose ] if-zero ; -MACRO: cleave* ( n -- ) +MACRO: cleave* ( n -- quot ) [ [ ] ] [ 1 - [ [ [ keep ] curry ] dip compose ] n*quot [ call ] compose ] if-zero ; @@ -118,10 +118,10 @@ MACRO: cleave* ( n -- ) : spread-curry ( a... quot... n -- ) [ [curry] ] swap [ napply ] [ spread* ] bi ; inline -MACRO: mnswap ( m n -- ) +MACRO: mnswap ( m n -- quot ) 1 + '[ _ -nrot ] swap '[ _ _ napply ] ; -MACRO: nweave ( n -- ) +MACRO: nweave ( n -- quot ) [ dup iota [ '[ _ _ mnswap ] ] with map ] keep '[ _ _ ncleave ] ; diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor index b9a83afa5e..135b2fd816 100644 --- a/basis/interpolate/interpolate.factor +++ b/basis/interpolate/interpolate.factor @@ -67,7 +67,7 @@ TUPLE: anon-var ; PRIVATE> -MACRO: interpolate ( str -- ) +MACRO: interpolate ( str -- quot ) [ [ get ] ] interpolate-quot ; : interpolate>string ( str -- newstr ) diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index 15b2b33218..21a4df0f84 100644 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -132,7 +132,7 @@ M: pop-inverse inverse : [undo] ( quot -- undo ) flatten fold reverse [ (undo) ] [ ] make ; -MACRO: undo ( quot -- ) [undo] ; +MACRO: undo ( quot -- quot ) [undo] ; ! Inverse of selected words @@ -294,4 +294,4 @@ M: no-match summary drop "Fall through in switch" ; reverse [ [ [undo] ] dip compose ] { } assoc>map recover-chain ; -MACRO: switch ( quot-alist -- ) [switch] ; +MACRO: switch ( quot-alist -- quot ) [switch] ; diff --git a/basis/match/match.factor b/basis/match/match.factor index 341d967c08..0b61389fd2 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -42,7 +42,7 @@ SYNTAX: MATCH-VARS: ! vars ... : match ( value1 value2 -- bindings ) [ (match) ] H{ } make swap [ drop f ] unless ; -MACRO: match-cond ( assoc -- ) +MACRO: match-cond ( assoc -- quot ) [ "Fall-through in match-cond" throw ] [ diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index 3658fa5d59..658d3586e0 100644 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -70,7 +70,7 @@ M: pair (bitfield-quot) ( spec -- quot ) PRIVATE> -MACRO: bitfield ( bitspec -- ) +MACRO: bitfield ( bitspec -- quot ) [ [ 0 ] ] [ [ (bitfield-quot) ] [ '[ @ _ dip bitor ] ] map-reduce ] if-empty ; diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index 9ce47d942a..b2ce6945f2 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -94,7 +94,7 @@ PRIVATE> [ drop ] 2bi '[ [ _ * ] dip + ] each ; -MACRO: polyval* ( p -- ) +MACRO: polyval* ( p -- quot ) reverse [ rest [ \ * swap \ + [ ] 3sequence ] map ] [ first \ drop swap [ ] 2sequence ] bi diff --git a/basis/math/vectors/conversion/conversion-tests.factor b/basis/math/vectors/conversion/conversion-tests.factor index aa61f44853..85416f294e 100644 --- a/basis/math/vectors/conversion/conversion-tests.factor +++ b/basis/math/vectors/conversion/conversion-tests.factor @@ -9,7 +9,7 @@ ERROR: optimized-vconvert-inconsistent unoptimized-result optimized-result ; -MACRO:: test-vconvert ( from-type to-type -- ) +MACRO:: test-vconvert ( from-type to-type -- quot ) [ from-type to-type vconvert ] :> quot quot infer :> effect effect in>> length :> inputs diff --git a/basis/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor index 2cc6bdb2b9..bb9c0d1d48 100644 --- a/basis/math/vectors/conversion/conversion.factor +++ b/basis/math/vectors/conversion/conversion.factor @@ -92,7 +92,7 @@ ERROR: bad-vconvert-input value expected-type ; PRIVATE> -MACRO:: vconvert ( from-type to-type -- ) +MACRO:: vconvert ( from-type to-type -- quot ) from-type new [ simd-element-type ] [ byte-length ] bi :> ( from-element from-length ) to-type new [ simd-element-type ] [ byte-length ] bi :> ( to-element to-length ) from-element heap-size :> from-size diff --git a/basis/nmake/nmake.factor b/basis/nmake/nmake.factor index b4dc3871d4..8050d2d3fe 100644 --- a/basis/nmake/nmake.factor +++ b/basis/nmake/nmake.factor @@ -28,7 +28,7 @@ SYMBOL: building-seq : 4% ( seq -- ) 4 n% ; : 4# ( num -- ) 4 n# ; -MACRO: finish-nmake ( exemplars -- ) +MACRO: finish-nmake ( exemplars -- quot ) length [ firstn ] curry ; :: nmake ( quot exemplars -- ) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 80f72b9f3a..55c2b766cd 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -65,10 +65,10 @@ TUPLE: gl-error-tuple function code string ; dip [ glDisableClientState ] each ; inline -MACRO: all-enabled ( seq quot -- ) +MACRO: all-enabled ( seq quot -- quot ) [ words>values ] dip '[ _ _ (all-enabled) ] ; -MACRO: all-enabled-client-state ( seq quot -- ) +MACRO: all-enabled-client-state ( seq quot -- quot ) [ words>values ] dip '[ _ _ (all-enabled-client-state) ] ; : do-matrix ( quot -- ) @@ -187,7 +187,7 @@ MACRO: all-enabled-client-state ( seq quot -- ) : (set-draw-buffers) ( buffers -- ) [ length ] [ uint >c-array ] bi glDrawBuffers ; -MACRO: set-draw-buffers ( buffers -- ) +MACRO: set-draw-buffers ( buffers -- quot ) words>values '[ _ (set-draw-buffers) ] ; : gen-dlist ( -- id ) 1 glGenLists ; diff --git a/basis/sequences/generalizations/generalizations.factor b/basis/sequences/generalizations/generalizations.factor index 5c4a18e124..c05d667e2f 100644 --- a/basis/sequences/generalizations/generalizations.factor +++ b/basis/sequences/generalizations/generalizations.factor @@ -4,28 +4,28 @@ combinators macros math.order math.ranges quotations fry effects memoize.private generalizations ; IN: sequences.generalizations -MACRO: nsequence ( n seq -- ) +MACRO: nsequence ( n seq -- quot ) [ [nsequence] ] keep '[ @ _ like ] ; -MACRO: narray ( n -- ) +MACRO: narray ( n -- quot ) '[ _ { } nsequence ] ; -MACRO: firstn-unsafe ( n -- ) +MACRO: firstn-unsafe ( n -- quot ) [firstn] ; -MACRO: firstn ( n -- ) +MACRO: firstn ( n -- quot ) [ [ drop ] ] [ [ 1 - swap bounds-check 2drop ] [ firstn-unsafe ] bi-curry '[ _ _ bi ] ] if-zero ; -MACRO: set-firstn-unsafe ( n -- ) +MACRO: set-firstn-unsafe ( n -- quot ) [ 1 + ] [ iota [ '[ _ rot [ set-nth-unsafe ] keep ] ] map ] bi '[ _ -nrot _ spread drop ] ; -MACRO: set-firstn ( n -- ) +MACRO: set-firstn ( n -- quot ) [ [ drop ] ] [ [ 1 - swap bounds-check 2drop ] [ set-firstn-unsafe ] @@ -37,7 +37,7 @@ MACRO: set-firstn ( n -- ) : nappend-as ( n exemplar -- seq ) [ narray ] [ concat-as ] bi* ; inline -MACRO: nmin-length ( n -- ) +MACRO: nmin-length ( n -- quot ) dup 1 - [ min ] n*quot '[ [ length ] _ napply @ ] ; @@ -47,7 +47,7 @@ MACRO: nmin-length ( n -- ) : nnth-unsafe ( n seq... n -- ) [ nth-unsafe ] swap [ apply-curry ] [ cleave* ] bi ; inline -MACRO: nset-nth-unsafe ( n -- ) +MACRO: nset-nth-unsafe ( n -- quot ) [ [ drop ] ] [ '[ [ set-nth-unsafe ] _ [ apply-curry ] [ cleave-curry ] [ spread* ] tri ] ] if-zero ; @@ -65,7 +65,7 @@ MACRO: nset-nth-unsafe ( n -- ) : nmap ( seq... quot n -- result ) dup '[ [ _ npick ] dip swap ] dip nmap-as ; inline -MACRO: nnew-sequence ( n -- ) +MACRO: nnew-sequence ( n -- quot ) [ [ drop ] ] [ dup '[ [ new-sequence ] _ apply-curry _ cleave* ] ] if-zero ; @@ -78,7 +78,7 @@ MACRO: nnew-sequence ( n -- ) _ spread* ] call ; inline -MACRO: (ncollect) ( n -- ) +MACRO: (ncollect) ( n -- quot ) 3 dupn 1 + '[ [ [ keep ] _ ndip _ nset-nth-unsafe ] _ ncurry ] ; diff --git a/basis/shuffle/shuffle.factor b/basis/shuffle/shuffle.factor index 0bab3c7a1b..03d3caed8b 100644 --- a/basis/shuffle/shuffle.factor +++ b/basis/shuffle/shuffle.factor @@ -5,7 +5,7 @@ generalizations kernel macros make sequences sequences.generalizations ; IN: shuffle -MACRO: shuffle-effect ( effect -- ) +MACRO: shuffle-effect ( effect -- quot ) [ in>> H{ } zip-index-as ] [ out>> ] bi [ drop assoc-size '[ _ narray ] ] [ [ of '[ _ swap nth ] ] with map ] 2bi diff --git a/basis/stack-checker/transforms/transforms-tests.factor b/basis/stack-checker/transforms/transforms-tests.factor index 2a0b5bfcb2..204d42f310 100644 --- a/basis/stack-checker/transforms/transforms-tests.factor +++ b/basis/stack-checker/transforms/transforms-tests.factor @@ -58,7 +58,7 @@ DEFER: smart-combo [ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer ! Caveat found by Doug -MACRO: curry-folding-test ( quot -- ) +MACRO: curry-folding-test ( quot -- quot ) length \ drop >quotation ; { 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index 762ce06176..24eb41f4f1 100644 --- a/basis/tools/test/test.factor +++ b/basis/tools/test/test.factor @@ -79,7 +79,7 @@ M: did-not-fail summary drop "Did not fail" ; "(" ?head drop ")" ?tail drop H{ { CHAR: - CHAR: \s } } substitute >title ; -MACRO: ( word -- ) +MACRO: ( word -- quot ) [ stack-effect in>> length dup ] [ name>> experiment-title ] bi '[ _ ndup _ narray _ prefix ] ; diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 6108cd457e..0fb4de728d 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -17,7 +17,7 @@ ERROR: unix-system-call-error args errno message word ; [ not ] } 1|| ; -MACRO:: unix-system-call ( quot -- ) +MACRO:: unix-system-call ( quot -- quot ) quot inputs :> n quot first :> word 0 :> ret! @@ -40,7 +40,7 @@ MACRO:: unix-system-call ( quot -- ) ] if ] ; -MACRO:: unix-system-call-allow-eintr ( quot -- ) +MACRO:: unix-system-call-allow-eintr ( quot -- quot ) quot inputs :> n quot first :> word 0 :> ret! diff --git a/basis/xmode/utilities/utilities.factor b/basis/xmode/utilities/utilities.factor index a7e42877aa..3fbce8e7cf 100644 --- a/basis/xmode/utilities/utilities.factor +++ b/basis/xmode/utilities/utilities.factor @@ -25,7 +25,7 @@ IN: xmode.utilities : with-tag-initializer ( tag obj quot -- ) [ object set tag set ] prepose with-scope ; inline -MACRO: (init-from-tag) ( specs -- ) +MACRO: (init-from-tag) ( specs -- quot ) [ tag-init-form ] map concat [ ] like [ with-tag-initializer ] curry ; diff --git a/extra/alien/data/map/map.factor b/extra/alien/data/map/map.factor index 7a7311b0e9..1abb3a76ef 100644 --- a/extra/alien/data/map/map.factor +++ b/extra/alien/data/map/map.factor @@ -80,10 +80,10 @@ MACRO: >param ( in -- quot: ( array -- param ) ) MACRO: alloc-param ( out -- quot: ( len -- param ) ) [alloc-param] ; -MACRO: unpack-params ( ins -- ) +MACRO: unpack-params ( ins -- quot ) [ c-type-count nip '[ _ firstn-unsafe ] ] map '[ _ spread ] ; -MACRO: pack-params ( outs -- ) +MACRO: pack-params ( outs -- quot ) [ ] [ c-type-count nip dup [ [ ndip _ ] dip set-firstn ] 3curry ] reduce fry [ call ] compose ; @@ -104,7 +104,7 @@ MACRO: pack-params ( outs -- ) [ orig>> ] , #outs , \ napply , ] [ ] make fry \ call suffix ; -MACRO: data-map ( ins outs -- ) +MACRO: data-map ( ins outs -- quot ) 2dup [ [ [ '[ _ >param ] ] map '[ _ spread ] ] @@ -113,7 +113,7 @@ MACRO: data-map ( ins outs -- ) [ [ '[ _ alloc-param ] ] map '[ _ cleave ] ] bi* compose [data-map] ; -MACRO: data-map! ( ins outs -- ) +MACRO: data-map! ( ins outs -- quot ) 2dup append [ '[ _ >param ] ] map '[ _ spread ] [data-map] ; : parse-data-map-effect ( accum -- accum ) diff --git a/extra/alien/fortran/fortran.factor b/extra/alien/fortran/fortran.factor index 6f9bae57ac..b2584b1840 100755 --- a/extra/alien/fortran/fortran.factor +++ b/extra/alien/fortran/fortran.factor @@ -101,7 +101,7 @@ CONSTANT: fortran>c-types H{ : append-dimensions ( base-c-type type -- c-type ) dims>> [ product 2array ] when* ; -MACRO: size-case-type ( cases -- ) +MACRO: size-case-type ( cases -- quot ) [ invalid-fortran-type ] suffix '[ [ size>> _ case ] [ append-dimensions ] bi ] ; @@ -424,7 +424,7 @@ PRIVATE> [ '[ _ throw ] ] [ drop return library function parameters ((fortran-invoke)) ] if ; -MACRO: fortran-invoke ( return library function parameters -- ) +MACRO: fortran-invoke ( return library function parameters -- quot ) { [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ; : parse-arglist ( parameters return -- types effect ) diff --git a/extra/brainfuck/brainfuck.factor b/extra/brainfuck/brainfuck.factor index e082e511b3..b164a669c0 100644 --- a/extra/brainfuck/brainfuck.factor +++ b/extra/brainfuck/brainfuck.factor @@ -70,7 +70,7 @@ code = (loop|ops|unknown)* => [[ compose-all ]] PRIVATE> -MACRO: run-brainfuck ( code -- ) +MACRO: run-brainfuck ( code -- quot ) parse-brainfuck '[ @ drop flush ] ; : get-brainfuck ( code -- result ) diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index 4f280b56b8..ac13f54286 100644 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -175,7 +175,7 @@ TUPLE: bunny-outlined } cleave ] [ drop ] if ; -MACRO: (framebuffer-texture>>draw) ( iformat xformat setter -- ) +MACRO: (framebuffer-texture>>draw) ( iformat xformat setter -- quot ) '[ _ _ (framebuffer-texture) [ @ drop ] keep ] ; : (make-framebuffer-textures) ( draw dim -- draw color normal depth ) diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor index c30788fbbe..afc7296f7e 100644 --- a/extra/combinators/extras/extras.factor +++ b/extra/combinators/extras/extras.factor @@ -10,7 +10,7 @@ IN: combinators.extras : thrice ( quot -- ) dup dup [ call ] 2dip [ call ] dip call ; inline : forever ( quot -- ) [ t ] compose loop ; inline -MACRO: cond-case ( assoc -- ) +MACRO: cond-case ( assoc -- quot ) [ dup callable? not [ [ first [ dup ] prepose ] @@ -18,7 +18,7 @@ MACRO: cond-case ( assoc -- ) ] when ] map [ cond ] curry ; -MACRO: cleave-array ( quots -- ) +MACRO: cleave-array ( quots -- quot ) [ '[ _ cleave ] ] [ length '[ _ narray ] ] bi compose ; : 3bi* ( u v w x y z p q -- ) @@ -45,7 +45,7 @@ MACRO: cleave-array ( quots -- ) : plox ( ... x/f quot: ( ... x -- ... ) -- ... ) dupd when ; inline -MACRO: smart-plox ( true -- ) +MACRO: smart-plox ( true -- quot ) [ inputs [ 1 - [ and ] n*quot ] keep ] keep swap '[ _ _ [ _ ndrop f ] smart-if ] ; diff --git a/extra/combinators/tuple/tuple.factor b/extra/combinators/tuple/tuple.factor index 8a8dd9eda5..af95d9abb1 100644 --- a/extra/combinators/tuple/tuple.factor +++ b/extra/combinators/tuple/tuple.factor @@ -13,7 +13,7 @@ IN: combinators.tuple PRIVATE> -MACRO:: nmake-tuple ( class assoc n -- ) +MACRO:: nmake-tuple ( class assoc n -- quot ) class all-slots [ assoc n (tuple-slot-quot) ] map :> quots class :> \class { quots n ncleave \class boa } >quotation ; diff --git a/extra/cuda/libraries/libraries.factor b/extra/cuda/libraries/libraries.factor index 2e5c36bff6..f899d4430d 100644 --- a/extra/cuda/libraries/libraries.factor +++ b/extra/cuda/libraries/libraries.factor @@ -162,7 +162,7 @@ MACRO: cuda-arguments ( c-types abi -- quot: ( args... function -- ) ) [ cached-module ] dip 2array cuda-functions get [ first2 get-function-ptr ] cache ; -MACRO: cuda-invoke ( module-name function-name arguments -- ) +MACRO: cuda-invoke ( module-name function-name arguments -- quot ) pick lookup-cuda-library abi>> '[ _ _ cached-function [ nip _ _ cuda-arguments ] diff --git a/extra/cursors/cursors.factor b/extra/cursors/cursors.factor index c03940e654..7efa7cca2d 100644 --- a/extra/cursors/cursors.factor +++ b/extra/cursors/cursors.factor @@ -547,13 +547,13 @@ ALIAS: -2in- -assoc- : -unzip- ( quot -- quot' ) '[ [ keys>> cursor-value-unsafe ] [ values>> ] bi @ ] ; inline -MACRO: nzip-cursors ( n -- ) 1 - [ zip-cursors ] n*quot ; +MACRO: nzip-cursors ( n -- quot ) 1 - [ zip-cursors ] n*quot ; : nall ( seqs... n -- begin end ) [ [ all ] swap napply ] [ nzip-cursors ] bi ; inline : nall- ( seqs... quot n -- begin end quot ) swap [ nall ] dip ; inline -MACRO: -nin- ( n -- ) +MACRO: -nin- ( n -- quot ) 1 - [ -unzip- ] n*quot [ -in- ] prepend ; : nin- ( seqs... quot n -- begin end quot ) [ nall- ] [ -nin- ] bi ; inline @@ -574,5 +574,5 @@ MACRO: -nin- ( n -- ) : -2with- ( invariant invariant begin end quot -- begin end quot' ) -with- -with- ; inline -MACRO: -nwith- ( n -- ) +MACRO: -nwith- ( n -- quot ) [ -with- ] n*quot ; diff --git a/extra/gml/macros/macros.factor b/extra/gml/macros/macros.factor index ca635a3fbd..0f79d0d1d0 100644 --- a/extra/gml/macros/macros.factor +++ b/extra/gml/macros/macros.factor @@ -24,7 +24,7 @@ SYMBOL: current-macro : save-euler-op ( euler-op -- ) current-macro get log>> push ; -MACRO:: log-euler-op ( class def inputs -- ) +MACRO:: log-euler-op ( class def inputs -- quot ) class inputs def inputs '[ [ current-macro get [ _ boa save-euler-op ] [ _ ndrop ] if ] _ _ nbi ] ; SYNTAX: LOG-GML: diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index a3cba43071..9bef56f5eb 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -78,7 +78,7 @@ IN: mason.child : recover-else ( try catch else -- ) [ [ '[ @ f t ] ] [ '[ @ f ] ] bi* recover ] dip '[ drop @ ] when ; inline -MACRO: recover-cond ( alist -- ) +MACRO: recover-cond ( alist -- quot ) dup { [ length 1 = ] [ first callable? ] } 1&& [ first ] [ [ first first2 ] [ rest ] bi diff --git a/extra/math/dual/dual.factor b/extra/math/dual/dual.factor index 640c776b8a..4512eb8f76 100644 --- a/extra/math/dual/dual.factor +++ b/extra/math/dual/dual.factor @@ -33,7 +33,7 @@ MACRO: ordinary-op ( word -- o ) ! e1 o1 o2 ... oN e2 o1 o2 ... oN ... eN o1 o2 ... oN ! This allows a set of partial derivatives each to be evaluated ! at the same point. -MACRO: duals>nweave ( n -- ) +MACRO: duals>nweave ( n -- quot ) dup dup dup '[ [ [ epsilon-part>> ] _ napply ] @@ -64,7 +64,7 @@ MACRO: chain-rule ( word -- e ) PRIVATE> -MACRO: dual-op ( word -- ) +MACRO: dual-op ( word -- quot ) [ '[ _ ordinary-op ] ] [ input-length '[ _ nkeep ] ] [ '[ _ chain-rule ] ] diff --git a/extra/twitter/twitter.factor b/extra/twitter/twitter.factor index b27122df4f..40b44878d5 100644 --- a/extra/twitter/twitter.factor +++ b/extra/twitter/twitter.factor @@ -49,7 +49,7 @@ PRIVATE> \ boa [ ] 2sequence [undo] ; GENERIC# (match-branch) 1 ( class quot -- class quot' ) @@ -65,6 +65,6 @@ M: object (match-branch) : ?class ( object -- class ) dup word? [ class-of ] unless ; -MACRO: match ( branches -- ) +MACRO: match ( branches -- quot ) [ dup callable? [ first2 (match-branch) 2array ] unless ] map [ \ dup \ ?class ] dip \ case [ ] 4sequence ; -- 2.34.1