diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor index e8ed72564c..33a651a19c 100644 --- a/basis/alien/complex/functor/functor.factor +++ b/basis/alien/complex/functor/functor.factor @@ -4,7 +4,7 @@ USING: accessors alien alien.c-types classes.struct functors kernel math math.functions quotations ; IN: alien.complex.functor -FUNCTOR: define-complex-type ( N T -- ) +>boxed-class drop -;FUNCTOR +;FUNCTOR> diff --git a/basis/alien/destructors/destructors.factor b/basis/alien/destructors/destructors.factor index f5127c0c78..27d7440454 100644 --- a/basis/alien/destructors/destructors.factor +++ b/basis/alien/destructors/destructors.factor @@ -6,7 +6,7 @@ IN: alien.destructors TUPLE: alien-destructor alien ; -FUNCTOR: define-destructor ( F -- ) + DEFINES <${F}-destructor> @@ -27,6 +27,6 @@ M: F-destructor dispose alien>> F N ndrop ; : |F ( alien -- alien ) dup |dispose drop ; inline -;FUNCTOR +;FUNCTOR> SYNTAX: DESTRUCTOR: scan-word define-destructor ; diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor index e85315d119..174eb09540 100644 --- a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor +++ b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor @@ -57,7 +57,7 @@ MIXIN: dataflow-analysis M: dataflow-analysis join-sets 2drop assoc-refine ; M: dataflow-analysis ignore-block? drop kill-block?>> ; -FUNCTOR: define-analysis ( name -- ) + ! ! ! Forward dataflow analysis @@ -88,7 +88,7 @@ M: forward-analysis block-order drop reverse-post-order ; M: forward-analysis successors drop successors>> ; M: forward-analysis predecessors drop predecessors>> ; -FUNCTOR: define-forward-analysis ( name -- ) + ! ! ! Backward dataflow analysis @@ -114,7 +114,7 @@ M: backward-analysis block-order drop post-order ; M: backward-analysis successors drop predecessors>> ; M: backward-analysis predecessors drop successors>> ; -FUNCTOR: define-backward-analysis ( name -- ) + PRIVATE> diff --git a/basis/compiler/cfg/renaming/functor/functor.factor b/basis/compiler/cfg/renaming/functor/functor.factor index 2f2d348b72..06b827699f 100644 --- a/basis/compiler/cfg/renaming/functor/functor.factor +++ b/basis/compiler/cfg/renaming/functor/functor.factor @@ -12,7 +12,7 @@ IN: compiler.cfg.renaming.functor '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join [ drop ] append ; -FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- ) + SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ; diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index 8fc1fda86e..e52ff7d04e 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -5,7 +5,7 @@ IN: functors.tests << -FUNCTOR: define-box ( T -- ) + DEFINES <${B}> @@ -16,7 +16,7 @@ TUPLE: B { value T } ; C: B ( T -- B ) -;FUNCTOR +;FUNCTOR> \ float define-box @@ -30,7 +30,7 @@ C: B ( T -- B ) [ execute ] [ execute ] bi ; inline << -FUNCTOR: wrapper-test ( W -- ) + \ sq wrapper-test @@ -48,7 +48,7 @@ WHERE << -FUNCTOR: wrapper-test-2 ( W -- ) + "blah" wrapper-test-2 @@ -66,7 +66,7 @@ WHERE << -FUNCTOR: symbol-test ( W -- ) + "blorgh" symbol-test @@ -84,7 +84,7 @@ SYMBOL: W << -FUNCTOR: generic-test ( W -- ) + "snurv" generic-test @@ -126,7 +126,7 @@ M: integer W 1 + ; test-redefinition -FUNCTOR: redefine-test ( W -- ) + [ [ ] ] [ "IN: functors.tests @@ -152,7 +152,7 @@ test-redefinition << -FUNCTOR: define-a-struct ( T NAME TYPE N -- ) + "a-struct" "nemo" c:char 2 define-a-struct @@ -213,7 +213,7 @@ STRUCT: T-class << -FUNCTOR: define-an-inline-word ( W -- ) + "an-inline-word" define-an-inline-word @@ -234,7 +234,7 @@ WHERE << -FUNCTOR: define-a-final-class ( T W -- ) + "a-final-tuple" "a-word" define-a-final-class diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index eefa7a31da..909ae38279 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -138,7 +138,7 @@ SYNTAX: DEFINES-PRIVATE [ begin-private create-word-in end-private ] (INTERPOLAT SYNTAX: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ; -DEFER: ;FUNCTOR delimiter +DEFER: ;FUNCTOR> delimiter suffix ] { } assoc>map concat - \ ;FUNCTOR parse-until [ ] append-as + \ ;FUNCTOR> parse-until [ ] append-as qualified-vocabs pop* ! unuse the bindings ] with-lambda-scope ; -: (FUNCTOR:) ( -- word def effect ) +: ( -SYNTAX: FUNCTOR: (FUNCTOR:) define-declared ; +SYNTAX: A/2 IS >${A/2} @@ -72,7 +72,7 @@ SYNTAX: A{ \ } [ >A ] parse-literal ; A-rep >>rep \ A typedef -;FUNCTOR +;FUNCTOR> : define-simd-128-cord ( A/2 T -- ) [ define-specialized-cord ] diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index 5434a4c24f..1edbdf03f4 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -263,7 +263,7 @@ M: simd-128 pprint* pprint-object ; ! SIMD concrete type functor -FUNCTOR: define-simd-128 ( T -- ) + A-rep >>rep \ A c:typedef -;FUNCTOR +;FUNCTOR> SYNTAX: SIMD-128: scan-token define-simd-128 ; diff --git a/basis/sequences/cords/cords.factor b/basis/sequences/cords/cords.factor index 766fbe87c0..74b513261f 100644 --- a/basis/sequences/cords/cords.factor +++ b/basis/sequences/cords/cords.factor @@ -27,7 +27,7 @@ GENERIC: cord-append ( seq1 seq2 -- cord ) M: object cord-append generic-cord boa ; inline -FUNCTOR: define-specialized-cord ( T C -- ) + : cord-map ( cord quot -- cord' ) [ [ head>> ] dip call ] diff --git a/basis/sorting/functor/functor.factor b/basis/sorting/functor/functor.factor index 8e9ea6a9ea..c4078576c4 100644 --- a/basis/sorting/functor/functor.factor +++ b/basis/sorting/functor/functor.factor @@ -3,7 +3,7 @@ USING: functors kernel math.order sequences sorting ; IN: sorting.functor -FUNCTOR: define-sorting ( NAME QUOT -- ) + DEFINES ${NAME}<=> NAME>=< DEFINES ${NAME}>=< @@ -13,4 +13,4 @@ WHERE : NAME<=> ( obj1 obj2 -- <=> ) QUOT compare ; : NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ; -;FUNCTOR +;FUNCTOR> diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 7976a5c148..bd221cc6b0 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -38,7 +38,7 @@ GENERIC: direct-like ( alien len exemplar -- seq ) M: byte-array nth-c-ptr ; inline M: byte-array direct-like drop uchar ; inline -FUNCTOR: define-array ( T -- ) + DEFINES <${A}> @@ -103,7 +103,7 @@ M: A vs* [ * \ T c-type-clamp ] 2map ; inline M: A v*high [ * \ T heap-size neg shift ] 2map ; inline -;FUNCTOR +;FUNCTOR> : specialized-array-vocab ( c-type -- vocab ) [ diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index 52ec17ae86..721aeef907 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -13,7 +13,7 @@ MIXIN: specialized-vector V ] parse-literal ; INSTANCE: V specialized-vector INSTANCE: V growable -;FUNCTOR +;FUNCTOR> : specialized-vector-vocab ( c-type -- vocab ) [ diff --git a/basis/tuple-arrays/tuple-arrays.factor b/basis/tuple-arrays/tuple-arrays.factor index 1ed3c86726..a08d7932a8 100644 --- a/basis/tuple-arrays/tuple-arrays.factor +++ b/basis/tuple-arrays/tuple-arrays.factor @@ -34,7 +34,7 @@ MACRO: write-tuple ( class -- quot ) PRIVATE> -FUNCTOR: define-tuple-array ( CLASS -- ) +CLASS-array ] unless ; inline INSTANCE: CLASS-array sequence -;FUNCTOR +;FUNCTOR> SYNTAX: TUPLE-ARRAY: scan-word define-tuple-array ; diff --git a/basis/vectors/functor/functor.factor b/basis/vectors/functor/functor.factor index 32c551b385..d47a80025f 100644 --- a/basis/vectors/functor/functor.factor +++ b/basis/vectors/functor/functor.factor @@ -4,7 +4,7 @@ USING: classes functors growable kernel math sequences sequences.private ; IN: vectors.functor -FUNCTOR: define-vector ( V A -- ) + -- ) DEFINES <${V}> >V DEFINES >${V} @@ -32,4 +32,4 @@ M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ; INSTANCE: V growable -;FUNCTOR +;FUNCTOR> diff --git a/extra/annotations/annotations.factor b/extra/annotations/annotations.factor index 9c69d1feb4..0fa4b5b0be 100644 --- a/extra/annotations/annotations.factor +++ b/extra/annotations/annotations.factor @@ -14,7 +14,7 @@ IN: annotations [ { [ word? ] [ vocabulary>> "annotations" = ] } 1&& not ] filter ; -FUNCTOR: define-annotation ( NAME -- ) + CONSTANT: annotation-tags { "XXX" "TODO" "FIXME" "BUG" "REVIEW" "LICENSE" diff --git a/extra/arrays/shaped/shaped-tests.factor b/extra/arrays/shaped/shaped-tests.factor index 6a74f43484..07c62f6355 100644 --- a/extra/arrays/shaped/shaped-tests.factor +++ b/extra/arrays/shaped/shaped-tests.factor @@ -52,4 +52,4 @@ IN: arrays.shaped.tests ] unit-test -{ } [ 15 { 3 5 1 } reshape drop ] unit-test \ No newline at end of file +{ } [ 15 { 3 5 1 } reshape drop ] unit-test diff --git a/extra/classes/struct/vectored/vectored.factor b/extra/classes/struct/vectored/vectored.factor index cc5b53495d..650e7e61b0 100644 --- a/extra/classes/struct/vectored/vectored.factor +++ b/extra/classes/struct/vectored/vectored.factor @@ -45,7 +45,7 @@ MACRO: (vectored-element>) ( struct-class -- quot: ( elt -- struct ) ) SLOT: (n) SLOT: (vectored) -FUNCTOR: define-vectored-accessors ( S>> S<< T -- ) +> S<< T -- ) WHERE @@ -54,14 +54,14 @@ M: T S>> M: T S<< [ (n)>> ] [ (vectored)>> S>> ] bi set-nth-unsafe ; inline -;FUNCTOR +;FUNCTOR> PRIVATE> GENERIC: struct-transpose ( structstruct -- ssttrruucctt ) GENERIC: vectored-element> ( elt -- struct ) -FUNCTOR: define-vectored-struct ( T -- ) + ] [ drop ] [ nip (vectored-T) ] 2tri [ [ [ nth ] [ set-nth ] bi-curry* bi ] 2curry each ] keep ; inline -;FUNCTOR +;FUNCTOR> SYNTAX: VECTORED-STRUCT: scan-word define-vectored-struct ; diff --git a/extra/math/blas/matrices/matrices.factor b/extra/math/blas/matrices/matrices.factor index e455d81152..85df45a093 100644 --- a/extra/math/blas/matrices/matrices.factor +++ b/extra/math/blas/matrices/matrices.factor @@ -247,7 +247,7 @@ M: blas-matrix-base equal? << -FUNCTOR: (define-blas-matrix) ( TYPE T U C -- ) + IS <${TYPE}-blas-vector> @@ -296,7 +296,7 @@ SYNTAX: XMATRIX{ \ } [ >MATRIX ] parse-literal ; M: MATRIX pprint-delims drop \ XMATRIX{ \ } ; -;FUNCTOR +;FUNCTOR> : define-real-blas-matrix ( TYPE T -- ) diff --git a/extra/math/blas/vectors/vectors.factor b/extra/math/blas/vectors/vectors.factor index 16d02b997e..9bf81f2c82 100644 --- a/extra/math/blas/vectors/vectors.factor +++ b/extra/math/blas/vectors/vectors.factor @@ -129,7 +129,7 @@ M: blas-vector-base virtual@ << -FUNCTOR: (define-blas-vector) ( TYPE T -- ) + IS XCOPY IS ${T}COPY @@ -184,10 +184,10 @@ SYNTAX: XVECTOR{ \ } [ >VECTOR ] parse-literal ; M: VECTOR pprint-delims drop \ XVECTOR{ \ } ; -;FUNCTOR +;FUNCTOR> -FUNCTOR: (define-real-blas-vector) ( TYPE T -- ) + -FUNCTOR: (define-complex-blas-vector) ( TYPE C S -- ) + : define-real-blas-vector ( TYPE T -- ) diff --git a/extra/talks/tc-lisp-talk/tc-lisp-talk.factor b/extra/talks/tc-lisp-talk/tc-lisp-talk.factor index f8d7de66da..f024d58714 100644 --- a/extra/talks/tc-lisp-talk/tc-lisp-talk.factor +++ b/extra/talks/tc-lisp-talk/tc-lisp-talk.factor @@ -180,7 +180,7 @@ computer-name" } { $slide "Functor for sorting" { $code - "FUNCTOR: define-sorting ( NAME QUOT -- ) + " DEFINES ${NAME}<=> NAME>=< DEFINES ${NAME}>=< @@ -191,7 +191,7 @@ WHERE : NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ; -;FUNCTOR" +;FUNCTOR>" } } { $slide "Example of sorting functor" diff --git a/extra/tokyo/assoc-functor/assoc-functor.factor b/extra/tokyo/assoc-functor/assoc-functor.factor index 19f6d2d4b1..bfcba2e55b 100644 --- a/extra/tokyo/assoc-functor/assoc-functor.factor +++ b/extra/tokyo/assoc-functor/assoc-functor.factor @@ -5,7 +5,7 @@ destructors fry functors kernel locals sequences serialize tokyo.alien.tcutil tokyo.utils vectors ; IN: tokyo.assoc-functor -FUNCTOR: define-tokyo-assoc-api ( T N -- ) +