steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Eliminate duplicate syntax for stack effects "(" no longer drops and is identical to the old "((", which is now removed.

db4
John Benediktsson 2011-10-18 13:18:42 -07:00
parent 9b2634fbd7
commit 80e1c8e3f2
77 changed files with 422 additions and 430 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/alien/enums/enums.factor
View File

@ -40,7 +40,7 @@ M: enum-c-type c-type-setter
: define-enum-constructor ( word -- )
[ name>> "<" ">" surround create-in ] keep
[ number>enum ] curry (( number -- enum )) define-inline ;
[ number>enum ] curry ( number -- enum ) define-inline ;
PRIVATE>

6
basis/alien/parser/parser-tests.factor
View File

@ -38,7 +38,7 @@ CONSTANT: eleven 11
FUNCTION: void* alien-parser-function-effect-test ( int *arg1 float arg2 ) ;
[ (( arg1 arg2 -- void* )) ] [
[ ( arg1 arg2 -- void* ) ] [
\ alien-parser-function-effect-test "declared-effect" word-prop
] unit-test
@ -46,7 +46,7 @@ FUNCTION: void* alien-parser-function-effect-test ( int *arg1 float arg2 ) ;
FUNCTION-ALIAS: (alien-parser-function-effect-test) void* alien-parser-function-effect-test ( int *arg1 float arg2 ) ;
[ (( arg1 arg2 -- void* )) ] [
[ ( arg1 arg2 -- void* ) ] [
\ (alien-parser-function-effect-test) "declared-effect" word-prop
] unit-test
@ -54,7 +54,7 @@ FUNCTION-ALIAS: (alien-parser-function-effect-test) void* alien-parser-function-
CALLBACK: void* alien-parser-callback-effect-test ( int *arg1 float arg2 ) ;
[ (( arg1 arg2 -- void* )) ] [
[ ( arg1 arg2 -- void* ) ] [
\ alien-parser-callback-effect-test "callback-effect" word-prop
] unit-test

6
basis/alien/parser/parser.factor
View File

@ -155,7 +155,7 @@ PRIVATE>
void* type-word typedef
type-word names return function-effect "callback-effect" set-word-prop
type-word lib "callback-library" set-word-prop
type-word return types lib library-abi callback-quot (( quot -- alien )) ;
type-word return types lib library-abi callback-quot ( quot -- alien ) ;
: (CALLBACK:) ( -- word quot effect )
current-library get
@ -182,11 +182,11 @@ PREDICATE: alien-callback-type-word < typedef-word
'[ _ _ address-of 0 _ set-alien-value ] ;
: define-global-getter ( type word -- )
[ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;
[ nip ] [ global-quot ] 2bi ( -- value ) define-declared ;
: define-global-setter ( type word -- )
[ nip name>> "set-" prepend create-in ]
[ set-global-quot ] 2bi (( obj -- )) define-declared ;
[ set-global-quot ] 2bi ( obj -- ) define-declared ;
: define-global ( type word -- )
[ define-global-getter ] [ define-global-setter ] 2bi ;

4
basis/classes/struct/bit-accessors/bit-accessors-tests.factor
View File

@ -4,5 +4,5 @@ USING: classes.struct.bit-accessors tools.test effects kernel
sequences random stack-checker ;
IN: classes.struct.bit-accessors.test
[ t ] [ 20 random 20 random bit-reader infer (( alien -- n )) effect= ] unit-test
[ t ] [ 20 random 20 random bit-writer infer (( n alien -- )) effect= ] unit-test
[ t ] [ 20 random 20 random bit-reader infer ( alien -- n ) effect= ] unit-test
[ t ] [ 20 random 20 random bit-writer infer ( n alien -- ) effect= ] unit-test

2
basis/cocoa/messages/messages.factor
View File

@ -231,7 +231,7 @@ ERROR: no-objc-type name ;
[ class-init-hooks get set-at ]
[
[ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi
(( -- class )) define-declared
( -- class ) define-declared
] bi ;
: import-objc-class ( name quot -- )

2
basis/cocoa/subclassing/subclassing.factor
View File

@ -43,7 +43,7 @@ IN: cocoa.subclassing
: prepare-method ( ret types quot -- type imp )
[ [ encode-types ] 2keep ] dip
'[ _ _ cdecl _ alien-callback ]
(( -- callback )) define-temp ;
( -- callback ) define-temp ;
: prepare-methods ( methods -- methods )
[

2
basis/compiler/tests/codegen.factor
View File

@ -106,7 +106,7 @@ unit-test
[ ] [
[
[ 200 dup [ 200 3array ] curry map drop ] times
] [ (( n -- )) define-temp ] with-compilation-unit drop
] [ ( n -- ) define-temp ] with-compilation-unit drop
] unit-test
! Test how dispatch handles the end of a basic block

4
basis/compiler/tests/redefine15.factor
View File

@ -5,7 +5,7 @@ DEFER: word-1
: word-2 ( a -- b ) word-1 ;
[ \ word-1 [ ] (( a -- b )) define-declared ] with-compilation-unit
[ \ word-1 [ ] ( a -- b ) define-declared ] with-compilation-unit
[ "a" ] [ "a" word-2 ] unit-test
@ -15,6 +15,6 @@ DEFER: word-1
[ 1 1 ] [ 0 word-4 ] unit-test
[ \ word-3 [ [ 2 + ] bi@ ] (( a b -- c d )) define-declared ] with-compilation-unit
[ \ word-3 [ [ 2 + ] bi@ ] ( a b -- c d ) define-declared ] with-compilation-unit
[ 2 3 ] [ 0 word-4 ] unit-test

38
basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
View File

@ -5,19 +5,19 @@ compiler.tree.builder compiler.tree.optimizer compiler.tree.debugger sequences
eval combinators ;
IN: compiler.tree.propagation.call-effect.tests
[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test
[ t ] [ \ + ( a b -- c ) execute-effect-unsafe? ] unit-test
[ t ] [ \ + ( a b c -- d e ) execute-effect-unsafe? ] unit-test
[ f ] [ \ + ( a b c -- d ) execute-effect-unsafe? ] unit-test
[ f ] [ \ call ( x -- ) execute-effect-unsafe? ] unit-test
[ t ] [ [ + ] cached-effect (( a b -- c )) effect= ] unit-test
[ t ] [ 5 [ + ] curry cached-effect (( a -- c )) effect= ] unit-test
[ t ] [ 5 [ ] curry cached-effect (( -- c )) effect= ] unit-test
[ t ] [ [ dup ] [ drop ] compose cached-effect (( a -- b )) effect= ] unit-test
[ t ] [ [ drop ] [ dup ] compose cached-effect (( a b -- c d )) effect= ] unit-test
[ t ] [ [ 2drop ] [ dup ] compose cached-effect (( a b c -- d e )) effect= ] unit-test
[ t ] [ [ 1 2 3 ] [ 2drop ] compose cached-effect (( -- a )) effect= ] unit-test
[ t ] [ [ 1 2 ] [ 3drop ] compose cached-effect (( a -- )) effect= ] unit-test
[ t ] [ [ + ] cached-effect ( a b -- c ) effect= ] unit-test
[ t ] [ 5 [ + ] curry cached-effect ( a -- c ) effect= ] unit-test
[ t ] [ 5 [ ] curry cached-effect ( -- c ) effect= ] unit-test
[ t ] [ [ dup ] [ drop ] compose cached-effect ( a -- b ) effect= ] unit-test
[ t ] [ [ drop ] [ dup ] compose cached-effect ( a b -- c d ) effect= ] unit-test
[ t ] [ [ 2drop ] [ dup ] compose cached-effect ( a b c -- d e ) effect= ] unit-test
[ t ] [ [ 1 2 3 ] [ 2drop ] compose cached-effect ( -- a ) effect= ] unit-test
[ t ] [ [ 1 2 ] [ 3drop ] compose cached-effect ( a -- ) effect= ] unit-test
: optimized-quot ( quot -- quot' )
build-tree optimize-tree nodes>quot ;
@ -44,11 +44,11 @@ IN: compiler.tree.propagation.call-effect.tests
[ 3 ] [ 1 2 '[ _ + ] call( a -- b ) ] unit-test
[ 3 ] [ 1 2 '[ _ ] [ + ] compose call( a -- b ) ] unit-test
[ t ] [ [ 2 '[ _ ] [ + ] compose ] final-info first infer-value (( object -- object )) effect= ] unit-test
[ t ] [ [ 2 '[ _ ] 1 '[ _ + ] compose ] final-info first infer-value (( -- object )) effect= ] unit-test
[ t ] [ [ 2 '[ _ + ] ] final-info first infer-value (( object -- object )) effect= ] unit-test
[ t ] [ [ 2 '[ _ ] [ + ] compose ] final-info first infer-value ( object -- object ) effect= ] unit-test
[ t ] [ [ 2 '[ _ ] 1 '[ _ + ] compose ] final-info first infer-value ( -- object ) effect= ] unit-test
[ t ] [ [ 2 '[ _ + ] ] final-info first infer-value ( object -- object ) effect= ] unit-test
[ f ] [ [ [ [ ] [ 1 ] if ] ] final-info first infer-value ] unit-test
[ t ] [ [ [ 1 ] '[ @ ] ] final-info first infer-value (( -- object )) effect= ] unit-test
[ t ] [ [ [ 1 ] '[ @ ] ] final-info first infer-value ( -- object ) effect= ] unit-test
[ f ] [ [ dup drop ] final-info first infer-value ] unit-test
! This should not hang
@ -66,11 +66,11 @@ TUPLE: a-tuple x ;
: test-quotatation ( -- quot ) [ call(-redefine-test ] ;
[ t ] [ test-quotatation cached-effect (( a -- b )) effect<= ] unit-test
[ t ] [ test-quotatation cached-effect ( a -- b ) effect<= ] unit-test
[ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a b -- c ) + ;" eval( -- ) ] unit-test
[ t ] [ test-quotatation cached-effect (( a b -- c )) effect<= ] unit-test
[ t ] [ test-quotatation cached-effect ( a b -- c ) effect<= ] unit-test
: inline-cache-invalidation-test ( a b c -- c ) call( a b -- c ) ;
@ -78,7 +78,7 @@ TUPLE: a-tuple x ;
[ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a -- c ) 1 + ;" eval( -- ) ] unit-test
[ 1 3 test-quotatation inline-cache-invalidation-test ] [ T{ wrong-values f [ call(-redefine-test ] (( a b -- c )) } = ] must-fail-with
[ 1 3 test-quotatation inline-cache-invalidation-test ] [ T{ wrong-values f [ call(-redefine-test ] ( a b -- c ) } = ] must-fail-with
! See if redefining a tuple class bumps effect counter
TUPLE: my-tuple a b c ;

2
basis/compiler/tree/propagation/call-effect/call-effect.factor
View File

@ -167,7 +167,7 @@ M: quotation add-quot-to-history add-to-history ;
ERROR: uninferable ;
: remove-effect-input ( effect -- effect' )
(( -- object )) swap compose-effects ;
( -- object ) swap compose-effects ;
: (infer-value) ( value-info -- effect )
dup literal?>> [

2
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -899,7 +899,7 @@ SYMBOL: not-an-assoc
[ f ] [ [ 5 instance? ] { instance? } inlined? ] unit-test
[ t ] [ [ array instance? ] { instance? } inlined? ] unit-test
[ t ] [ [ (( a b c -- c b a )) shuffle ] { shuffle } inlined? ] unit-test
[ t ] [ [ ( a b c -- c b a ) shuffle ] { shuffle } inlined? ] unit-test
[ f ] [ [ { 1 2 3 } swap shuffle ] { shuffle } inlined? ] unit-test
! Type function for 'clone' had a subtle issue

2
basis/core-foundation/strings/strings.factor
View File

@ -99,4 +99,4 @@ FUNCTION: CFStringRef CFCopyTypeIDDescription ( CFTypeID type_id ) ;
SYNTAX: CFSTRING:
scan-new-word scan-object
[ drop ] [ '[ _ [ _ <CFString> ] initialize-alien ] ] 2bi
(( -- alien )) define-declared ;
( -- alien ) define-declared ;

4
basis/eval/eval-docs.factor
View File

@ -21,7 +21,7 @@ HELP: eval(
"This parsing word is just a slightly nicer syntax for " { $link eval } ". The following are equivalent:"
{ $code
"eval( inputs -- outputs )"
"(( inputs -- outputs )) eval"
"( inputs -- outputs ) eval"
}
}
{ $errors "Throws an error if the input is malformed, or if the evaluation itself throws an error." } ;
@ -51,7 +51,7 @@ $nl
"""USING: eval listener vocabs.parser ;
[
"cad.objects" use-vocab
(( -- seq )) (eval)
( -- seq ) (eval)
] with-interactive-vocabs"""
}
"Note that the search path in the outer code (set by the " { $link POSTPONE: USING: } " form) has no relation to the search path used when parsing the string parameter (this is determined by " { $link with-interactive-vocabs } " and " { $link use-vocab } ")." ;

2
basis/eval/eval.factor
View File

@ -19,7 +19,7 @@ SYNTAX: eval( \ eval parse-call( ;
: (eval>string) ( str -- output )
[
parser-quiet? on
'[ _ (( -- )) (eval) ] [ print-error ] recover
'[ _ ( -- ) (eval) ] [ print-error ] recover
] with-string-writer ;
: eval>string ( str -- output )

2
basis/logging/logging.factor
View File

@ -140,7 +140,7 @@ SYNTAX: LOG:
#! Syntax: name level
scan-new-word dup scan-word
'[ 1array stack>message _ _ log-message ]
(( message -- )) define-declared ;
( message -- ) define-declared ;
USE: vocabs.loader

2
basis/match/match.factor
View File

@ -11,7 +11,7 @@ SYMBOL: _
: define-match-var ( name -- )
create-in
dup t "match-var" set-word-prop
dup [ get ] curry (( -- value )) define-declared ;
dup [ get ] curry ( -- value ) define-declared ;
: define-match-vars ( seq -- )
[ define-match-var ] each ;

2
basis/math/bitwise/bitwise.factor
View File

@ -77,7 +77,7 @@ DEFER: byte-bit-count
256 iota [
8 <bits> 0 [ [ 1 + ] when ] reduce
] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ]
(( byte -- table )) define-declared
( byte -- table ) define-declared
\ byte-bit-count make-inline

2
basis/math/partial-dispatch/partial-dispatch.factor
View File

@ -95,7 +95,7 @@ M: word integer-op-input-classes
: define-integer-op-word ( fix-word big-word triple -- )
[
[ 2nip integer-op-word dup make-foldable ] [ integer-op-quot ] 3bi
(( x y -- z )) define-declared
( x y -- z ) define-declared
] [
2nip
[ integer-op-word ] keep

4
basis/math/vectors/simd/simd-tests.factor
View File

@ -334,11 +334,11 @@ simd-classes&reps [
! Invalid inputs should not cause the compiler to throw errors
[ ] [
[ [ { int-4 } declare t hrshift ] (( a -- b )) define-temp drop ] with-compilation-unit
[ [ { int-4 } declare t hrshift ] ( a -- b ) define-temp drop ] with-compilation-unit
] unit-test
[ ] [
[ [ { int-4 } declare { 3 2 1 } vshuffle ] (( a -- b )) define-temp drop ] with-compilation-unit
[ [ { int-4 } declare { 3 2 1 } vshuffle ] ( a -- b ) define-temp drop ] with-compilation-unit
] unit-test
! Shuffles

2
basis/memoize/memoize-tests.factor
View File

@ -30,6 +30,6 @@ unit-test
[ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test
[ sq ] (( a -- b )) memoize-quot "q" set
[ sq ] ( a -- b ) memoize-quot "q" set
[ 9 ] [ 3 "q" get call ] unit-test

2
basis/multiline/multiline.factor
View File

@ -34,7 +34,7 @@ ERROR: text-found-before-eol string ;
SYNTAX: STRING:
scan-new-word
parse-here 1quotation
(( -- string )) define-inline ;
( -- string ) define-inline ;
<PRIVATE

2
basis/openssl/libssl/libssl.factor
View File

@ -282,7 +282,7 @@ H{ } clone verify-messages set-global
SYNTAX: X509_V_:
scan-token "X509_V_" prepend create-in
scan-number
[ 1quotation (( -- value )) define-inline ]
[ 1quotation ( -- value ) define-inline ]
[ verify-messages get set-at ]
2bi ;

6
basis/peg/ebnf/ebnf.factor
View File

@ -492,8 +492,8 @@ ERROR: bad-effect quot effect ;
: check-action-effect ( quot -- quot )
dup infer {
{ [ dup (( a -- b )) effect<= ] [ drop ] }
{ [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] }
{ [ dup ( a -- b ) effect<= ] [ drop ] }
{ [ dup ( -- b ) effect<= ] [ drop [ drop ] prepose ] }
[ bad-effect ]
} cond ;
@ -572,5 +572,5 @@ SYNTAX: [EBNF
SYNTAX: EBNF:
reset-tokenizer scan-new-word dup ";EBNF" parse-multiline-string
ebnf>quot swapd
(( input -- ast )) define-declared "ebnf-parser" set-word-prop
( input -- ast ) define-declared "ebnf-parser" set-word-prop
reset-tokenizer ;

6
basis/peg/peg.factor
View File

@ -270,7 +270,7 @@ GENERIC: (compile) ( peg -- quot )
: define-parser-word ( parser word -- )
#! Return the body of the word that is the compiled version
#! of the parser.
2dup swap peg>> (compile) (( -- result )) define-declared
2dup swap peg>> (compile) ( -- result ) define-declared
swap id>> "peg-id" set-word-prop ;
: compile-parser ( parser -- word )
@ -295,13 +295,13 @@ SYMBOL: delayed
#! Work through all delayed parsers and recompile their
#! words to have the correct bodies.
delayed get [
call( -- parser ) compile-parser-quot (( -- result )) define-declared
call( -- parser ) compile-parser-quot ( -- result ) define-declared
] assoc-each ;
: compile ( parser -- word )
[
H{ } clone delayed [
compile-parser-quot (( -- result )) define-temp fixup-delayed
compile-parser-quot ( -- result ) define-temp fixup-delayed
] with-variable
] with-compilation-unit ;

4
basis/regexp/compiler/compiler.factor
View File

@ -112,7 +112,7 @@ C: <box> box
: states>code ( words dfa -- )
'[
dup _ word>quot
(( last-match index string -- ? ))
( last-match index string -- ? )
define-declared
] each ;
@ -132,7 +132,7 @@ PRIVATE>
: dfa>word ( dfa -- quot )
dfa>main-word execution-quot word-template
(( start-index string regexp -- i/f )) define-temp ;
( start-index string regexp -- i/f ) define-temp ;
: dfa>shortest-word ( dfa -- word )
t shortest? [ dfa>word ] with-variable ;

2
basis/regexp/regexp.factor
View File

@ -167,7 +167,7 @@ DEFER: compile-next-match
dup \ next-initial-word = [
drop _ [ compile-regexp dfa>> def>> ] [ reverse-regexp? ] bi
'[ { array-capacity string regexp } declare _ _ next-match ]
(( i string regexp -- start end string )) define-temp
( i string regexp -- start end string ) define-temp
] when
] change-next-match ;

6
basis/stack-checker/branches/branches.factor
View File

@ -47,7 +47,7 @@ SYMBOLS: +bottom+ +top+ ;
SYMBOLS: combinator quotations ;
: simple-unbalanced-branches-error ( word quots branches -- * )
[ length [ (( ..a -- ..b )) ] replicate ]
[ length [ ( ..a -- ..b ) ] replicate ]
[ [ length [ "x" <array> ] bi@ <effect> ] { } assoc>map ] bi
unbalanced-branches-error ;
@ -128,8 +128,8 @@ M: declared-effect curried/composed? known>> curried/composed? ;
: declare-if-effects ( -- )
H{ } clone V{ } clone
[ [ \ if (( ..a -- ..b )) ] 2dip 0 declare-effect-d ]
[ [ \ if (( ..a -- ..b )) ] 2dip 1 declare-effect-d ] 2bi ;
[ [ \ if ( ..a -- ..b ) ] 2dip 0 declare-effect-d ]
[ [ \ if ( ..a -- ..b ) ] 2dip 1 declare-effect-d ] 2bi ;
: infer-if ( -- )
\ if combinator set

34
basis/stack-checker/known-words/known-words.factor
View File

@ -41,10 +41,10 @@ IN: stack-checker.known-words
"shuffle" word-prop infer-shuffle ;
: infer-local-reader ( word -- )
(( -- value )) apply-word/effect ;
( -- value ) apply-word/effect ;
: infer-local-writer ( word -- )
(( value -- )) apply-word/effect ;
( value -- ) apply-word/effect ;
: non-inline-word ( word -- )
dup depends-on-effect
@ -61,21 +61,21 @@ IN: stack-checker.known-words
} cond ;
{
{ drop (( x -- )) }
{ 2drop (( x y -- )) }
{ 3drop (( x y z -- )) }
{ dup (( x -- x x )) }
{ 2dup (( x y -- x y x y )) }
{ 3dup (( x y z -- x y z x y z )) }
{ rot (( x y z -- y z x )) }
{ -rot (( x y z -- z x y )) }
{ dupd (( x y -- x x y )) }
{ swapd (( x y z -- y x z )) }
{ nip (( x y -- y )) }
{ 2nip (( x y z -- z )) }
{ over (( x y -- x y x )) }
{ pick (( x y z -- x y z x )) }
{ swap (( x y -- y x )) }
{ drop ( x -- ) }
{ 2drop ( x y -- ) }
{ 3drop ( x y z -- ) }
{ dup ( x -- x x ) }
{ 2dup ( x y -- x y x y ) }
{ 3dup ( x y z -- x y z x y z ) }
{ rot ( x y z -- y z x ) }
{ -rot ( x y z -- z x y ) }
{ dupd ( x y -- x x y ) }
{ swapd ( x y z -- y x z ) }
{ nip ( x y -- y ) }
{ 2nip ( x y z -- z ) }
{ over ( x y -- x y x ) }
{ pick ( x y z -- x y z x ) }
{ swap ( x y -- y x ) }
} [ "shuffle" set-word-prop ] assoc-each
: check-declaration ( declaration -- declaration )

6
basis/tools/deploy/shaker/shaker.factor
View File

@ -285,7 +285,7 @@ IN: tools.deploy.shaker
recursive-subst ;
: new-default-method ( -- gensym )
[ [ "No method" throw ] (( -- * )) define-temp ] with-compilation-unit ;
[ [ "No method" throw ] ( -- * ) define-temp ] with-compilation-unit ;
: strip-default-methods ( -- )
! In a development image, each generic has its own default method.
@ -569,11 +569,11 @@ SYMBOL: deploy-vocab
: die-with ( error original-error -- * )
#! We don't want DCE to drop the error before the die call!
[ die 1 exit ] (( a -- * )) call-effect-unsafe ;
[ die 1 exit ] ( a -- * ) call-effect-unsafe ;
: die-with2 ( error original-error -- * )
#! We don't want DCE to drop the error before the die call!
[ die 1 exit ] (( a b -- * )) call-effect-unsafe ;
[ die 1 exit ] ( a b -- * ) call-effect-unsafe ;
: deploy-error-handler ( quot -- )
[

2
basis/tools/profiler/profiler-tests.factor
View File

@ -67,7 +67,7 @@ IN: tools.profiler.tests
[ 1 ] [
[
[ [ ] (( -- )) define-temp ] with-compilation-unit
[ [ ] ( -- ) define-temp ] with-compilation-unit
dup execute( -- )
] profile
counter>>

4
basis/tr/tr.factor
View File

@ -30,13 +30,13 @@ M: bad-tr summary
'[ [ dup ascii? [ _ tr-nth ] when ] map ] ;
: define-tr ( word mapping -- )
tr-quot (( seq -- translated )) define-declared ;
tr-quot ( seq -- translated ) define-declared ;
: fast-tr-quot ( mapping -- quot )
'[ [ _ tr-nth ] map! drop ] ;
: define-fast-tr ( word mapping -- )
fast-tr-quot (( seq -- )) define-declared ;
fast-tr-quot ( seq -- ) define-declared ;
PRIVATE>

2
basis/typed/typed-tests.factor
View File

@ -52,7 +52,7 @@ TUPLE: unboxable2
TYPED: unboxy ( in: unboxable -- out: unboxable2 )
dup [ x>> ] [ y>> ] bi - unboxable2 boa ;
[ (( in: fixnum in: fixnum -- out: fixnum out: fixnum out: fixnum )) ]
[ ( in: fixnum in: fixnum -- out: fixnum out: fixnum out: fixnum ) ]
[ \ unboxy "typed-word" word-prop stack-effect ] unit-test
[ T{ unboxable2 { u T{ unboxable { x 12 } { y 3 } } } { xy 9 } } ]

2
basis/ui/ui.factor
View File

@ -222,7 +222,7 @@ HOOK: system-alert ui-backend ( caption text -- )
: define-main-window ( word attributes quot -- )
[
'[ [ f _ clone @ open-window ] with-ui ] (( -- )) define-declared
'[ [ f _ clone @ open-window ] with-ui ] ( -- ) define-declared
] [ 2drop current-vocab main<< ] 3bi ;
SYNTAX: MAIN-WINDOW:

2
basis/values/values.factor
View File

@ -34,7 +34,7 @@ SYNTAX: VALUE:
scan-new-word
dup t "no-def-strip" set-word-prop
T{ value-holder } clone [ obj>> ] curry
(( -- value )) define-declared ;
( -- value ) define-declared ;
M: value-word definer drop \ VALUE: f ;

10
basis/windows/com/com-tests.factor
View File

@ -25,11 +25,11 @@ COM-INTERFACE: ISelfReferential IUnknown {d4f45bf8-f720-4701-a09d-e8e341981121}
{ GUID: {00000000-0000-0000-C000-000000000046} } [ IUnknown-iid ] unit-test
{ GUID: {b06ac3f4-30e4-406b-a7cd-c29cead4552c} } [ IUnrelated-iid ] unit-test
{ (( -- iid )) } [ \ ISimple-iid stack-effect ] unit-test
{ (( this -- HRESULT )) } [ \ ISimple::returnOK stack-effect ] unit-test
{ (( this -- int )) } [ \ IInherited::getX stack-effect ] unit-test
{ (( this newX -- )) } [ \ IInherited::setX stack-effect ] unit-test
{ (( this mul add -- int )) } [ \ IUnrelated::xMulAdd stack-effect ] unit-test
{ ( -- iid ) } [ \ ISimple-iid stack-effect ] unit-test
{ ( this -- HRESULT ) } [ \ ISimple::returnOK stack-effect ] unit-test
{ ( this -- int ) } [ \ IInherited::getX stack-effect ] unit-test
{ ( this newX -- ) } [ \ IInherited::setX stack-effect ] unit-test
{ ( this mul add -- int ) } [ \ IUnrelated::xMulAdd stack-effect ] unit-test
SYMBOL: +test-wrapper+
SYMBOL: +guinea-pig-implementation+

2
basis/windows/com/syntax/syntax.factor
View File

@ -74,7 +74,7 @@ ERROR: no-com-interface interface ;
define-declared ;
: define-words-for-com-interface ( definition -- )
[ [ (iid-word) ] [ iid>> 1quotation ] bi (( -- iid )) define-declared ]
[ [ (iid-word) ] [ iid>> 1quotation ] bi ( -- iid ) define-declared ]
[
dup family-tree-functions
[ (define-word-for-function) ] with each-index

2
basis/windows/com/wrapper/wrapper.factor
View File

@ -93,7 +93,7 @@ unless
: compile-alien-callback ( word return parameters abi quot -- word )
'[ _ _ _ _ alien-callback ]
[ [ (( -- alien )) define-declared ] pick [ call ] dip ]
[ [ ( -- alien ) define-declared ] pick [ call ] dip ]
with-compilation-unit ;
: (callback-word) ( function-name interface counter -- word )

2
basis/xml/syntax/syntax.factor
View File

@ -37,7 +37,7 @@ SYNTAX: TAG:
scan-token scan-word parse-definition define-tag ;
SYNTAX: XML-NS:
scan-new-word scan-token '[ f swap _ <name> ] (( string -- name )) define-memoized ;
scan-new-word scan-token '[ f swap _ <name> ] ( string -- name ) define-memoized ;
<PRIVATE

434
core/bootstrap/primitives.factor
View File

@ -260,11 +260,11 @@ tuple
"((empty))" "hashtables.private" create
"tombstone" "hashtables.private" lookup f
2array >tuple 1quotation (( -- value )) define-inline
2array >tuple 1quotation ( -- value ) define-inline
"((tombstone))" "hashtables.private" create
"tombstone" "hashtables.private" lookup t
2array >tuple 1quotation (( -- value )) define-inline
2array >tuple 1quotation ( -- value ) define-inline
! Some tuple classes
"curry" "kernel" create
@ -287,7 +287,7 @@ tuple
] [ ] make
]
} cleave
(( obj quot -- curry )) define-declared
( obj quot -- curry ) define-declared
"compose" "kernel" create
tuple
@ -310,7 +310,7 @@ tuple
] [ ] make
]
} cleave
(( quot1 quot2 -- compose )) define-declared
( quot1 quot2 -- compose ) define-declared
! Sub-primitive words
: make-sub-primitive ( word vocab effect -- )
@ -321,62 +321,62 @@ tuple
] dip define-declared ;
{
{ "mega-cache-lookup" "generic.single.private" (( methods index cache -- )) }
{ "inline-cache-miss" "generic.single.private" (( generic methods index cache -- )) }
{ "inline-cache-miss-tail" "generic.single.private" (( generic methods index cache -- )) }
{ "drop" "kernel" (( x -- )) }
{ "2drop" "kernel" (( x y -- )) }
{ "3drop" "kernel" (( x y z -- )) }
{ "dup" "kernel" (( x -- x x )) }
{ "2dup" "kernel" (( x y -- x y x y )) }
{ "3dup" "kernel" (( x y z -- x y z x y z )) }
{ "rot" "kernel" (( x y z -- y z x )) }
{ "-rot" "kernel" (( x y z -- z x y )) }
{ "dupd" "kernel" (( x y -- x x y )) }
{ "swapd" "kernel" (( x y z -- y x z )) }
{ "nip" "kernel" (( x y -- y )) }
{ "2nip" "kernel" (( x y z -- z )) }
{ "over" "kernel" (( x y -- x y x )) }
{ "pick" "kernel" (( x y z -- x y z x )) }
{ "swap" "kernel" (( x y -- y x )) }
{ "eq?" "kernel" (( obj1 obj2 -- ? )) }
{ "tag" "kernel.private" (( object -- n )) }
{ "(execute)" "kernel.private" (( word -- )) }
{ "(call)" "kernel.private" (( quot -- )) }
{ "fpu-state" "kernel.private" (( -- )) }
{ "set-fpu-state" "kernel.private" (( -- )) }
{ "unwind-native-frames" "kernel.private" (( -- )) }
{ "set-callstack" "kernel.private" (( callstack -- * )) }
{ "lazy-jit-compile" "kernel.private" (( -- )) }
{ "c-to-factor" "kernel.private" (( -- )) }
{ "slot" "slots.private" (( obj m -- value )) }
{ "get-local" "locals.backend" (( n -- obj )) }
{ "load-local" "locals.backend" (( obj -- )) }
{ "drop-locals" "locals.backend" (( n -- )) }
{ "both-fixnums?" "math.private" (( x y -- ? )) }
{ "fixnum+fast" "math.private" (( x y -- z )) }
{ "fixnum-fast" "math.private" (( x y -- z )) }
{ "fixnum*fast" "math.private" (( x y -- z )) }
{ "fixnum-bitand" "math.private" (( x y -- z )) }
{ "fixnum-bitor" "math.private" (( x y -- z )) }
{ "fixnum-bitxor" "math.private" (( x y -- z )) }
{ "fixnum-bitnot" "math.private" (( x -- y )) }
{ "fixnum-mod" "math.private" (( x y -- z )) }
{ "fixnum-shift-fast" "math.private" (( x y -- z )) }
{ "fixnum/i-fast" "math.private" (( x y -- z )) }
{ "fixnum/mod-fast" "math.private" (( x y -- z w )) }
{ "fixnum+" "math.private" (( x y -- z )) }
{ "fixnum-" "math.private" (( x y -- z )) }
{ "fixnum*" "math.private" (( x y -- z )) }
{ "fixnum<" "math.private" (( x y -- ? )) }
{ "fixnum<=" "math.private" (( x y -- z )) }
{ "fixnum>" "math.private" (( x y -- ? )) }
{ "fixnum>=" "math.private" (( x y -- ? )) }
{ "string-nth-fast" "strings.private" (( n string -- ch )) }
{ "(set-context)" "threads.private" (( obj context -- obj' )) }
{ "(set-context-and-delete)" "threads.private" (( obj context -- * )) }
{ "(start-context)" "threads.private" (( obj quot -- obj' )) }
{ "(start-context-and-delete)" "threads.private" (( obj quot -- * )) }
{ "mega-cache-lookup" "generic.single.private" ( methods index cache -- ) }
{ "inline-cache-miss" "generic.single.private" ( generic methods index cache -- ) }
{ "inline-cache-miss-tail" "generic.single.private" ( generic methods index cache -- ) }
{ "drop" "kernel" ( x -- ) }
{ "2drop" "kernel" ( x y -- ) }
{ "3drop" "kernel" ( x y z -- ) }
{ "dup" "kernel" ( x -- x x ) }
{ "2dup" "kernel" ( x y -- x y x y ) }
{ "3dup" "kernel" ( x y z -- x y z x y z ) }
{ "rot" "kernel" ( x y z -- y z x ) }
{ "-rot" "kernel" ( x y z -- z x y ) }
{ "dupd" "kernel" ( x y -- x x y ) }
{ "swapd" "kernel" ( x y z -- y x z ) }
{ "nip" "kernel" ( x y -- y ) }
{ "2nip" "kernel" ( x y z -- z ) }
{ "over" "kernel" ( x y -- x y x ) }
{ "pick" "kernel" ( x y z -- x y z x ) }
{ "swap" "kernel" ( x y -- y x ) }
{ "eq?" "kernel" ( obj1 obj2 -- ? ) }
{ "tag" "kernel.private" ( object -- n ) }
{ "(execute)" "kernel.private" ( word -- ) }
{ "(call)" "kernel.private" ( quot -- ) }
{ "fpu-state" "kernel.private" ( -- ) }
{ "set-fpu-state" "kernel.private" ( -- ) }
{ "unwind-native-frames" "kernel.private" ( -- ) }
{ "set-callstack" "kernel.private" ( callstack -- * ) }
{ "lazy-jit-compile" "kernel.private" ( -- ) }
{ "c-to-factor" "kernel.private" ( -- ) }
{ "slot" "slots.private" ( obj m -- value ) }
{ "get-local" "locals.backend" ( n -- obj ) }
{ "load-local" "locals.backend" ( obj -- ) }
{ "drop-locals" "locals.backend" ( n -- ) }
{ "both-fixnums?" "math.private" ( x y -- ? ) }
{ "fixnum+fast" "math.private" ( x y -- z ) }
{ "fixnum-fast" "math.private" ( x y -- z ) }
{ "fixnum*fast" "math.private" ( x y -- z ) }
{ "fixnum-bitand" "math.private" ( x y -- z ) }
{ "fixnum-bitor" "math.private" ( x y -- z ) }
{ "fixnum-bitxor" "math.private" ( x y -- z ) }
{ "fixnum-bitnot" "math.private" ( x -- y ) }
{ "fixnum-mod" "math.private" ( x y -- z ) }
{ "fixnum-shift-fast" "math.private" ( x y -- z ) }
{ "fixnum/i-fast" "math.private" ( x y -- z ) }
{ "fixnum/mod-fast" "math.private" ( x y -- z w ) }
{ "fixnum+" "math.private" ( x y -- z ) }
{ "fixnum-" "math.private" ( x y -- z ) }
{ "fixnum*" "math.private" ( x y -- z ) }
{ "fixnum<" "math.private" ( x y -- ? ) }
{ "fixnum<=" "math.private" ( x y -- z ) }
{ "fixnum>" "math.private" ( x y -- ? ) }
{ "fixnum>=" "math.private" ( x y -- ? ) }
{ "string-nth-fast" "strings.private" ( n string -- ch ) }
{ "(set-context)" "threads.private" ( obj context -- obj' ) }
{ "(set-context-and-delete)" "threads.private" ( obj context -- * ) }
{ "(start-context)" "threads.private" ( obj quot -- obj' ) }
{ "(start-context-and-delete)" "threads.private" ( obj quot -- * ) }
} [ first3 make-sub-primitive ] each
! Primitive words
@ -391,165 +391,165 @@ tuple
] dip define-declared ;
{
{ "<callback>" "alien" "primitive_callback" (( return-rewind word -- alien )) }
{ "<displaced-alien>" "alien" "primitive_displaced_alien" (( displacement c-ptr -- alien )) }
{ "alien-address" "alien" "primitive_alien_address" (( c-ptr -- addr )) }
{ "alien-cell" "alien.accessors" "primitive_alien_cell" (( c-ptr n -- value )) }
{ "alien-double" "alien.accessors" "primitive_alien_double" (( c-ptr n -- value )) }
{ "alien-float" "alien.accessors" "primitive_alien_float" (( c-ptr n -- value )) }
{ "alien-signed-1" "alien.accessors" "primitive_alien_signed_1" (( c-ptr n -- value )) }
{ "alien-signed-2" "alien.accessors" "primitive_alien_signed_2" (( c-ptr n -- value )) }
{ "alien-signed-4" "alien.accessors" "primitive_alien_signed_4" (( c-ptr n -- value )) }
{ "alien-signed-8" "alien.accessors" "primitive_alien_signed_8" (( c-ptr n -- value )) }
{ "alien-signed-cell" "alien.accessors" "primitive_alien_signed_cell" (( c-ptr n -- value )) }
{ "alien-unsigned-1" "alien.accessors" "primitive_alien_unsigned_1" (( c-ptr n -- value )) }
{ "alien-unsigned-2" "alien.accessors" "primitive_alien_unsigned_2" (( c-ptr n -- value )) }
{ "alien-unsigned-4" "alien.accessors" "primitive_alien_unsigned_4" (( c-ptr n -- value )) }
{ "alien-unsigned-8" "alien.accessors" "primitive_alien_unsigned_8" (( c-ptr n -- value )) }
{ "alien-unsigned-cell" "alien.accessors" "primitive_alien_unsigned_cell" (( c-ptr n -- value )) }
{ "set-alien-cell" "alien.accessors" "primitive_set_alien_cell" (( value c-ptr n -- )) }
{ "set-alien-double" "alien.accessors" "primitive_set_alien_double" (( value c-ptr n -- )) }
{ "set-alien-float" "alien.accessors" "primitive_set_alien_float" (( value c-ptr n -- )) }
{ "set-alien-signed-1" "alien.accessors" "primitive_set_alien_signed_1" (( value c-ptr n -- )) }
{ "set-alien-signed-2" "alien.accessors" "primitive_set_alien_signed_2" (( value c-ptr n -- )) }
{ "set-alien-signed-4" "alien.accessors" "primitive_set_alien_signed_4" (( value c-ptr n -- )) }
{ "set-alien-signed-8" "alien.accessors" "primitive_set_alien_signed_8" (( value c-ptr n -- )) }
{ "set-alien-signed-cell" "alien.accessors" "primitive_set_alien_signed_cell" (( value c-ptr n -- )) }
{ "set-alien-unsigned-1" "alien.accessors" "primitive_set_alien_unsigned_1" (( value c-ptr n -- )) }
{ "set-alien-unsigned-2" "alien.accessors" "primitive_set_alien_unsigned_2" (( value c-ptr n -- )) }
{ "set-alien-unsigned-4" "alien.accessors" "primitive_set_alien_unsigned_4" (( value c-ptr n -- )) }
{ "set-alien-unsigned-8" "alien.accessors" "primitive_set_alien_unsigned_8" (( value c-ptr n -- )) }
{ "set-alien-unsigned-cell" "alien.accessors" "primitive_set_alien_unsigned_cell" (( value c-ptr n -- )) }
{ "(dlopen)" "alien.libraries" "primitive_dlopen" (( path -- dll )) }
{ "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) }
{ "(dlsym-raw)" "alien.libraries" "primitive_dlsym_raw" (( name dll -- alien )) }
{ "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) }
{ "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) }
{ "current-callback" "alien.private" "primitive_current_callback" (( -- n )) }
{ "<array>" "arrays" "primitive_array" (( n elt -- array )) }
{ "resize-array" "arrays" "primitive_resize_array" (( n array -- new-array )) }
{ "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" (( n -- byte-array )) }
{ "<byte-array>" "byte-arrays" "primitive_byte_array" (( n -- byte-array )) }
{ "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" (( n byte-array -- new-byte-array )) }
{ "<tuple-boa>" "classes.tuple.private" "primitive_tuple_boa" (( slots... layout -- tuple )) }
{ "<tuple>" "classes.tuple.private" "primitive_tuple" (( layout -- tuple )) }
{ "modify-code-heap" "compiler.units" "primitive_modify_code_heap" (( alist update-existing? reset-pics? -- )) }
{ "lookup-method" "generic.single.private" "primitive_lookup_method" (( object methods -- method )) }
{ "mega-cache-miss" "generic.single.private" "primitive_mega_cache_miss" (( methods index cache -- method )) }
{ "(exists?)" "io.files.private" "primitive_existsp" (( path -- ? )) }
{ "(fopen)" "io.streams.c" "primitive_fopen" (( path mode -- alien )) }
{ "fclose" "io.streams.c" "primitive_fclose" (( alien -- )) }
{ "fflush" "io.streams.c" "primitive_fflush" (( alien -- )) }
{ "fgetc" "io.streams.c" "primitive_fgetc" (( alien -- byte/f )) }
{ "fputc" "io.streams.c" "primitive_fputc" (( byte alien -- )) }
{ "fread-unsafe" "io.streams.c" "primitive_fread" (( n buf alien -- count )) }
{ "fseek" "io.streams.c" "primitive_fseek" (( alien offset whence -- )) }
{ "ftell" "io.streams.c" "primitive_ftell" (( alien -- n )) }
{ "fwrite" "io.streams.c" "primitive_fwrite" (( data length alien -- )) }
{ "(clone)" "kernel" "primitive_clone" (( obj -- newobj )) }
{ "<wrapper>" "kernel" "primitive_wrapper" (( obj -- wrapper )) }
{ "callstack" "kernel" "primitive_callstack" (( -- callstack )) }
{ "callstack>array" "kernel" "primitive_callstack_to_array" (( callstack -- array )) }
{ "datastack" "kernel" "primitive_datastack" (( -- array )) }
{ "die" "kernel" "primitive_die" (( -- )) }
{ "retainstack" "kernel" "primitive_retainstack" (( -- array )) }
{ "(identity-hashcode)" "kernel.private" "primitive_identity_hashcode" (( obj -- code )) }
{ "become" "kernel.private" "primitive_become" (( old new -- )) }
{ "callstack-bounds" "kernel.private" "primitive_callstack_bounds" (( -- start end )) }
{ "check-datastack" "kernel.private" "primitive_check_datastack" (( array in# out# -- ? )) }
{ "compute-identity-hashcode" "kernel.private" "primitive_compute_identity_hashcode" (( obj -- )) }
{ "context-object" "kernel.private" "primitive_context_object" (( n -- obj )) }
{ "innermost-frame-executing" "kernel.private" "primitive_innermost_stack_frame_executing" (( callstack -- obj )) }
{ "innermost-frame-scan" "kernel.private" "primitive_innermost_stack_frame_scan" (( callstack -- n )) }
{ "set-context-object" "kernel.private" "primitive_set_context_object" (( obj n -- )) }
{ "set-datastack" "kernel.private" "primitive_set_datastack" (( array -- )) }
{ "set-innermost-frame-quot" "kernel.private" "primitive_set_innermost_stack_frame_quot" (( n callstack -- )) }
{ "set-retainstack" "kernel.private" "primitive_set_retainstack" (( array -- )) }
{ "set-special-object" "kernel.private" "primitive_set_special_object" (( obj n -- )) }
{ "special-object" "kernel.private" "primitive_special_object" (( n -- obj )) }
{ "strip-stack-traces" "kernel.private" "primitive_strip_stack_traces" (( -- )) }
{ "unimplemented" "kernel.private" "primitive_unimplemented" (( -- * )) }
{ "load-locals" "locals.backend" "primitive_load_locals" (( ... n -- )) }
{ "bits>double" "math" "primitive_bits_double" (( n -- x )) }
{ "bits>float" "math" "primitive_bits_float" (( n -- x )) }
{ "double>bits" "math" "primitive_double_bits" (( x -- n )) }
{ "float>bits" "math" "primitive_float_bits" (( x -- n )) }
{ "(format-float)" "math.parser.private" "primitive_format_float" (( n format -- byte-array )) }
{ "bignum*" "math.private" "primitive_bignum_multiply" (( x y -- z )) }
{ "bignum+" "math.private" "primitive_bignum_add" (( x y -- z )) }
{ "bignum-" "math.private" "primitive_bignum_subtract" (( x y -- z )) }
{ "bignum-bit?" "math.private" "primitive_bignum_bitp" (( n x -- ? )) }
{ "bignum-bitand" "math.private" "primitive_bignum_and" (( x y -- z )) }
{ "bignum-bitnot" "math.private" "primitive_bignum_not" (( x -- y )) }
{ "bignum-bitor" "math.private" "primitive_bignum_or" (( x y -- z )) }
{ "bignum-bitxor" "math.private" "primitive_bignum_xor" (( x y -- z )) }
{ "bignum-log2" "math.private" "primitive_bignum_log2" (( x -- n )) }
{ "bignum-mod" "math.private" "primitive_bignum_mod" (( x y -- z )) }
{ "bignum-shift" "math.private" "primitive_bignum_shift" (( x y -- z )) }
{ "bignum/i" "math.private" "primitive_bignum_divint" (( x y -- z )) }
{ "bignum/mod" "math.private" "primitive_bignum_divmod" (( x y -- z w )) }
{ "bignum<" "math.private" "primitive_bignum_less" (( x y -- ? )) }
{ "bignum<=" "math.private" "primitive_bignum_lesseq" (( x y -- ? )) }
{ "bignum=" "math.private" "primitive_bignum_eq" (( x y -- ? )) }
{ "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) }
{ "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) }
{ "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) }
{ "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) }
{ "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) }
{ "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) }
{ "fixnum>bignum" "math.private" "primitive_fixnum_to_bignum" (( x -- y )) }
{ "fixnum>float" "math.private" "primitive_fixnum_to_float" (( x -- y )) }
{ "float*" "math.private" "primitive_float_multiply" (( x y -- z )) }
{ "float+" "math.private" "primitive_float_add" (( x y -- z )) }
{ "float-" "math.private" "primitive_float_subtract" (( x y -- z )) }
{ "float-u<" "math.private" "primitive_float_less" (( x y -- ? )) }
{ "float-u<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) }
{ "float-u>" "math.private" "primitive_float_greater" (( x y -- ? )) }
{ "float-u>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) }
{ "float/f" "math.private" "primitive_float_divfloat" (( x y -- z )) }
{ "float<" "math.private" "primitive_float_less" (( x y -- ? )) }
{ "float<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) }
{ "float=" "math.private" "primitive_float_eq" (( x y -- ? )) }
{ "float>" "math.private" "primitive_float_greater" (( x y -- ? )) }
{ "float>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) }
{ "float>bignum" "math.private" "primitive_float_to_bignum" (( x -- y )) }
{ "float>fixnum" "math.private" "primitive_float_to_fixnum" (( x -- y )) }
{ "all-instances" "memory" "primitive_all_instances" (( -- array )) }
{ "(code-blocks)" "tools.memory.private" "primitive_code_blocks" (( -- array )) }
{ "(code-room)" "tools.memory.private" "primitive_code_room" (( -- code-room )) }
{ "compact-gc" "memory" "primitive_compact_gc" (( -- )) }
{ "(data-room)" "tools.memory.private" "primitive_data_room" (( -- data-room )) }
{ "disable-gc-events" "tools.memory.private" "primitive_disable_gc_events" (( -- events )) }
{ "enable-gc-events" "tools.memory.private" "primitive_enable_gc_events" (( -- )) }
{ "gc" "memory" "primitive_full_gc" (( -- )) }
{ "minor-gc" "memory" "primitive_minor_gc" (( -- )) }
{ "size" "memory" "primitive_size" (( obj -- n )) }
{ "(save-image)" "memory.private" "primitive_save_image" (( path1 path2 -- )) }
{ "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" (( path1 path2 -- )) }
{ "jit-compile" "quotations" "primitive_jit_compile" (( quot -- )) }
{ "quot-compiled?" "quotations" "primitive_quot_compiled_p" (( quot -- ? )) }
{ "quotation-code" "quotations" "primitive_quotation_code" (( quot -- start end )) }
{ "array>quotation" "quotations.private" "primitive_array_to_quotation" (( array -- quot )) }
{ "set-slot" "slots.private" "primitive_set_slot" (( value obj n -- )) }
{ "<string>" "strings" "primitive_string" (( n ch -- string )) }
{ "resize-string" "strings" "primitive_resize_string" (( n str -- newstr )) }
{ "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" (( ch n string -- )) }
{ "(exit)" "system" "primitive_exit" (( n -- * )) }
{ "nano-count" "system" "primitive_nano_count" (( -- ns )) }
{ "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
{ "callstack-for" "threads.private" "primitive_callstack_for" (( context -- array )) }
{ "context-object-for" "threads.private" "primitive_context_object_for" (( n context -- obj )) }
{ "datastack-for" "threads.private" "primitive_datastack_for" (( context -- array )) }
{ "retainstack-for" "threads.private" "primitive_retainstack_for" (( context -- array )) }
{ "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) }
{ "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) }
{ "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) }
{ "optimized?" "words" "primitive_optimized_p" (( word -- ? )) }
{ "word-code" "words" "primitive_word_code" (( word -- start end )) }
{ "(word)" "words.private" "primitive_word" (( name vocab hashcode -- word )) }
{ "<callback>" "alien" "primitive_callback" ( return-rewind word -- alien ) }
{ "<displaced-alien>" "alien" "primitive_displaced_alien" ( displacement c-ptr -- alien ) }
{ "alien-address" "alien" "primitive_alien_address" ( c-ptr -- addr ) }
{ "alien-cell" "alien.accessors" "primitive_alien_cell" ( c-ptr n -- value ) }
{ "alien-double" "alien.accessors" "primitive_alien_double" ( c-ptr n -- value ) }
{ "alien-float" "alien.accessors" "primitive_alien_float" ( c-ptr n -- value ) }
{ "alien-signed-1" "alien.accessors" "primitive_alien_signed_1" ( c-ptr n -- value ) }
{ "alien-signed-2" "alien.accessors" "primitive_alien_signed_2" ( c-ptr n -- value ) }
{ "alien-signed-4" "alien.accessors" "primitive_alien_signed_4" ( c-ptr n -- value ) }
{ "alien-signed-8" "alien.accessors" "primitive_alien_signed_8" ( c-ptr n -- value ) }
{ "alien-signed-cell" "alien.accessors" "primitive_alien_signed_cell" ( c-ptr n -- value ) }
{ "alien-unsigned-1" "alien.accessors" "primitive_alien_unsigned_1" ( c-ptr n -- value ) }
{ "alien-unsigned-2" "alien.accessors" "primitive_alien_unsigned_2" ( c-ptr n -- value ) }
{ "alien-unsigned-4" "alien.accessors" "primitive_alien_unsigned_4" ( c-ptr n -- value ) }
{ "alien-unsigned-8" "alien.accessors" "primitive_alien_unsigned_8" ( c-ptr n -- value ) }
{ "alien-unsigned-cell" "alien.accessors" "primitive_alien_unsigned_cell" ( c-ptr n -- value ) }
{ "set-alien-cell" "alien.accessors" "primitive_set_alien_cell" ( value c-ptr n -- ) }
{ "set-alien-double" "alien.accessors" "primitive_set_alien_double" ( value c-ptr n -- ) }
{ "set-alien-float" "alien.accessors" "primitive_set_alien_float" ( value c-ptr n -- ) }
{ "set-alien-signed-1" "alien.accessors" "primitive_set_alien_signed_1" ( value c-ptr n -- ) }
{ "set-alien-signed-2" "alien.accessors" "primitive_set_alien_signed_2" ( value c-ptr n -- ) }
{ "set-alien-signed-4" "alien.accessors" "primitive_set_alien_signed_4" ( value c-ptr n -- ) }
{ "set-alien-signed-8" "alien.accessors" "primitive_set_alien_signed_8" ( value c-ptr n -- ) }
{ "set-alien-signed-cell" "alien.accessors" "primitive_set_alien_signed_cell" ( value c-ptr n -- ) }
{ "set-alien-unsigned-1" "alien.accessors" "primitive_set_alien_unsigned_1" ( value c-ptr n -- ) }
{ "set-alien-unsigned-2" "alien.accessors" "primitive_set_alien_unsigned_2" ( value c-ptr n -- ) }
{ "set-alien-unsigned-4" "alien.accessors" "primitive_set_alien_unsigned_4" ( value c-ptr n -- ) }
{ "set-alien-unsigned-8" "alien.accessors" "primitive_set_alien_unsigned_8" ( value c-ptr n -- ) }
{ "set-alien-unsigned-cell" "alien.accessors" "primitive_set_alien_unsigned_cell" ( value c-ptr n -- ) }
{ "(dlopen)" "alien.libraries" "primitive_dlopen" ( path -- dll ) }
{ "(dlsym)" "alien.libraries" "primitive_dlsym" ( name dll -- alien ) }
{ "(dlsym-raw)" "alien.libraries" "primitive_dlsym_raw" ( name dll -- alien ) }
{ "dlclose" "alien.libraries" "primitive_dlclose" ( dll -- ) }
{ "dll-valid?" "alien.libraries" "primitive_dll_validp" ( dll -- ? ) }
{ "current-callback" "alien.private" "primitive_current_callback" ( -- n ) }
{ "<array>" "arrays" "primitive_array" ( n elt -- array ) }
{ "resize-array" "arrays" "primitive_resize_array" ( n array -- new-array ) }
{ "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" ( n -- byte-array ) }
{ "<byte-array>" "byte-arrays" "primitive_byte_array" ( n -- byte-array ) }
{ "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" ( n byte-array -- new-byte-array ) }
{ "<tuple-boa>" "classes.tuple.private" "primitive_tuple_boa" ( slots... layout -- tuple ) }
{ "<tuple>" "classes.tuple.private" "primitive_tuple" ( layout -- tuple ) }
{ "modify-code-heap" "compiler.units" "primitive_modify_code_heap" ( alist update-existing? reset-pics? -- ) }
{ "lookup-method" "generic.single.private" "primitive_lookup_method" ( object methods -- method ) }
{ "mega-cache-miss" "generic.single.private" "primitive_mega_cache_miss" ( methods index cache -- method ) }
{ "(exists?)" "io.files.private" "primitive_existsp" ( path -- ? ) }
{ "(fopen)" "io.streams.c" "primitive_fopen" ( path mode -- alien ) }
{ "fclose" "io.streams.c" "primitive_fclose" ( alien -- ) }
{ "fflush" "io.streams.c" "primitive_fflush" ( alien -- ) }
{ "fgetc" "io.streams.c" "primitive_fgetc" ( alien -- byte/f ) }
{ "fputc" "io.streams.c" "primitive_fputc" ( byte alien -- ) }
{ "fread-unsafe" "io.streams.c" "primitive_fread" ( n buf alien -- count ) }
{ "fseek" "io.streams.c" "primitive_fseek" ( alien offset whence -- ) }
{ "ftell" "io.streams.c" "primitive_ftell" ( alien -- n ) }
{ "fwrite" "io.streams.c" "primitive_fwrite" ( data length alien -- ) }
{ "(clone)" "kernel" "primitive_clone" ( obj -- newobj ) }
{ "<wrapper>" "kernel" "primitive_wrapper" ( obj -- wrapper ) }
{ "callstack" "kernel" "primitive_callstack" ( -- callstack ) }
{ "callstack>array" "kernel" "primitive_callstack_to_array" ( callstack -- array ) }
{ "datastack" "kernel" "primitive_datastack" ( -- array ) }
{ "die" "kernel" "primitive_die" ( -- ) }
{ "retainstack" "kernel" "primitive_retainstack" ( -- array ) }
{ "(identity-hashcode)" "kernel.private" "primitive_identity_hashcode" ( obj -- code ) }
{ "become" "kernel.private" "primitive_become" ( old new -- ) }
{ "callstack-bounds" "kernel.private" "primitive_callstack_bounds" ( -- start end ) }
{ "check-datastack" "kernel.private" "primitive_check_datastack" ( array in# out# -- ? ) }
{ "compute-identity-hashcode" "kernel.private" "primitive_compute_identity_hashcode" ( obj -- ) }
{ "context-object" "kernel.private" "primitive_context_object" ( n -- obj ) }
{ "innermost-frame-executing" "kernel.private" "primitive_innermost_stack_frame_executing" ( callstack -- obj ) }
{ "innermost-frame-scan" "kernel.private" "primitive_innermost_stack_frame_scan" ( callstack -- n ) }
{ "set-context-object" "kernel.private" "primitive_set_context_object" ( obj n -- ) }
{ "set-datastack" "kernel.private" "primitive_set_datastack" ( array -- ) }
{ "set-innermost-frame-quot" "kernel.private" "primitive_set_innermost_stack_frame_quot" ( n callstack -- ) }
{ "set-retainstack" "kernel.private" "primitive_set_retainstack" ( array -- ) }
{ "set-special-object" "kernel.private" "primitive_set_special_object" ( obj n -- ) }
{ "special-object" "kernel.private" "primitive_special_object" ( n -- obj ) }
{ "strip-stack-traces" "kernel.private" "primitive_strip_stack_traces" ( -- ) }
{ "unimplemented" "kernel.private" "primitive_unimplemented" ( -- * ) }
{ "load-locals" "locals.backend" "primitive_load_locals" ( ... n -- ) }
{ "bits>double" "math" "primitive_bits_double" ( n -- x ) }
{ "bits>float" "math" "primitive_bits_float" ( n -- x ) }
{ "double>bits" "math" "primitive_double_bits" ( x -- n ) }
{ "float>bits" "math" "primitive_float_bits" ( x -- n ) }
{ "(format-float)" "math.parser.private" "primitive_format_float" ( n format -- byte-array ) }
{ "bignum*" "math.private" "primitive_bignum_multiply" ( x y -- z ) }
{ "bignum+" "math.private" "primitive_bignum_add" ( x y -- z ) }
{ "bignum-" "math.private" "primitive_bignum_subtract" ( x y -- z ) }
{ "bignum-bit?" "math.private" "primitive_bignum_bitp" ( n x -- ? ) }
{ "bignum-bitand" "math.private" "primitive_bignum_and" ( x y -- z ) }
{ "bignum-bitnot" "math.private" "primitive_bignum_not" ( x -- y ) }
{ "bignum-bitor" "math.private" "primitive_bignum_or" ( x y -- z ) }
{ "bignum-bitxor" "math.private" "primitive_bignum_xor" ( x y -- z ) }
{ "bignum-log2" "math.private" "primitive_bignum_log2" ( x -- n ) }
{ "bignum-mod" "math.private" "primitive_bignum_mod" ( x y -- z ) }
{ "bignum-shift" "math.private" "primitive_bignum_shift" ( x y -- z ) }
{ "bignum/i" "math.private" "primitive_bignum_divint" ( x y -- z ) }
{ "bignum/mod" "math.private" "primitive_bignum_divmod" ( x y -- z w ) }
{ "bignum<" "math.private" "primitive_bignum_less" ( x y -- ? ) }
{ "bignum<=" "math.private" "primitive_bignum_lesseq" ( x y -- ? ) }
{ "bignum=" "math.private" "primitive_bignum_eq" ( x y -- ? ) }
{ "bignum>" "math.private" "primitive_bignum_greater" ( x y -- ? ) }
{ "bignum>=" "math.private" "primitive_bignum_greatereq" ( x y -- ? ) }
{ "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" ( x -- y ) }
{ "fixnum-shift" "math.private" "primitive_fixnum_shift" ( x y -- z ) }
{ "fixnum/i" "math.private" "primitive_fixnum_divint" ( x y -- z ) }
{ "fixnum/mod" "math.private" "primitive_fixnum_divmod" ( x y -- z w ) }
{ "fixnum>bignum" "math.private" "primitive_fixnum_to_bignum" ( x -- y ) }
{ "fixnum>float" "math.private" "primitive_fixnum_to_float" ( x -- y ) }
{ "float*" "math.private" "primitive_float_multiply" ( x y -- z ) }
{ "float+" "math.private" "primitive_float_add" ( x y -- z ) }
{ "float-" "math.private" "primitive_float_subtract" ( x y -- z ) }
{ "float-u<" "math.private" "primitive_float_less" ( x y -- ? ) }
{ "float-u<=" "math.private" "primitive_float_lesseq" ( x y -- ? ) }
{ "float-u>" "math.private" "primitive_float_greater" ( x y -- ? ) }
{ "float-u>=" "math.private" "primitive_float_greatereq" ( x y -- ? ) }
{ "float/f" "math.private" "primitive_float_divfloat" ( x y -- z ) }
{ "float<" "math.private" "primitive_float_less" ( x y -- ? ) }
{ "float<=" "math.private" "primitive_float_lesseq" ( x y -- ? ) }
{ "float=" "math.private" "primitive_float_eq" ( x y -- ? ) }
{ "float>" "math.private" "primitive_float_greater" ( x y -- ? ) }
{ "float>=" "math.private" "primitive_float_greatereq" ( x y -- ? ) }
{ "float>bignum" "math.private" "primitive_float_to_bignum" ( x -- y ) }
{ "float>fixnum" "math.private" "primitive_float_to_fixnum" ( x -- y ) }
{ "all-instances" "memory" "primitive_all_instances" ( -- array ) }
{ "(code-blocks)" "tools.memory.private" "primitive_code_blocks" ( -- array ) }
{ "(code-room)" "tools.memory.private" "primitive_code_room" ( -- code-room ) }
{ "compact-gc" "memory" "primitive_compact_gc" ( -- ) }
{ "(data-room)" "tools.memory.private" "primitive_data_room" ( -- data-room ) }
{ "disable-gc-events" "tools.memory.private" "primitive_disable_gc_events" ( -- events ) }
{ "enable-gc-events" "tools.memory.private" "primitive_enable_gc_events" ( -- ) }
{ "gc" "memory" "primitive_full_gc" ( -- ) }
{ "minor-gc" "memory" "primitive_minor_gc" ( -- ) }
{ "size" "memory" "primitive_size" ( obj -- n ) }
{ "(save-image)" "memory.private" "primitive_save_image" ( path1 path2 -- ) }
{ "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" ( path1 path2 -- ) }
{ "jit-compile" "quotations" "primitive_jit_compile" ( quot -- ) }
{ "quot-compiled?" "quotations" "primitive_quot_compiled_p" ( quot -- ? ) }
{ "quotation-code" "quotations" "primitive_quotation_code" ( quot -- start end ) }
{ "array>quotation" "quotations.private" "primitive_array_to_quotation" ( array -- quot ) }
{ "set-slot" "slots.private" "primitive_set_slot" ( value obj n -- ) }
{ "<string>" "strings" "primitive_string" ( n ch -- string ) }
{ "resize-string" "strings" "primitive_resize_string" ( n str -- newstr ) }
{ "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" ( ch n string -- ) }
{ "(exit)" "system" "primitive_exit" ( n -- * ) }
{ "nano-count" "system" "primitive_nano_count" ( -- ns ) }
{ "(sleep)" "threads.private" "primitive_sleep" ( nanos -- ) }
{ "callstack-for" "threads.private" "primitive_callstack_for" ( context -- array ) }
{ "context-object-for" "threads.private" "primitive_context_object_for" ( n context -- obj ) }
{ "datastack-for" "threads.private" "primitive_datastack_for" ( context -- array ) }
{ "retainstack-for" "threads.private" "primitive_retainstack_for" ( context -- array ) }
{ "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" ( -- stats ) }
{ "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" ( -- ) }
{ "profiling" "tools.profiler.private" "primitive_profiling" ( ? -- ) }
{ "optimized?" "words" "primitive_optimized_p" ( word -- ? ) }
{ "word-code" "words" "primitive_word_code" ( word -- start end ) }
{ "(word)" "words.private" "primitive_word" ( name vocab hashcode -- word ) }
} [ first4 make-primitive ] each
! Bump build number
"build" "kernel" create build 1 + [ ] curry (( -- n )) define-declared
"build" "kernel" create build 1 + [ ] curry ( -- n ) define-declared
] with-compilation-unit

2
core/classes/classes.factor
View File

@ -78,7 +78,7 @@ M: predicate reset-word
[ call-next-method ] [ f "predicating" set-word-prop ] bi ;
: define-predicate ( class quot -- )
[ predicate-word ] dip (( object -- ? )) define-declared ;
[ predicate-word ] dip ( object -- ? ) define-declared ;
: superclass ( class -- super )
#! Output f for non-classes to work with algebra code

2
core/classes/tuple/tuple-tests.factor
View File

@ -714,7 +714,7 @@ DEFER: redefine-tuple-twice
ERROR: base-error x y ;
ERROR: derived-error < base-error z ;
[ (( x y z -- * )) ] [ \ derived-error stack-effect ] unit-test
[ ( x y z -- * ) ] [ \ derived-error stack-effect ] unit-test
! Make sure that tuple reshaping updates code heap roots
TUPLE: code-heap-ref ;

2
core/classes/tuple/tuple.factor
View File

@ -16,7 +16,7 @@ ERROR: not-a-tuple object ;
: all-slots ( class -- slots )
superclasses [ "slots" word-prop ] map concat ;
PREDICATE: immutable-tuple-class < tuple-class ( class -- ? )
PREDICATE: immutable-tuple-class < tuple-class
all-slots [ read-only>> ] all? ;
<PRIVATE

4
core/combinators/combinators-docs.factor
View File

@ -234,7 +234,7 @@ HELP: call-effect
"The following two lines are equivalent:"
{ $code
"call( a b -- c )"
"(( a b -- c )) call-effect"
"( a b -- c ) call-effect"
}
} ;
@ -245,7 +245,7 @@ HELP: execute-effect
"The following two lines are equivalent:"
{ $code
"execute( a b -- c )"
"(( a b -- c )) execute-effect"
"( a b -- c ) execute-effect"
}
} ;

4
core/combinators/combinators-tests.factor
View File

@ -253,7 +253,7 @@ CONSTANT: case-const-2 2
DEFER: corner-case-1
<< \ corner-case-1 2 [ + ] curry 1array [ case ] curry (( a -- b )) define-declared >>
<< \ corner-case-1 2 [ + ] curry 1array [ case ] curry ( a -- b ) define-declared >>
[ t ] [ \ corner-case-1 optimized? ] unit-test
@ -321,6 +321,6 @@ DEFER: corner-case-1
[ "nachos" ] [ 33 test-case-12 ] unit-test
[ "nachos" ] [ 33 \ test-case-12 def>> call ] unit-test
[ (( x x -- x x )) ] [
[ ( x x -- x x ) ] [
[ { [ ] [ ] } spread ] infer
] unit-test

2
core/combinators/combinators.factor
View File

@ -17,7 +17,7 @@ IN: combinators
M: object throw
5 special-object [ die ] or
(( error -- * )) call-effect-unsafe ;
( error -- * ) call-effect-unsafe ;
PRIVATE>

2
core/compiler/units/units-tests.factor
View File

@ -40,7 +40,7 @@ SYMBOL: counter
M: observer definitions-changed 2drop global [ counter inc ] bind ;
[ gensym [ ] (( -- )) define-declared ] with-compilation-unit
[ gensym [ ] ( -- ) define-declared ] with-compilation-unit
[ 1 ] [ counter get-global ] unit-test

6
core/continuations/continuations.factor
View File

@ -10,7 +10,7 @@ IN: continuations
[ [ datastack ] dip swap [ { } like set-datastack ] dip ] dip
swap [ call datastack ] dip
swap [ set-datastack ] dip
] (( stack quot -- new-stack )) call-effect-unsafe ;
] ( stack quot -- new-stack ) call-effect-unsafe ;
SYMBOL: original-error
SYMBOL: error
@ -68,7 +68,7 @@ PRIVATE>
set-retainstack
[ set-datastack ] dip
set-callstack
] (( continuation -- * )) call-effect-unsafe ;
] ( continuation -- * ) call-effect-unsafe ;
PRIVATE>
@ -81,7 +81,7 @@ PRIVATE>
set-retainstack
[ set-datastack drop 4 special-object f 4 set-special-object f ] dip
set-callstack
] (( obj continuation -- * )) call-effect-unsafe ;
] ( obj continuation -- * ) call-effect-unsafe ;
: continue ( continuation -- * )
f swap continue-with ;

22
core/effects/effects-docs.factor
View File

@ -50,13 +50,13 @@ HELP: <effect>
{ $notes "This word cannot construct effects with " { $link "effects-variables" } ". Use " { $link <variable-effect> } " to construct variable stack effects." }
{ $examples
{ $example """USING: effects prettyprint ;
{ "a" "b" } { "c" } <effect> .""" """(( a b -- c ))""" }
{ "a" "b" } { "c" } <effect> .""" """( a b -- c )""" }
{ $example """USING: arrays effects prettyprint ;
{ "a" { "b" array } } { "c" } <effect> .""" """(( a b: array -- c ))""" }
{ "a" { "b" array } } { "c" } <effect> .""" """( a b: array -- c )""" }
{ $example """USING: effects prettyprint ;
{ "a" { "b" (( x y -- z )) } } { "c" } <effect> .""" """(( a b: ( x y -- z ) -- c ))""" }
{ "a" { "b" ( x y -- z ) } } { "c" } <effect> .""" """( a b: ( x y -- z ) -- c )""" }
{ $example """USING: effects prettyprint ;
{ "a" { "b" (( x y -- z )) } } { "*" } <effect> .""" """(( a b: ( x y -- z ) -- * ))""" }
{ "a" { "b" ( x y -- z ) } } { "*" } <effect> .""" """( a b: ( x y -- z ) -- * )""" }
} ;
HELP: <terminated-effect>
@ -70,9 +70,9 @@ HELP: <terminated-effect>
{ $notes "This word cannot construct effects with " { $link "effects-variables" } ". Use " { $link <variable-effect> } " to construct variable stack effects." }
{ $examples
{ $example """USING: effects prettyprint ;
{ "a" { "b" (( x y -- z )) } } { "c" } f <terminated-effect> .""" """(( a b: ( x y -- z ) -- c ))""" }
{ "a" { "b" ( x y -- z ) } } { "c" } f <terminated-effect> .""" """( a b: ( x y -- z ) -- c )""" }
{ $example """USING: effects prettyprint ;
{ "a" { "b" (( x y -- z )) } } { } t <terminated-effect> .""" """(( a b: ( x y -- z ) -- * ))""" }
{ "a" { "b" ( x y -- z ) } } { } t <terminated-effect> .""" """( a b: ( x y -- z ) -- * )""" }
} ;
HELP: <variable-effect>
@ -86,13 +86,13 @@ HELP: <variable-effect>
{ $description "Constructs an " { $link effect } " object like " { $link <effect> } ". If " { $snippet "in-var" } " or " { $snippet "out-var" } " are not " { $link f } ", they are used as the names of the " { $link "effects-variables" } " for the inputs and outputs of the effect object." }
{ $examples
{ $example """USING: effects prettyprint ;
f { "a" "b" } f { "c" } <variable-effect> .""" """(( a b -- c ))""" }
f { "a" "b" } f { "c" } <variable-effect> .""" """( a b -- c )""" }
{ $example """USING: effects prettyprint ;
"x" { "a" "b" } "y" { "c" } <variable-effect> .""" """(( ..x a b -- ..y c ))""" }
"x" { "a" "b" } "y" { "c" } <variable-effect> .""" """( ..x a b -- ..y c )""" }
{ $example """USING: arrays effects prettyprint ;
"y" { "a" { "b" (( ..x -- ..y )) } } "x" { "c" } <variable-effect> .""" """(( ..y a b: ( ..x -- ..y ) -- ..x c ))""" }
"y" { "a" { "b" ( ..x -- ..y ) } } "x" { "c" } <variable-effect> .""" """( ..y a b: ( ..x -- ..y ) -- ..x c )""" }
{ $example """USING: effects prettyprint ;
"." { "a" "b" } f { "*" } <variable-effect> .""" """(( ... a b -- * ))""" }
"." { "a" "b" } f { "*" } <variable-effect> .""" """( ... a b -- * )""" }
} ;
@ -131,7 +131,7 @@ HELP: effect=
{ $values { "effect1" effect } { "effect2" effect } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "effect1" } " and " { $snippet "effect2" } " represent the same stack transformation, without looking parameter names." }
{ $examples
{ $example "USING: effects prettyprint ;" "(( a -- b )) (( x -- y )) effect= ." "t" }
{ $example "USING: effects prettyprint ;" "( a -- b ) ( x -- y ) effect= ." "t" }
} ;
HELP: effect>string

62
core/effects/effects-tests.factor
View File

@ -7,45 +7,45 @@ IN: effects.tests
[ t ] [ { "a" "b" } { "a" "b" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
[ f ] [ { "a" "b" "c" } { "a" "b" "c" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
[ f ] [ { "a" "b" } { "a" "b" "c" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
[ 2 ] [ (( a b -- c )) in>> length ] unit-test
[ 1 ] [ (( a b -- c )) out>> length ] unit-test
[ 2 ] [ ( a b -- c ) in>> length ] unit-test
[ 1 ] [ ( a b -- c ) out>> length ] unit-test
[ t ] [ (( a b -- c )) (( ... a b -- ... c )) effect<= ] unit-test
[ t ] [ (( b -- )) (( ... a b -- ... c )) effect<= ] unit-test
[ f ] [ (( ... a b -- ... c )) (( a b -- c )) effect<= ] unit-test
[ f ] [ (( ... b -- ... )) (( a b -- c )) effect<= ] unit-test
[ f ] [ (( a b -- c )) (( ... a b -- c )) effect<= ] unit-test
[ f ] [ (( a b -- c )) (( ..x a b -- ..y c )) effect<= ] unit-test
[ t ] [ ( a b -- c ) ( ... a b -- ... c ) effect<= ] unit-test
[ t ] [ ( b -- ) ( ... a b -- ... c ) effect<= ] unit-test
[ f ] [ ( ... a b -- ... c ) ( a b -- c ) effect<= ] unit-test
[ f ] [ ( ... b -- ... ) ( a b -- c ) effect<= ] unit-test
[ f ] [ ( a b -- c ) ( ... a b -- c ) effect<= ] unit-test
[ f ] [ ( a b -- c ) ( ..x a b -- ..y c ) effect<= ] unit-test
[ "(( object -- object ))" ] [ { f } { f } <effect> unparse ] unit-test
[ "(( a b -- c d ))" ] [ { "a" "b" } { "c" "d" } <effect> unparse ] unit-test
[ "(( -- c d ))" ] [ { } { "c" "d" } <effect> unparse ] unit-test
[ "(( a b -- ))" ] [ { "a" "b" } { } <effect> unparse ] unit-test
[ "(( -- ))" ] [ { } { } <effect> unparse ] unit-test
[ "(( a b -- c ))" ] [ (( a b -- c )) unparse ] unit-test
[ "( object -- object )" ] [ { f } { f } <effect> unparse ] unit-test
[ "( a b -- c d )" ] [ { "a" "b" } { "c" "d" } <effect> unparse ] unit-test
[ "( -- c d )" ] [ { } { "c" "d" } <effect> unparse ] unit-test
[ "( a b -- )" ] [ { "a" "b" } { } <effect> unparse ] unit-test
[ "( -- )" ] [ { } { } <effect> unparse ] unit-test
[ "( a b -- c )" ] [ ( a b -- c ) unparse ] unit-test
[ { "x" "y" } ] [ { "y" "x" } (( a b -- b a )) shuffle ] unit-test
[ { "y" "x" "y" } ] [ { "y" "x" } (( a b -- a b a )) shuffle ] unit-test
[ { } ] [ { "y" "x" } (( a b -- )) shuffle ] unit-test
[ { "x" "y" } ] [ { "y" "x" } ( a b -- b a ) shuffle ] unit-test
[ { "y" "x" "y" } ] [ { "y" "x" } ( a b -- a b a ) shuffle ] unit-test
[ { } ] [ { "y" "x" } ( a b -- ) shuffle ] unit-test
[ t ] [ (( -- )) (( -- )) compose-effects (( -- )) effect= ] unit-test
[ t ] [ (( -- * )) (( -- )) compose-effects (( -- * )) effect= ] unit-test
[ t ] [ (( -- )) (( -- * )) compose-effects (( -- * )) effect= ] unit-test
[ t ] [ ( -- ) ( -- ) compose-effects ( -- ) effect= ] unit-test
[ t ] [ ( -- * ) ( -- ) compose-effects ( -- * ) effect= ] unit-test
[ t ] [ ( -- ) ( -- * ) compose-effects ( -- * ) effect= ] unit-test
[ { object object } ] [ (( a b -- )) effect-in-types ] unit-test
[ { object sequence } ] [ (( a b: sequence -- )) effect-in-types ] unit-test
[ { object object } ] [ ( a b -- ) effect-in-types ] unit-test
[ { object sequence } ] [ ( a b: sequence -- ) effect-in-types ] unit-test
[ f ] [ (( a b c -- d )) in-var>> ] unit-test
[ f ] [ (( -- d )) in-var>> ] unit-test
[ "a" ] [ (( ..a b c -- d )) in-var>> ] unit-test
[ { "b" "c" } ] [ (( ..a b c -- d )) in>> ] unit-test
[ f ] [ ( a b c -- d ) in-var>> ] unit-test
[ f ] [ ( -- d ) in-var>> ] unit-test
[ "a" ] [ ( ..a b c -- d ) in-var>> ] unit-test
[ { "b" "c" } ] [ ( ..a b c -- d ) in>> ] unit-test
[ f ] [ (( ..a b c -- e )) out-var>> ] unit-test
[ "d" ] [ (( ..a b c -- ..d e )) out-var>> ] unit-test
[ { "e" } ] [ (( ..a b c -- ..d e )) out>> ] unit-test
[ f ] [ ( ..a b c -- e ) out-var>> ] unit-test
[ "d" ] [ ( ..a b c -- ..d e ) out-var>> ] unit-test
[ { "e" } ] [ ( ..a b c -- ..d e ) out>> ] unit-test
[ "(( a ..b c -- d ))" eval( -- effect ) ]
[ "( a ..b c -- d )" eval( -- effect ) ]
[ error>> invalid-row-variable? ] must-fail-with
[ "(( ..a: integer b c -- d ))" eval( -- effect ) ]
[ "( ..a: integer b c -- d )" eval( -- effect ) ]
[ error>> row-variable-can't-have-type? ] must-fail-with

2
core/effects/effects.factor
View File

@ -92,7 +92,7 @@ M: word stack-effect
[ "declared-effect" word-prop ]
[ parent-word dup [ stack-effect ] when ] bi or ;
M: deferred stack-effect call-next-method (( -- * )) or ;
M: deferred stack-effect call-next-method ( -- * ) or ;
M: effect clone
[ in>> clone ] [ out>> clone ] bi <effect> ;

2
core/effects/parser/parser-docs.factor
View File

@ -4,6 +4,6 @@ USING: strings effects help.markup help.syntax ;
HELP: parse-effect
{ $values { "end" string } { "effect" "an instance of " { $link effect } } }
{ $description "Parses a stack effect from the current input line." }
{ $examples "This word is used by " { $link POSTPONE: ( } " and " { $link POSTPONE: (( } " to parse stack effect declarations." }
{ $examples "This word is used by " { $link POSTPONE: ( } " to parse stack effect declarations." }
$parsing-note ;

2
core/generic/math/math.factor
View File

@ -122,7 +122,7 @@ M: math-combination perform-combination
define
] with-variable ;
PREDICATE: math-generic < generic ( word -- ? )
PREDICATE: math-generic < generic
"combination" word-prop math-combination? ;
M: math-generic definer drop \ MATH: f ;

16
core/generic/parser/parser-tests.factor
View File

@ -2,12 +2,12 @@ USING: generic.parser tools.test ;
IN: generic.parser.tests
[ t ] [ (( -- )) (( -- )) method-effect= ] unit-test
[ t ] [ (( a -- b )) (( x -- y )) method-effect= ] unit-test
[ f ] [ (( a b -- c )) (( x -- y )) method-effect= ] unit-test
[ f ] [ (( a -- b )) (( x y -- z )) method-effect= ] unit-test
[ t ] [ ( -- ) ( -- ) method-effect= ] unit-test
[ t ] [ ( a -- b ) ( x -- y ) method-effect= ] unit-test
[ f ] [ ( a b -- c ) ( x -- y ) method-effect= ] unit-test
[ f ] [ ( a -- b ) ( x y -- z ) method-effect= ] unit-test
[ t ] [ (( -- * )) (( -- )) method-effect= ] unit-test
[ f ] [ (( -- * )) (( x -- y )) method-effect= ] unit-test
[ t ] [ (( x -- * )) (( x -- y )) method-effect= ] unit-test
[ t ] [ (( x -- * )) (( x -- y z )) method-effect= ] unit-test
[ t ] [ ( -- * ) ( -- ) method-effect= ] unit-test
[ f ] [ ( -- * ) ( x -- y ) method-effect= ] unit-test
[ t ] [ ( x -- * ) ( x -- y ) method-effect= ] unit-test
[ t ] [ ( x -- * ) ( x -- y z ) method-effect= ] unit-test

4
core/parser/parser-tests.factor
View File

@ -337,7 +337,7 @@ DEFER: foo
] must-fail
[ ] [
"IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" eval( -- )
"IN: parser.tests USE: kernel PREDICATE: foo < object ;" eval( -- )
] unit-test
[ t ] [
@ -543,7 +543,7 @@ EXCLUDE: qualified.tests.bar => x ;
[ t ] [ "was-once-a-word-bug" "parser.tests" lookup >boolean ] unit-test
[ [ ] ] [
"IN: parser.tests USE: words << \"was-once-a-word-bug\" \"parser.tests\" create [ ] (( -- )) define-declared >>"
"IN: parser.tests USE: words << \"was-once-a-word-bug\" \"parser.tests\" create [ ] ( -- ) define-declared >>"
<string-reader> "was-once-a-word-test" parse-stream
] unit-test

2
core/parser/parser.factor
View File

@ -15,7 +15,7 @@ IN: parser
: save-location ( definition -- )
location remember-definition ;
M: parsing-word stack-effect drop (( parsed -- parsed )) ;
M: parsing-word stack-effect drop ( parsed -- parsed ) ;
: create-in ( str -- word )
current-vocab create dup set-word dup save-location ;

8
core/slots/slots.factor
View File

@ -45,7 +45,7 @@ M: object reader-quot
"reading" associate ;
: define-reader-generic ( name -- )
reader-word (( object -- value )) define-simple-generic ;
reader-word ( object -- value ) define-simple-generic ;
: define-reader ( class slot-spec -- )
[ nip name>> define-reader-generic ]
@ -92,7 +92,7 @@ M: object writer-quot
"writing" associate ;
: define-writer-generic ( name -- )
writer-word (( value object -- )) define-simple-generic ;
writer-word ( value object -- ) define-simple-generic ;
: define-writer ( class slot-spec -- )
[ nip name>> define-writer-generic ] [
@ -110,7 +110,7 @@ M: object writer-quot
: define-setter ( name -- )
dup setter-word dup deferred? [
[ \ over , swap writer-word , ] [ ] make
(( object value -- object )) define-inline
( object value -- object ) define-inline
] [ 2drop ] if ;
: changer-word ( name -- word )
@ -123,7 +123,7 @@ M: object writer-quot
over reader-word 1quotation
[ dip call ] curry [ ] like [ dip swap ] curry %
swap setter-word ,
] [ ] make (( object quot -- object )) define-inline
] [ ] make ( object quot -- object ) define-inline
] [ 2drop ] if ;
: define-slot-methods ( class slot-spec -- )

4
core/source-files/errors/errors-tests.factor
View File

@ -4,7 +4,7 @@ IN: source-files.errors.tests
DEFER: forget-test
[ ] [ [ \ forget-test [ 1 ] (( -- )) define-declared ] with-compilation-unit ] unit-test
[ ] [ [ \ forget-test [ 1 ] ( -- ) define-declared ] with-compilation-unit ] unit-test
[ t ] [ \ forget-test compiler-errors get key? ] unit-test
[ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test
[ f ] [ \ forget-test compiler-errors get key? ] unit-test
[ f ] [ \ forget-test compiler-errors get key? ] unit-test

16
core/syntax/syntax-docs.factor
View File

@ -214,7 +214,7 @@ ARTICLE: "syntax-pathnames" "Pathname syntax"
ARTICLE: "syntax-effects" "Stack effect syntax"
"Note that this is " { $emphasis "not" } " syntax to declare stack effects of words. This pushes an " { $link effect } " instance on the stack for reflection, for use with words such as " { $link define-declared } ", " { $link call-effect } " and " { $link execute-effect } "."
{ $subsections POSTPONE: (( }
{ $subsections POSTPONE: ( }
{ $see-also "effects" "inference" "tools.inference" } ;
ARTICLE: "syntax-literals" "Literals"
@ -625,13 +625,7 @@ HELP: P"
HELP: (
{ $syntax "( inputs -- outputs )" }
{ $values { "inputs" "a list of tokens" } { "outputs" "a list of tokens" } }
{ $description "A stack effect declaration. This is treated as a comment unless it appears inside a word definition." }
{ $see-also "effects" } ;
HELP: ((
{ $syntax "(( inputs -- outputs ))" }
{ $values { "inputs" "a list of tokens" } { "outputs" "a list of tokens" } }
{ $description "Literal stack effect syntax." }
{ $description "Literal stack effect syntax. Also used by syntax words (such as " { $link POSTPONE: : } "), typically declaring the stack effect of the word definition which follows." }
{ $notes "Useful for meta-programming with " { $link define-declared } "." }
{ $examples
{ $example
@ -642,13 +636,15 @@ HELP: ((
""
"["
" my-dynamic-word 2 { [ + ] [ * ] } random curry"
" (( x -- y )) define-declared"
" ( x -- y ) define-declared"
"] with-compilation-unit"
""
"2 my-dynamic-word ."
"4"
}
} ;
}
{ $see-also "effects" }
;
HELP: !
{ $syntax "! comment..." }

6
core/syntax/syntax.factor
View File

@ -226,11 +226,7 @@ IN: bootstrap.syntax
] define-core-syntax
"(" [
")" parse-effect drop
] define-core-syntax
"((" [
"))" parse-effect suffix!
")" parse-effect suffix!
] define-core-syntax
"MAIN:" [

2
core/words/alias/alias-tests.factor
View File

@ -3,4 +3,4 @@ IN: words.alias.tests
ALIAS: foo +
[ ] [ "IN: words.alias.tests CONSTANT: foo 5" eval( -- ) ] unit-test
[ (( -- value )) ] [ \ foo stack-effect ] unit-test
[ ( -- value ) ] [ \ foo stack-effect ] unit-test

4
core/words/constant/constant.factor
View File

@ -7,11 +7,11 @@ PREDICATE: constant < word "constant" word-prop >boolean ;
: define-constant ( word value -- )
[ "constant" set-word-prop ]
[ [ ] curry (( -- value )) define-inline ] 2bi ;
[ [ ] curry ( -- value ) define-inline ] 2bi ;
M: constant reset-word
[ call-next-method ] [ f "constant" set-word-prop ] bi ;
M: constant definer drop \ CONSTANT: f ;
M: constant definition "constant" word-prop literalize 1quotation ;
M: constant definition "constant" word-prop literalize 1quotation ;

4
core/words/symbol/symbol.factor
View File

@ -3,7 +3,7 @@
USING: kernel sequences accessors definitions words ;
IN: words.symbol
PREDICATE: symbol < word ( obj -- ? )
PREDICATE: symbol < word
[ def>> ] [ [ ] curry ] bi sequence= ;
M: symbol definer drop \ SYMBOL: f ;
@ -11,4 +11,4 @@ M: symbol definer drop \ SYMBOL: f ;
M: symbol definition drop f ;
: define-symbol ( word -- )
dup [ ] curry (( -- value )) define-inline ;
dup [ ] curry ( -- value ) define-inline ;

2
core/words/words-docs.factor
View File

@ -330,7 +330,7 @@ HELP: define-temp
{ $notes
"The following phrases are equivalent:"
{ $code "[ 2 2 + . ] call" }
{ $code "[ 2 2 + . ] (( -- )) define-temp execute" }
{ $code "[ 2 2 + . ] ( -- ) define-temp execute" }
"This word must be called from inside " { $link with-compilation-unit } "."
} ;

2
core/words/words-tests.factor
View File

@ -6,7 +6,7 @@ IN: words.tests
[ 4 ] [
[
"poo" "words.tests" create [ 2 2 + ] (( -- n )) define-declared
"poo" "words.tests" create [ 2 2 + ] ( -- n ) define-declared
] with-compilation-unit
"poo" "words.tests" lookup execute
] unit-test

4
core/words/words.factor
View File

@ -51,11 +51,11 @@ TUPLE: undefined word ;
#! above.
[ undefined f ] ;
PREDICATE: deferred < word ( obj -- ? ) def>> undefined-def = ;
PREDICATE: deferred < word def>> undefined-def = ;
M: deferred definer drop \ DEFER: f ;
M: deferred definition drop f ;
PREDICATE: primitive < word ( obj -- ? ) "primitive" word-prop ;
PREDICATE: primitive < word "primitive" word-prop ;
M: primitive definer drop \ PRIMITIVE: f ;
M: primitive definition drop f ;

2
extra/calendar/holidays/holidays.factor
View File

@ -12,7 +12,7 @@ SYNTAX: HOLIDAY:
dup "holiday" word-prop [
dup H{ } clone "holiday" set-word-prop
] unless
parse-definition (( timestamp/n -- timestamp )) define-declared ;
parse-definition ( timestamp/n -- timestamp ) define-declared ;
SYNTAX: HOLIDAY-NAME:
[let scan-word "holiday" word-prop :> holidays scan-word :> name scan-object :> value

2
extra/cpu/8080/emulator/emulator.factor
View File

@ -1391,7 +1391,7 @@ SYMBOL: last-opcode
dup " " join instruction-quotations
[
"_" join [ "emulate-" % % ] "" make create-in dup last-instruction set-global
] dip (( cpu -- )) define-declared ;
] dip ( cpu -- ) define-declared ;
SYNTAX: INSTRUCTION: ";" parse-tokens parse-instructions ;

2
extra/cuda/libraries/libraries.factor
View File

@ -183,7 +183,7 @@ MACRO: cuda-invoke ( module-name function-name arguments -- )
3bi define-inline ;
: define-cuda-global ( word module-name symbol-name -- )
'[ _ _ cuda-global ] (( -- device-ptr )) define-inline ;
'[ _ _ cuda-global ] ( -- device-ptr ) define-inline ;
TUPLE: cuda-library name abi path handle ;
ERROR: bad-cuda-abi abi ;

2
extra/graphviz/notation/notation.factor
View File

@ -24,7 +24,7 @@ IN: graphviz.notation
[ 2nip ] [
create dup
1 <standard-combination>
(( graphviz-obj val -- graphviz-obj' ))
( graphviz-obj val -- graphviz-obj' )
define-generic
] if* ;

4
extra/graphviz/render/render.factor
View File

@ -112,7 +112,7 @@ PRIVATE>
: define-graphviz-by-engine ( -K -- )
[ "graphviz.render" create dup make-inline ]
[ [ graphviz ] curry ] bi
(( graph -O -T -- ))
( graph -O -T -- )
define-declared ;
: define-graphviz-by-format ( -T -- )
@ -121,7 +121,7 @@ PRIVATE>
"graphviz.render" create dup make-inline
]
[ [ graphviz* ] curry ] bi
(( graph -O -- ))
( graph -O -- )
define-declared ;
PRIVATE>

14
extra/html/elements/elements.factor
View File

@ -29,7 +29,7 @@ SYMBOL: html
#! Return the name and code for the <foo> patterned
#! word.
dup <foo> swap '[ _ <foo> write-html ]
(( -- )) html-word ;
( -- ) html-word ;
: <foo ( str -- <str ) "<" prepend ;
@ -37,21 +37,21 @@ SYMBOL: html
#! Return the name and code for the <foo patterned
#! word.
<foo dup '[ _ write-html ]
(( -- )) html-word ;
( -- ) html-word ;
: foo> ( str -- foo> ) ">" append ;
: def-for-html-word-foo> ( name -- )
#! Return the name and code for the foo> patterned
#! word.
foo> [ ">" write-html ] (( -- )) html-word ;
foo> [ ">" write-html ] ( -- ) html-word ;
: </foo> ( str -- </str> ) "</" ">" surround ;
: def-for-html-word-</foo> ( name -- )
#! Return the name and code for the </foo> patterned
#! word.
</foo> dup '[ _ write-html ] (( -- )) html-word ;
</foo> dup '[ _ write-html ] ( -- ) html-word ;
: <foo/> ( str -- <str/> ) "<" "/>" surround ;
@ -59,14 +59,14 @@ SYMBOL: html
#! Return the name and code for the <foo/> patterned
#! word.
dup <foo/> swap '[ _ <foo/> write-html ]
(( -- )) html-word ;
( -- ) html-word ;
: foo/> ( str -- str/> ) "/>" append ;
: def-for-html-word-foo/> ( name -- )
#! Return the name and code for the foo/> patterned
#! word.
foo/> [ "/>" write-html ] (( -- )) html-word ;
foo/> [ "/>" write-html ] ( -- ) html-word ;
: define-closed-html-word ( name -- )
#! Given an HTML tag name, define the words for
@ -92,7 +92,7 @@ SYMBOL: html
: define-attribute-word ( name -- )
dup "=" prepend swap
'[ _ write-attr ] (( string -- )) html-word ;
'[ _ write-attr ] ( string -- ) html-word ;
! Define some closed HTML tags
[

2
extra/mongodb/tuple/persistent/persistent.factor
View File

@ -62,7 +62,7 @@ CONSTRUCTOR: cond-value ( value quot -- cond-value ) ;
{ [ dup value>> mdb-persistent? ]
[ [ value>> ] [ quot>> ] bi write-mdb-persistent ] }
{ [ dup value>> data-tuple? ]
[ [ value>> ] [ quot>> ] bi (( tuple -- assoc )) call-effect ] }
[ [ value>> ] [ quot>> ] bi ( tuple -- assoc ) call-effect ] }
{ [ dup value>> [ hashtable? ] [ linked-assoc? ] bi or ]
[ [ value>> ] [ quot>> ] bi '[ _ write-field ] assoc-map ] }
[ value>> ]

4
extra/multi-methods/tests/definitions.factor
View File

@ -4,7 +4,7 @@ IN: multi-methods.tests
DEFER: fake
\ fake H{ } clone "multi-methods" set-word-prop
<< (( -- )) \ fake set-stack-effect >>
<< ( -- ) \ fake set-stack-effect >>
[
[ "fake-{ }" ] [ { } \ fake method-word-name ] unit-test
@ -24,7 +24,7 @@ DEFER: fake
DEFER: testing
[ ] [ \ testing (( -- )) define-generic ] unit-test
[ ] [ \ testing ( -- ) define-generic ] unit-test
[ t ] [ \ testing generic? ] unit-test
] with-compilation-unit

2
extra/project-euler/common/common.factor
View File

@ -159,5 +159,5 @@ SYNTAX: SOLUTION:
scan-word
[ name>> "-main" append create-in ] keep
[ drop current-vocab main<< ]
[ [ . ] swap prefix (( -- )) define-declared ]
[ [ . ] swap prefix ( -- ) define-declared ]
2bi ;

2
extra/readline/readline.factor
View File

@ -26,6 +26,6 @@ IN: readline
'[
[ @ [ utf8 malloc-string ] [ f ] if* ]
readline.ffi:rl_compentry_func_t
] (( -- alien )) define-temp
] ( -- alien ) define-temp
] with-compilation-unit execute( -- alien )
readline.ffi:set-rl_completion_entry_function ;

4
extra/variables/variables.factor
View File

@ -23,12 +23,12 @@ SYNTAX: set:
'[ _ set ] ;
: (define-variable) ( word getter setter -- )
[ (( -- value )) define-inline ]
[ ( -- value ) define-inline ]
[
[
[ name>> "set: " prepend <uninterned-word> ]
[ over "variable-setter" set-word-prop ] bi
] dip (( value -- )) define-inline
] dip ( value -- ) define-inline
] bi-curry* bi ;
: define-variable ( word -- )

2
unmaintained/ui/gadgets/layout/layout.factor
View File

@ -55,7 +55,7 @@ M: model -> dup , ;
ERROR: not-in-template word ;
SYNTAX: $ scan-new-word dup
[ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry (( -- )) define-declared "$" expect ]
[ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry ( -- ) define-declared "$" expect ]
[ [ <placeholder> [ swap templates get set-at ] keep , ] curry ] bi append! ;
: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;