diff options
| author | Chouser <chouser@n01se.net> | 2015-02-07 10:01:31 -0500 |
|---|---|---|
| committer | Chouser <chouser@n01se.net> | 2015-02-21 13:22:44 -0500 |
| commit | 2e78e94eb894e511e583db03286a3c13b9ecc780 (patch) | |
| tree | e74193c142d3efd8486329458f7ed639943afc19 | |
| parent | 168fb5dc56fee6653816ee8236259940e575c7ec (diff) | |
| download | mal-2e78e94eb894e511e583db03286a3c13b9ecc780.tar.gz mal-2e78e94eb894e511e583db03286a3c13b9ecc780.zip | |
forth: Finished step 1
| -rw-r--r-- | forth/printer.fs | 24 | ||||
| -rw-r--r-- | forth/reader.fs | 10 | ||||
| -rw-r--r-- | forth/types.fs | 4 |
3 files changed, 33 insertions, 5 deletions
diff --git a/forth/printer.fs b/forth/printer.fs index 243780a..1244c08 100644 --- a/forth/printer.fs +++ b/forth/printer.fs @@ -70,17 +70,18 @@ MalNil drop s" nil" str-append ;; drop +: pr-buf-list-item ( list str-addr str-len -- list str-addr str-len) + rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf ; + : pr-buf-list ( list str-addr str-len -- str-addr str-len) - rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf + pr-buf-list-item begin ( list str-addr str-len ) 2 pick mal-nil <> while - a-space - rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf + a-space pr-buf-list-item repeat rot drop ; - MalList extend pr-buf -rot s" (" str-append ( list str-addr str-len ) @@ -96,6 +97,21 @@ MalVector s" ]" str-append ;; drop +MalMap + extend pr-buf + MalMap/list @ + -rot s" {" str-append ( list str-addr str-len ) + pr-buf-list-item a-space pr-buf-list-item + begin ( list str-addr str-len ) + 2 pick mal-nil <> + while + s" , " str-append + pr-buf-list-item a-space pr-buf-list-item + repeat + rot drop + s" }" str-append ;; +drop + MalInt extend pr-buf MalInt/int @ int>str str-append ;; diff --git a/forth/reader.fs b/forth/reader.fs index 57f3e8d..7ff46fd 100644 --- a/forth/reader.fs +++ b/forth/reader.fs @@ -126,6 +126,7 @@ defer read-form ( str-addr str-len -- str-addr str-len mal-obj ) dup mal-digit? if read-int else dup [char] ( = if [char] ) read-list else dup [char] [ = if [char] ] read-list MalVector new tuck MalVector/list ! else + dup [char] { = if [char] } read-list MalMap new tuck MalMap/list ! else dup [char] " = if read-string-literal else dup [char] ; = if read-comment else dup [char] @ = if drop adv-str s" deref" read-wrapped else @@ -137,8 +138,15 @@ defer read-form ( str-addr str-len -- str-addr str-len mal-obj ) else s" unquote" read-wrapped endif else + dup [char] ^ = if + drop adv-str + read-form { meta } read-form { obj } + meta mal-nil conj + obj swap conj + s" with-meta" MalSymbol. swap conj + else read-symbol-str MalSymbol. - endif endif endif endif endif endif endif endif endif + endif endif endif endif endif endif endif endif endif endif endif dup skip-elem = while drop repeat ; ' read-form2 is read-form diff --git a/forth/types.fs b/forth/types.fs index 7f6b6ea..2933448 100644 --- a/forth/types.fs +++ b/forth/types.fs @@ -188,6 +188,10 @@ MalType% cell% field MalVector/list deftype* constant MalVector +MalType% + cell% field MalMap/list +deftype* constant MalMap + \ Examples of extending existing protocol methods to existing type MalDefault extend conj ( obj this -- this ) |