diff --git a/lib/array.fs b/lib/array.fs index e7fc5b7..12d32c4 100644 --- a/lib/array.fs +++ b/lib/array.fs @@ -5,7 +5,6 @@ private{ -( === Allocation strategy === ) defined? array-alloc-strategy [unless] \ Compute new capacity @@ -21,8 +20,6 @@ struct int% field array>capa end-struct array% -s" Index out of range" exception constant OUT-OF-RANGE export - \ Allocate array with capacity : allocate-array ( n capa -- arr ) array% %allocate throw diff --git a/lib/core.fs b/lib/core.fs index 297ee6d..f987629 100644 --- a/lib/core.fs +++ b/lib/core.fs @@ -16,8 +16,11 @@ s" Invalid argument" exception constant INVALID-ARGUMENT unless INVALID-ARGUMENT throw then ; +( === Builtin Exceptions === ) +s" Index out of range" exception constant OUT-OF-RANGE export + defined? roll [unless] - : roll ( w[n-1] ... w0 n -- w0 w[n-2] ... w0 w[n-1] ) + : roll ( w[n-1] ... w0 n -- w[n-2] ... w0 w[n-1] ) dup 0<= if drop else swap >r 1- recurse r> swap then ; [then] diff --git a/lib/string.fs b/lib/string.fs index 258ffd4..01a8cb3 100644 --- a/lib/string.fs +++ b/lib/string.fs @@ -1,23 +1,48 @@ \ planckforth - \ Copyright (C) 2021 nineties -( === String === ) +( === Heap Allocated String === ) private{ -\ Heap-allocated string object -\ p: null terminated string -: make-string ( p -- str ) - dup strlen 1 + allocate throw tuck strcpy +: make-string ( c-addr -- str ) + dup 0<> check-argument + dup strlen 1+ allocate throw + tuck strcpy ; export -: release-string ( str -- ) free ; export +: release-string ( str -- ) + free +; export + +: concat-string ( str1 str2 -- newstr ) + dup 0<> check-argument + over 0<> check-argument + over strlen over strlen + ( str1 str2 n1 n2 ) + over + 1+ allocate throw + ( str1 str2 n1 ptr ) + 3 pick over strcpy \ copy str1 to ptr + ( str1 str2 n1 ptr) + tuck + 2 pick swap strcpy \ copy str2 to ptr + n1 + swap drop swap drop +; export }private T{ s" AAAAA" make-string constant A -> }T T{ s" BBBBBBB" make-string constant B -> }T +T{ s" " make-string constant C -> }T +T{ A B concat-string constant D -> }T T{ A s" AAAAA" streq -> true }T T{ B s" BBBBBBB" streq -> true }T +T{ C s" " streq -> true }T +T{ D s" AAAAABBBBBBB" streq -> true }T +T{ A strlen -> 5 }T +T{ B strlen -> 7 }T +T{ C strlen -> 0 }T +T{ D strlen -> 12 }T T{ A release-string -> }T T{ B release-string -> }T +T{ C release-string -> }T +T{ D release-string -> }T