kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-11-10 02:45:44 +03:00
Code Issues Projects Releases Wiki Activity

forth: add seq and string?

Browse Source 
Issue #166

With assistance from chouser (thanks!).
This commit is contained in:
Joel Martin 2016-02-16 13:56:51 -06:00
parent 396d869e63
commit 82e2b26b36
2 changed files with 23 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
forth/core.fs
View File

@ -96,6 +96,8 @@ defcore conj { argv argc }
argv i cells + @ swap conj
loop ;;
defcore seq drop @ seq ;;
defcore assoc { argv argc }
argv @ ( coll )
argv argc cells + argv cell+ +do
@ -211,6 +213,7 @@ defcore list? drop @ mal-type @ MalList = mal-bool ;;
defcore vector? drop @ mal-type @ MalVector = mal-bool ;;
defcore keyword? drop @ mal-type @ MalKeyword = mal-bool ;;
defcore symbol? drop @ mal-type @ MalSymbol = mal-bool ;;
defcore string? drop @ mal-type @ MalString = mal-bool ;;
defcore atom? drop @ mal-type @ Atom = mal-bool ;;
defcore true? drop @ mal-true = mal-bool ;;
defcore false? drop @ mal-false = mal-bool ;;

20
forth/types.fs
View File

@ -262,6 +262,7 @@ end-extend
\ === Mal types and protocols === /
def-protocol-method conj ( obj this -- this )
def-protocol-method seq ( obj -- mal-list|nil )
def-protocol-method assoc ( k v this -- this )
def-protocol-method dissoc ( k this -- this )
def-protocol-method get ( not-found k this -- value )
@ -357,6 +358,10 @@ MalList
old-list MalList/start @ new-start cell+ new-count 1- cells cmove
endif
new-start new-count MalList. ;;
extend seq
dup MalList/count @ 0= if
drop mal-nil
endif ;;
extend empty? MalList/count @ 0= mal-bool ;;
extend mal-count MalList/count @ MalInt. ;;
extend mal=
@ -416,6 +421,8 @@ MalVector
new-start old-count 1+ MalList.
MalVector new swap
over MalVector/list ! ;;
extend seq
MalVector/list @ seq ;;
drop
MalType%
@ -526,6 +533,7 @@ drop
MalNil
extend conj ( item nil -- mal-list )
drop MalList/Empty conj ;;
extend seq drop mal-nil ;;
extend as-native drop nil ;;
extend get 2drop ;;
extend to-list drop MalList/Empty ;;
@ -613,6 +621,18 @@ MalString
2drop 0
endif ;;
' as-native ' unpack-str extend-method*
extend seq { str }
str MalString/str-len @ { len }
len 0= if
mal-nil
else
len cells allocate throw { list-start }
len 0 ?do
str MalString/str-addr @ i + 1 MalString. ( new-char-string )
list-start i cells + !
loop
list-start len MalList.
endif ;;
drop