Merge pull request #25 from nineties/lib-string

Wrote basic operations of lib/string
This commit is contained in:
Koichi NAKAMURA 2021-12-08 08:41:22 +09:00 committed by GitHub
commit 81902f8656
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 35 additions and 10 deletions

View file

@ -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

View file

@ -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]

View file

@ -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