core: callstack is a builtin type and a class name. rename the *stack words that grab the current stack get-foostack to avoid the callstack builtin conflict and for better symmetry with set-foostack.
parent
0e1169ceab
commit
c21a154056
|
@ -66,7 +66,7 @@ IN: compiler.tests.simple
|
|||
|
||||
! Regression
|
||||
|
||||
[ ] [ [ callstack ] compile-call drop ] unit-test
|
||||
[ ] [ [ get-callstack ] compile-call drop ] unit-test
|
||||
|
||||
! Regression
|
||||
|
||||
|
|
|
@ -55,7 +55,7 @@ M: tuple error. describe ;
|
|||
'[ dup _ assoc-stack ] H{ } map>assoc ;
|
||||
|
||||
: .vars ( -- )
|
||||
namestack vars-in-scope describe ;
|
||||
get-namestack vars-in-scope describe ;
|
||||
|
||||
: :vars ( -- )
|
||||
error-continuation get name>> vars-in-scope describe ;
|
||||
|
|
|
@ -49,8 +49,8 @@ IN: prettyprint
|
|||
] recover
|
||||
] each ;
|
||||
|
||||
: .s ( -- ) datastack stack. ;
|
||||
: .r ( -- ) retainstack stack. ;
|
||||
: .s ( -- ) get-datastack stack. ;
|
||||
: .r ( -- ) get-retainstack stack. ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
@ -125,7 +125,7 @@ PRIVATE>
|
|||
callstack>array 3 <groups>
|
||||
{ { table-gap { 5 5 } } } [ [ callframe. ] each ] tabular-output nl ;
|
||||
|
||||
: .c ( -- ) callstack callstack. ;
|
||||
: .c ( -- ) get-callstack callstack. ;
|
||||
|
||||
: pprint-cell ( obj -- ) [ pprint-short ] with-cell ;
|
||||
|
||||
|
|
|
@ -346,7 +346,7 @@ M: object infer-call* \ call bad-macro-input ;
|
|||
\ bits>double { integer } { float } define-primitive \ bits>double make-foldable
|
||||
\ bits>float { integer } { float } define-primitive \ bits>float make-foldable
|
||||
\ both-fixnums? { object object } { object } define-primitive
|
||||
\ callstack { } { callstack } define-primitive \ callstack make-flushable
|
||||
\ get-callstack { } { callstack } define-primitive \ get-callstack make-flushable
|
||||
\ callstack-bounds { } { alien alien } define-primitive \ callstack-bounds make-flushable
|
||||
\ callstack-for { c-ptr } { callstack } define-primitive \ callstack make-flushable
|
||||
\ callstack>array { callstack } { array } define-primitive \ callstack>array make-flushable
|
||||
|
@ -359,7 +359,7 @@ M: object infer-call* \ call bad-macro-input ;
|
|||
\ current-callback { } { fixnum } define-primitive \ current-callback make-flushable
|
||||
\ (callback-room) { } { byte-array } define-primitive \ (callback-room) make-flushable
|
||||
\ (data-room) { } { byte-array } define-primitive \ (data-room) make-flushable
|
||||
\ datastack { } { array } define-primitive \ datastack make-flushable
|
||||
\ get-datastack { } { array } define-primitive \ get-datastack make-flushable
|
||||
\ datastack-for { c-ptr } { array } define-primitive \ datastack-for make-flushable
|
||||
\ die { } { } define-primitive
|
||||
\ disable-gc-events { } { object } define-primitive
|
||||
|
@ -438,7 +438,7 @@ M: object infer-call* \ call bad-macro-input ;
|
|||
\ resize-array { integer array } { array } define-primitive
|
||||
\ resize-byte-array { integer byte-array } { byte-array } define-primitive
|
||||
\ resize-string { integer string } { string } define-primitive
|
||||
\ retainstack { } { array } define-primitive \ retainstack make-flushable
|
||||
\ get-retainstack { } { array } define-primitive \ get-retainstack make-flushable
|
||||
\ retainstack-for { c-ptr } { array } define-primitive \ retainstack-for make-flushable
|
||||
\ set-alien-cell { c-ptr c-ptr integer } { } define-primitive
|
||||
\ set-alien-double { float c-ptr integer } { } define-primitive
|
||||
|
|
|
@ -228,7 +228,7 @@ M: real sleep
|
|||
>integer nano-count + sleep-until ;
|
||||
|
||||
: (spawn) ( thread -- )
|
||||
[ register-thread ] [ [ namestack ] dip resume-with ] bi ;
|
||||
[ register-thread ] [ [ get-namestack ] dip resume-with ] bi ;
|
||||
|
||||
: spawn ( quot name -- thread )
|
||||
<thread> [ (spawn) ] keep ;
|
||||
|
@ -237,7 +237,7 @@ M: real sleep
|
|||
[ '[ _ loop ] ] dip spawn ;
|
||||
|
||||
: in-thread ( quot -- )
|
||||
[ datastack ] dip
|
||||
[ get-datastack ] dip
|
||||
'[ _ set-datastack @ ]
|
||||
"Thread" spawn drop ;
|
||||
|
||||
|
|
|
@ -21,7 +21,7 @@ PRIVATE>
|
|||
SYMBOL: break-hook
|
||||
|
||||
: break ( -- )
|
||||
current-continuation callstack >>call
|
||||
current-continuation get-callstack >>call
|
||||
break-hook get call( continuation -- continuation' )
|
||||
after-break ;
|
||||
|
||||
|
@ -63,7 +63,7 @@ M: object add-breakpoint ;
|
|||
\ (step-into-execute) t "step-into?" set-word-prop
|
||||
|
||||
: (step-into-continuation) ( -- )
|
||||
current-continuation callstack >>call break ;
|
||||
current-continuation get-callstack >>call break ;
|
||||
|
||||
: (step-into-call-next-method) ( method -- )
|
||||
next-method-quot (step-into-quotation) ;
|
||||
|
|
|
@ -451,11 +451,11 @@ tuple
|
|||
{ "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 ) }
|
||||
{ "get-callstack" "kernel" "primitive_callstack" ( -- callstack ) }
|
||||
{ "callstack>array" "kernel" "primitive_callstack_to_array" ( callstack -- array ) }
|
||||
{ "datastack" "kernel" "primitive_datastack" ( -- array ) }
|
||||
{ "get-datastack" "kernel" "primitive_datastack" ( -- array ) }
|
||||
{ "die" "kernel" "primitive_die" ( -- ) }
|
||||
{ "retainstack" "kernel" "primitive_retainstack" ( -- array ) }
|
||||
{ "get-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 ) }
|
||||
|
|
|
@ -6,7 +6,7 @@ IN: combinators.tests
|
|||
{ 3 } [ 1 2 [ + ] call( x y -- z ) ] unit-test
|
||||
[ 1 2 [ + ] call( -- z ) ] must-fail
|
||||
[ 1 2 [ + ] call( x y -- z a ) ] must-fail
|
||||
{ 1 2 3 { 1 2 3 4 } } [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
|
||||
{ 1 2 3 { 1 2 3 4 } } [ 1 2 3 4 [ get-datastack nip ] call( x -- y ) ] unit-test
|
||||
[ [ + ] call( x y -- z ) ] must-infer
|
||||
|
||||
{ 3 } [ 1 2 \ + execute( x y -- z ) ] unit-test
|
||||
|
|
|
@ -32,7 +32,7 @@ SLOT: terminated?
|
|||
! Don't use fancy combinators here, since this word always
|
||||
! runs unoptimized
|
||||
2dup [
|
||||
[ [ datastack ] dip dip ] dip
|
||||
[ [ get-datastack ] dip dip ] dip
|
||||
dup terminated?>> [ 2drop f ] [
|
||||
dup in>> length swap out>> length
|
||||
check-datastack
|
||||
|
|
|
@ -71,15 +71,15 @@ ARTICLE: "continuations.private" "Continuation implementation details"
|
|||
}
|
||||
"The five stacks can be read and written:"
|
||||
{ $subsections
|
||||
datastack
|
||||
get-datastack
|
||||
set-datastack
|
||||
retainstack
|
||||
get-retainstack
|
||||
set-retainstack
|
||||
callstack
|
||||
get-callstack
|
||||
set-callstack
|
||||
namestack
|
||||
get-namestack
|
||||
set-namestack
|
||||
catchstack
|
||||
get-catchstack
|
||||
set-catchstack
|
||||
} ;
|
||||
|
||||
|
@ -112,7 +112,7 @@ HELP: catchstack*
|
|||
{ $values { "catchstack" "a vector of continuations" } }
|
||||
{ $description "Outputs the current catchstack." } ;
|
||||
|
||||
HELP: catchstack
|
||||
HELP: get-catchstack
|
||||
{ $values { "catchstack" "a vector of continuations" } }
|
||||
{ $description "Outputs a copy of the current catchstack." } ;
|
||||
|
||||
|
|
|
@ -75,7 +75,7 @@ os windows? [
|
|||
] unless
|
||||
|
||||
: don't-compile-me ( -- ) ;
|
||||
: foo ( -- ) callstack "c" set don't-compile-me ;
|
||||
: foo ( -- ) get-callstack "c" set don't-compile-me ;
|
||||
: bar ( -- a b ) 1 foo 2 ;
|
||||
|
||||
<< { don't-compile-me foo bar } [ t "no-compile" set-word-prop ] each >>
|
||||
|
|
|
@ -6,8 +6,8 @@ IN: continuations
|
|||
|
||||
: with-datastack ( stack quot -- new-stack )
|
||||
[
|
||||
[ [ datastack ] dip swap [ { } like set-datastack ] dip ] dip
|
||||
swap [ call datastack ] dip
|
||||
[ [ get-datastack ] dip swap [ { } like set-datastack ] dip ] dip
|
||||
swap [ call get-datastack ] dip
|
||||
swap [ set-datastack ] dip
|
||||
] ( stack quot -- new-stack ) call-effect-unsafe ;
|
||||
|
||||
|
@ -26,7 +26,7 @@ SYMBOL: restarts
|
|||
: dummy-1 ( -- obj ) f ;
|
||||
: dummy-2 ( obj -- obj ) ;
|
||||
|
||||
: catchstack ( -- catchstack ) catchstack* clone ; inline
|
||||
: get-catchstack ( -- catchstack ) catchstack* clone ; inline
|
||||
|
||||
: (set-catchstack) ( catchstack -- )
|
||||
CONTEXT-OBJ-CATCHSTACK set-context-object ; inline
|
||||
|
@ -44,7 +44,7 @@ TUPLE: continuation data call retain name catch ;
|
|||
C: <continuation> continuation
|
||||
|
||||
: current-continuation ( -- continuation )
|
||||
datastack callstack retainstack namestack catchstack
|
||||
get-datastack get-callstack get-retainstack get-namestack get-catchstack
|
||||
<continuation> ;
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
@ -43,7 +43,7 @@ M: standard-combination picker
|
|||
M: standard-combination dispatch# #>> ;
|
||||
|
||||
M: standard-generic effective-method
|
||||
[ datastack ] dip [ "combination" word-prop #>> swap <reversed> nth ] keep
|
||||
[ get-datastack ] dip [ "combination" word-prop #>> swap <reversed> nth ] keep
|
||||
method-for-object ;
|
||||
|
||||
: inline-cache-quot ( word methods miss-word -- quot )
|
||||
|
|
|
@ -26,7 +26,7 @@ HELP: -rot $complex-shuffle ;
|
|||
HELP: dupd $complex-shuffle ;
|
||||
HELP: swapd $complex-shuffle ;
|
||||
|
||||
HELP: datastack
|
||||
HELP: get-datastack
|
||||
{ $values { "array" array } }
|
||||
{ $description "Outputs an array containing a copy of the data stack contents right before the call to this word, with the top of the stack at the end of the array." } ;
|
||||
|
||||
|
@ -34,7 +34,7 @@ HELP: set-datastack
|
|||
{ $values { "array" array } }
|
||||
{ $description "Replaces the data stack contents with a copy of an array. The end of the array becomes the top of the stack." } ;
|
||||
|
||||
HELP: retainstack
|
||||
HELP: get-retainstack
|
||||
{ $values { "array" array } }
|
||||
{ $description "Outputs an array containing a copy of the retain stack contents right before the call to this word, with the top of the stack at the end of the array." } ;
|
||||
|
||||
|
@ -42,7 +42,7 @@ HELP: set-retainstack
|
|||
{ $values { "array" array } }
|
||||
{ $description "Replaces the retain stack contents with a copy of an array. The end of the array becomes the top of the stack." } ;
|
||||
|
||||
HELP: callstack
|
||||
HELP: get-callstack
|
||||
{ $values { "callstack" callstack } }
|
||||
{ $description "Outputs a copy of the call stack contents, with the top of the stack at the end of the vector. The stack frame of the caller word is " { $emphasis "not" } " included. Each group of three elements in the callstack is frame:"
|
||||
{ $list
|
||||
|
|
|
@ -129,9 +129,9 @@ os windows? [
|
|||
|
||||
{ 6 2 } [ 1 2 [ 5 + ] dip ] unit-test
|
||||
|
||||
{ } [ callstack set-callstack ] unit-test
|
||||
{ } [ get-callstack set-callstack ] unit-test
|
||||
|
||||
[ 3drop datastack ] must-fail
|
||||
[ 3drop get-datastack ] must-fail
|
||||
{ } [ :c ] unit-test
|
||||
|
||||
! Doesn't compile; important
|
||||
|
|
|
@ -28,9 +28,9 @@ PRIMITIVE: 4dup ( w x y z -- w x y z w x y z )
|
|||
PRIMITIVE: (clone) ( obj -- newobj )
|
||||
PRIMITIVE: eq? ( obj1 obj2 -- ? )
|
||||
PRIMITIVE: <wrapper> ( obj -- wrapper )
|
||||
PRIMITIVE: callstack ( -- callstack )
|
||||
PRIMITIVE: datastack ( -- array )
|
||||
PRIMITIVE: retainstack ( -- array )
|
||||
PRIMITIVE: get-datastack ( -- array )
|
||||
PRIMITIVE: get-callstack ( -- callstack )
|
||||
PRIMITIVE: get-retainstack ( -- array )
|
||||
PRIMITIVE: die ( -- )
|
||||
PRIMITIVE: callstack>array ( callstack -- array )
|
||||
|
||||
|
|
|
@ -33,7 +33,7 @@ ARTICLE: "namespaces-global" "Global variables"
|
|||
ARTICLE: "namespaces.private" "Namespace implementation details"
|
||||
"The namestack holds namespaces."
|
||||
{ $subsections
|
||||
namestack
|
||||
get-namestack
|
||||
set-namestack
|
||||
namespace
|
||||
}
|
||||
|
@ -169,7 +169,7 @@ HELP: namestack*
|
|||
{ $values { "namestack" "a vector of assocs" } }
|
||||
{ $description "Outputs the current name stack." } ;
|
||||
|
||||
HELP: namestack
|
||||
HELP: get-namestack
|
||||
{ $values { "namestack" "a vector of assocs" } }
|
||||
{ $description "Outputs a copy of the current name stack." } ;
|
||||
|
||||
|
|
|
@ -41,7 +41,7 @@ PRIVATE>
|
|||
: global ( -- g ) OBJ-GLOBAL special-object { global-hashtable } declare ; foldable
|
||||
|
||||
: namespace ( -- namespace ) namestack* last ; inline
|
||||
: namestack ( -- namestack ) namestack* clone ;
|
||||
: get-namestack ( -- namestack ) namestack* clone ;
|
||||
: set-namestack ( namestack -- )
|
||||
>vector CONTEXT-OBJ-NAMESTACK set-context-object ;
|
||||
: init-namespaces ( -- ) global 1array set-namestack ;
|
||||
|
|
Loading…
Reference in New Issue