: define-enum-constructor ( word -- )
[ name>> "<" ">" surround create-in ] keep
- [ number>enum ] curry (( number -- enum )) define-inline ;
+ [ number>enum ] curry ( number -- enum ) define-inline ;
PRIVATE>
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
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
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
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
'[ _ _ 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 ;
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
[ class-init-hooks get set-at ]
[
[ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi
- (( -- class )) define-declared
+ ( -- class ) define-declared
] bi ;
: import-objc-class ( name quot -- )
: prepare-method ( ret types quot -- type imp )
[ [ encode-types ] 2keep ] dip
'[ _ _ cdecl _ alien-callback ]
- (( -- callback )) define-temp ;
+ ( -- callback ) define-temp ;
: prepare-methods ( methods -- methods )
[
[ ] [
[
[ 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
: 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
[ 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
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 ] [ [ + ] 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 ] [ \ + ( 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
: optimized-quot ( quot -- quot' )
build-tree optimize-tree nodes>quot ;
[ 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
: 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 ) ;
[ ] [ "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 ;
ERROR: uninferable ;
: remove-effect-input ( effect -- effect' )
- (( -- object )) swap compose-effects ;
+ ( -- object ) swap compose-effects ;
: (infer-value) ( value-info -- effect )
dup literal?>> [
[ 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
SYNTAX: CFSTRING:
scan-new-word scan-object
[ drop ] [ '[ _ [ _ <CFString> ] initialize-alien ] ] 2bi
- (( -- alien )) define-declared ;
+ ( -- alien ) define-declared ;
"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." } ;
"""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 } ")." ;
: (eval>string) ( str -- output )
[
parser-quiet? on
- '[ _ (( -- )) (eval) ] [ print-error ] recover
+ '[ _ ( -- ) (eval) ] [ print-error ] recover
] with-string-writer ;
: eval>string ( str -- output )
#! Syntax: name level\r
scan-new-word dup scan-word\r
'[ 1array stack>message _ _ log-message ]\r
- (( message -- )) define-declared ;\r
+ ( message -- ) define-declared ;\r
\r
USE: vocabs.loader\r
\r
: 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 ;
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
: 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
! 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
[ "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
SYNTAX: STRING:
scan-new-word
parse-here 1quotation
- (( -- string )) define-inline ;
+ ( -- string ) define-inline ;
<PRIVATE
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 ;
\r
: check-action-effect ( quot -- quot )\r
dup infer {\r
- { [ dup (( a -- b )) effect<= ] [ drop ] }\r
- { [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] }\r
+ { [ dup ( a -- b ) effect<= ] [ drop ] }\r
+ { [ dup ( -- b ) effect<= ] [ drop [ drop ] prepose ] }\r
[ bad-effect ]\r
} cond ;\r
\r
SYNTAX: EBNF: \r
reset-tokenizer scan-new-word dup ";EBNF" parse-multiline-string \r
ebnf>quot swapd\r
- (( input -- ast )) define-declared "ebnf-parser" set-word-prop \r
+ ( input -- ast ) define-declared "ebnf-parser" set-word-prop \r
reset-tokenizer ;\r
: 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 )
#! 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 ;
: states>code ( words dfa -- )
'[
dup _ word>quot
- (( last-match index string -- ? ))
+ ( last-match index string -- ? )
define-declared
] each ;
: 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 ;
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 ;
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 ;
: 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
"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
} 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 )
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.
: 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 -- )
[
[ 1 ] [
[
- [ [ ] (( -- )) define-temp ] with-compilation-unit
+ [ [ ] ( -- ) define-temp ] with-compilation-unit
dup execute( -- )
] profile
counter>>
'[ [ 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>
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 } } ]
: 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:
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 ;
{ 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+
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
: 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 )
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
"((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
] [ ] make
]
} cleave
-(( obj quot -- curry )) define-declared
+( obj quot -- curry ) define-declared
"compose" "kernel" create
tuple
] [ ] make
]
} cleave
-(( quot1 quot2 -- compose )) define-declared
+( quot1 quot2 -- compose ) define-declared
! Sub-primitive words
: make-sub-primitive ( word vocab effect -- )
] 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
] 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
[ 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
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 ;
: 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
"The following two lines are equivalent:"
{ $code
"call( a b -- c )"
- "(( a b -- c )) call-effect"
+ "( a b -- c ) call-effect"
}
} ;
"The following two lines are equivalent:"
{ $code
"execute( a b -- c )"
- "(( a b -- c )) execute-effect"
+ "( a b -- c ) execute-effect"
}
} ;
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
[ "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
M: object throw
5 special-object [ die ] or
- (( error -- * )) call-effect-unsafe ;
+ ( error -- * ) call-effect-unsafe ;
PRIVATE>
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
[ [ 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
set-retainstack
[ set-datastack ] dip
set-callstack
- ] (( continuation -- * )) call-effect-unsafe ;
+ ] ( continuation -- * ) call-effect-unsafe ;
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 ;
{ $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>
{ $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>
{ $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 -- * )""" }
} ;
{ $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
[ 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
-
-[ 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
-
-[ { "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
-
-[ { 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 -- 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 ) ]
+[ 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
+
+[ "( 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
+
+[ 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
+
+[ 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
+
+[ "( 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
[ "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> ;
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 ;
define
] with-variable ;
-PREDICATE: math-generic < generic ( word -- ? )
+PREDICATE: math-generic < generic
"combination" word-prop math-combination? ;
M: math-generic definer drop \ MATH: f ;
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
] 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 ] [
[ 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
: 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 ;
"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 ]
"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 ] [
: 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 )
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 -- )
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
\ No newline at end of file
+[ f ] [ \ forget-test compiler-errors get key? ] unit-test
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"
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
""
"["
" 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..." }
] define-core-syntax
"(" [
- ")" parse-effect drop
- ] define-core-syntax
-
- "((" [
- "))" parse-effect suffix!
+ ")" parse-effect suffix!
] define-core-syntax
"MAIN:" [
ALIAS: foo +
[ ] [ "IN: words.alias.tests CONSTANT: foo 5" eval( -- ) ] unit-test
-[ (( -- value )) ] [ \ foo stack-effect ] unit-test
+[ ( -- value ) ] [ \ foo stack-effect ] unit-test
: 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 ;
\ No newline at end of file
+M: constant definition "constant" word-prop literalize 1quotation ;
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 ;
M: symbol definition drop f ;
: define-symbol ( word -- )
- dup [ ] curry (( -- value )) define-inline ;
+ dup [ ] curry ( -- value ) define-inline ;
{ $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 } "."
} ;
[ 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
#! 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 ;
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
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 ;
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 ;
[ 2nip ] [
create dup
1 <standard-combination>
- (( graphviz-obj val -- graphviz-obj' ))
+ ( graphviz-obj val -- graphviz-obj' )
define-generic
] if* ;
: 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 -- )
"graphviz.render" create dup make-inline
]
[ [ graphviz* ] curry ] bi
- (( graph -O -- ))
+ ( graph -O -- )
define-declared ;
PRIVATE>
#! Return the name and code for the <foo> patterned
#! word.
dup <foo> swap '[ _ <foo> write-html ]
- (( -- )) html-word ;
+ ( -- ) html-word ;
: <foo ( str -- <str ) "<" prepend ;
#! 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 ;
#! 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
: define-attribute-word ( name -- )
dup "=" prepend swap
- '[ _ write-attr ] (( string -- )) html-word ;
+ '[ _ write-attr ] ( string -- ) html-word ;
! Define some closed HTML tags
[
{ [ 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>> ]
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
DEFER: testing
- [ ] [ \ testing (( -- )) define-generic ] unit-test
+ [ ] [ \ testing ( -- ) define-generic ] unit-test
[ t ] [ \ testing generic? ] unit-test
] with-compilation-unit
scan-word
[ name>> "-main" append create-in ] keep
[ drop current-vocab main<< ]
- [ [ . ] swap prefix (( -- )) define-declared ]
+ [ [ . ] swap prefix ( -- ) define-declared ]
2bi ;
'[
[ @ [ 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 ;
'[ _ 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 -- )
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 ;
projects / factor.git / commitdiff