tail-jump

\ tail-jump.fs	by Ouatu Bogdan Ionut <hum9> ouatubi@gmail.com, under New BSD License
\ 	Provides:
\	';;'       ,
\	':;'	for tail-jump; by default, jumps to current definition beginning;
\
\	'::'	defines a label to beginning of latest compiled definition.
\
\		A label should be paired with ';;' or ':;' , as in example:
\			': word ... ;      :: :word \ label for word'
\				and inside a definition, use tail-call optimization:
\			':word ;;'  for  'word ;'    sequence,
\			':word :;'  for  'word EXIT' sequence.
\   
\	OBS.:	redefines ':' , wich have effect only for tail-jumping words
\
\ Happy factoring!

\ Stack words 
: !+  tuck ! 1 cells + ;
: @-         1 cells - dup @ swap ;

	VARIABLE CS
:noname [ depth negate CS  ! ]
	BEGIN [ depth  CS +! ] AGAIN
; DROP

	\ Compile Stack Storage
	CREATE CS^ CS @ cells allot

: CS!  	CS^  [ CS @ ] LITERAL 0 ?DO !+ LOOP CS ! ; IMMEDIATE
: CS@  	CS @ [ CS @ ] LITERAL 0 ?DO @- LOOP drop
	     [ CS^ CS @ cells + ] LITERAL   CS ! ; IMMEDIATE

: ::    \ Defines a label for a non-local tail-jump
	CREATE HERE [ CS @ cells ] LITERAL allot
	CS^    swap [ CS @ cells ] LITERAL move
	IMMEDIATE
DOES>
	[ CS @ cells ] LITERAL + CS ! ; 

: : : postpone BEGIN postpone CS! ;
: ;;  postpone CS@ postpone AGAIN postpone ; ; IMMEDIATE
: :;  postpone CS@ postpone AGAIN            ; IMMEDIATE

0 [IF]
: bused  dup rot - . ." bytes used" cr ;

: hello ." Hello world!" ; see hello cr

here
: tjump0 dup IF 1- :; THEN ;         see tjump0 here bused 
: tjump1 dup 0= IF EXIT THEN 1- ;;   see tjump1 here bused drop

: tj0 ."  non-local jumped into tj0 beginning." ;   :: :tj0
: tj1 ." From tj1," :tj0 ;;
: tj2 ." From tj2," :tj0 :; ." SUPERFLUOUS!" ;

see :: see :tj0 see tj0 see tj1 see tj2
cr ." tj1 running: " tj1
cr ." tj2 running: " tj2 
cr .s cr BYE
[THEN]