\ heapstr.fs -- Manage character strings in heap memory
\ 2016 David Meyer <papa@sdf.org>  +JMJ

: c$type ( c-str -- ) count type ;

: $alloc ( a-str u -- c-heap )
\g Allocate heap space for counted version of string A-STR,U 
	dup 1+ chars allocate if  ( a-str u c-heap)
		>r 2drop r> -1  \ Returns string length -1 for alloc. error 
	else
		2dup c! dup >r 1 chars + swap cmove r>
	then
;

: c$alloc ( c-str -- c-heap )
\g Allocate heap space for counted string for C-STR
	count dup 1+ chars allocate if  ( a-str u c-heap)
		>r 2drop r> 0  \ Returns 0 c-pointer for alloc. error
	else
		2dup c!
		dup >r 1 chars + swap cmove r> 
	then
;

: $catcpy { a-str1 u1 a-str2 u2 a-cat ucat -- }
\g Copy characters from STR1 and STR2 to pre-allocated CAT
	a-str1 a-cat u1 cmove
	a-str2 a-cat u1 chars + u2 cmove
;

: c$cat ( c-str1 c-str2 -- c-cat )
\g Concatenate two counted strings in heap, preserve original strings
	count dup >r rot count dup >r 2swap  ( a-str1 u1 a-str2 u2 R: u2 u1 )
	r> r> + dup 1+ chars allocate if  ( a-str1 u1 a-str2 u2 ucat c-cat ) 
		clearstack 0  \ Returns 0 c-pointer for alloc. error
	else
		tuck c!  ( a-str1 u1 a-str2 u2 c-cat )
		dup >r count $catcpy r>
	then
;

: c$catx ( c-str1 c-str2 ux -- c-cat )
\g Concatenate two counted strings in heap, recycle original strings according to UX: 0 -- recycle STR1 and STR2, 1 -- recycle STR1 only, 2 -- recycle STR2 only
	>r 2dup c$cat r> ( c-str1 c-str2 c-cat ux )
	dup 2 = if
		drop swap free drop nip
	else dup 1 = if
		drop nip swap free drop
	else 0= if
		swap free drop
		swap free drop
	then then then
;