From 60801ed68d5b2c6630c83883de150ccce98767f9 Mon Sep 17 00:00:00 2001 From: Chouser Date: Sun, 15 Feb 2015 13:33:44 -0500 Subject: forth: Add step 4, but not varargs --- forth/core.fs | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 forth/core.fs (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs new file mode 100644 index 0000000..6e8ccfb --- /dev/null +++ b/forth/core.fs @@ -0,0 +1,36 @@ +require env.fs + +0 MalEnv. constant core + +: args-as-native drop { argv argc -- entry*argc... } + argc 0 ?do + argv i cells + @ as-native + loop ; + +: defcore ( xt ) + parse-allot-name MalSymbol. ( xt sym ) + swap MalFn. core env/set ; + +:noname args-as-native + MalInt. ; defcore + +:noname args-as-native - MalInt. ; defcore - +:noname args-as-native * MalInt. ; defcore * +:noname args-as-native / MalInt. ; defcore / +:noname args-as-native < mal-bool ; defcore < +:noname args-as-native > mal-bool ; defcore > +:noname args-as-native <= mal-bool ; defcore <= +:noname args-as-native >= mal-bool ; defcore >= + +:noname drop { argv argc } + MalList new { list } + argc cells allocate throw { start } + argv start argc cells cmove + argc list MalList/count ! + start list MalList/start ! + list +; defcore list + +:noname 2drop @ mal-type @ MalList = mal-bool ; defcore list? +:noname 2drop @ empty? ; defcore empty? +:noname 2drop @ mal-count ; defcore count + +:noname 2drop dup @ swap cell+ @ swap m= mal-bool ; defcore = -- cgit v1.2.3 From 136ce7c9afb5e103133fe6e423e6dad3d23db38d Mon Sep 17 00:00:00 2001 From: Chouser Date: Sun, 15 Feb 2015 14:10:47 -0500 Subject: forth: Split types for user fns vs native fns --- forth/core.fs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index 6e8ccfb..16105ad 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -2,14 +2,14 @@ require env.fs 0 MalEnv. constant core -: args-as-native drop { argv argc -- entry*argc... } +: args-as-native { argv argc -- entry*argc... } argc 0 ?do argv i cells + @ as-native loop ; : defcore ( xt ) parse-allot-name MalSymbol. ( xt sym ) - swap MalFn. core env/set ; + swap MalNativeFn. core env/set ; :noname args-as-native + MalInt. ; defcore + :noname args-as-native - MalInt. ; defcore - @@ -20,7 +20,7 @@ require env.fs :noname args-as-native <= mal-bool ; defcore <= :noname args-as-native >= mal-bool ; defcore >= -:noname drop { argv argc } +:noname { argv argc } MalList new { list } argc cells allocate throw { start } argv start argc cells cmove @@ -29,8 +29,8 @@ require env.fs list ; defcore list -:noname 2drop @ mal-type @ MalList = mal-bool ; defcore list? -:noname 2drop @ empty? ; defcore empty? -:noname 2drop @ mal-count ; defcore count +:noname drop @ mal-type @ MalList = mal-bool ; defcore list? +:noname drop @ empty? ; defcore empty? +:noname drop @ mal-count ; defcore count -:noname 2drop dup @ swap cell+ @ swap m= mal-bool ; defcore = +:noname drop dup @ swap cell+ @ swap m= mal-bool ; defcore = -- cgit v1.2.3 From c4403c179e732a50e2b21a01469f0a38ea2d0187 Mon Sep 17 00:00:00 2001 From: Chouser Date: Sun, 15 Feb 2015 16:46:34 -0500 Subject: forth: Add support for & var-args --- forth/core.fs | 71 ++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 51 insertions(+), 20 deletions(-) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index 16105ad..6dd4ec4 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -7,30 +7,61 @@ require env.fs argv i cells + @ as-native loop ; -: defcore ( xt ) - parse-allot-name MalSymbol. ( xt sym ) - swap MalNativeFn. core env/set ; - -:noname args-as-native + MalInt. ; defcore + -:noname args-as-native - MalInt. ; defcore - -:noname args-as-native * MalInt. ; defcore * -:noname args-as-native / MalInt. ; defcore / -:noname args-as-native < mal-bool ; defcore < -:noname args-as-native > mal-bool ; defcore > -:noname args-as-native <= mal-bool ; defcore <= -:noname args-as-native >= mal-bool ; defcore >= - -:noname { argv argc } +: defcore* ( sym xt ) + MalNativeFn. core env/set ; + +: defcore + parse-allot-name MalSymbol. ( xt ) + ['] defcore* :noname ; + +defcore + args-as-native + MalInt. ;; +defcore - args-as-native - MalInt. ;; +defcore * args-as-native * MalInt. ;; +defcore / args-as-native / MalInt. ;; +defcore < args-as-native < mal-bool ;; +defcore > args-as-native > mal-bool ;; +defcore <= args-as-native <= mal-bool ;; +defcore >= args-as-native >= mal-bool ;; + +defcore list { argv argc } MalList new { list } argc cells allocate throw { start } argv start argc cells cmove argc list MalList/count ! start list MalList/start ! - list -; defcore list + list ;; + +defcore list? drop @ mal-type @ MalList = mal-bool ;; +defcore empty? drop @ empty? ;; +defcore count drop @ mal-count ;; + +defcore = drop dup @ swap cell+ @ swap m= mal-bool ;; +defcore not + drop @ + dup mal-nil = if + drop mal-true + else + mal-false = if + mal-true + else + mal-false + endif + endif ;; + +: pr-str-multi ( argv argc ) + ?dup 0= if drop s" " + else + { argv argc } + new-str + argv @ pr-buf + argc 1 ?do + a-space + argv i cells + @ pr-buf + loop + endif ; -:noname drop @ mal-type @ MalList = mal-bool ; defcore list? -:noname drop @ empty? ; defcore empty? -:noname drop @ mal-count ; defcore count +defcore prn pr-str-multi type cr mal-nil ;; +defcore pr-str pr-str-multi MalString. ;; -:noname drop dup @ swap cell+ @ swap m= mal-bool ; defcore = +defcore str drop @ pr-str MalString. ;; +defcore println pr-str-multi 10 str-append-char MalString. ;; -- cgit v1.2.3 From 785786c6033c97a70e78fb6b684d58aea18df4ae Mon Sep 17 00:00:00 2001 From: Chouser Date: Sun, 15 Feb 2015 17:44:52 -0500 Subject: forth: Finish step 4 --- forth/core.fs | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index 6dd4ec4..4982a0e 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -48,8 +48,8 @@ defcore not endif endif ;; -: pr-str-multi ( argv argc ) - ?dup 0= if drop s" " +: pr-str-multi ( readably? argv argc ) + ?dup 0= if drop 0 0 else { argv argc } new-str @@ -60,8 +60,17 @@ defcore not loop endif ; -defcore prn pr-str-multi type cr mal-nil ;; -defcore pr-str pr-str-multi MalString. ;; - -defcore str drop @ pr-str MalString. ;; -defcore println pr-str-multi 10 str-append-char MalString. ;; +defcore prn true -rot pr-str-multi type cr drop mal-nil ;; +defcore pr-str true -rot pr-str-multi MalString. nip ;; +defcore println false -rot pr-str-multi type cr drop mal-nil ;; +defcore str ( argv argc ) + dup 0= if + MalString. + else + { argv argc } + false new-str + argc 0 ?do + argv i cells + @ pr-buf + loop + MalString. nip + endif ;; -- cgit v1.2.3 From bf6a574e00a221dfe564ba11148deaa73ba8a229 Mon Sep 17 00:00:00 2001 From: Chouser Date: Mon, 16 Feb 2015 20:12:44 -0500 Subject: forth: Add step 6, clean up comment parsing --- forth/core.fs | 3 +++ 1 file changed, 3 insertions(+) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index 4982a0e..71f43ca 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -74,3 +74,6 @@ defcore str ( argv argc ) loop MalString. nip endif ;; + +defcore read-string drop @ unpack-str read-str ;; +defcore slurp drop @ unpack-str slurp-file MalString. ;; -- cgit v1.2.3 From 794bfca1361fc6900f0ea0186d64111c3a02b0f8 Mon Sep 17 00:00:00 2001 From: Chouser Date: Mon, 16 Feb 2015 21:28:05 -0500 Subject: forth: Add step 7 --- forth/core.fs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index 71f43ca..e601e1d 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -77,3 +77,22 @@ defcore str ( argv argc ) defcore read-string drop @ unpack-str read-str ;; defcore slurp drop @ unpack-str slurp-file MalString. ;; + +defcore cons ( argv[item,coll] argc ) + drop dup @ swap cell+ @ ( item coll ) + to-list conj ;; + +defcore concat { lists argc } + 0 lists argc cells + lists +do ( count ) + i @ to-list MalList/count @ + + cell +loop { count } + count cells allocate throw { start } + start lists argc cells + lists +do ( target ) + i @ to-list MalList/count @ cells 2dup i @ to-list MalList/start @ -rot ( target bytes src target bytes ) + cmove ( target bytes ) + + ( new-target ) + cell +loop + drop + MalList new + start over MalList/start ! + count over MalList/count ! ;; -- cgit v1.2.3 From e82947d00f700558500e85e22aaf187544769a2e Mon Sep 17 00:00:00 2001 From: Chouser Date: Tue, 17 Feb 2015 09:40:03 -0500 Subject: forth: Add step 8 --- forth/core.fs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index e601e1d..43e6b75 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -96,3 +96,21 @@ defcore concat { lists argc } MalList new start over MalList/start ! count over MalList/count ! ;; + +defcore nth ( argv[coll,i] argc ) + over ( argv argc argv ) + cell+ @ MalInt/int @ ( argv argc count ) + swap over <= if ." nth out of bounds" cr 1 throw endif ( argv count ) + cells swap ( c-offset argv ) + @ to-list MalList/start @ + @ ;; + +defcore first ( argv[coll] argc ) + drop @ to-list + dup MalList/count @ 0= if + drop mal-nil + else + MalList/start @ @ + endif ;; + +defcore rest ( argv[coll] argc ) + drop @ to-list MalList/rest ;; -- cgit v1.2.3 From 580c4eef9d61f39264813b662fe5335c3c3c4ee5 Mon Sep 17 00:00:00 2001 From: Chouser Date: Tue, 17 Feb 2015 18:47:23 -0500 Subject: forth: Add step 9, just try*/throw - Moved some stuff out of printer into str, to support throwing strings in types.fs - Fixed an apparently completely broken 'nth' - Still failing 120 step9 tests --- forth/core.fs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index 43e6b75..c333131 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -98,11 +98,16 @@ defcore concat { lists argc } count over MalList/count ! ;; defcore nth ( argv[coll,i] argc ) - over ( argv argc argv ) - cell+ @ MalInt/int @ ( argv argc count ) - swap over <= if ." nth out of bounds" cr 1 throw endif ( argv count ) - cells swap ( c-offset argv ) - @ to-list MalList/start @ + @ ;; + drop dup @ to-list ( argv list ) + swap cell+ @ MalInt/int @ ( list i ) + over MalList/count @ ( list i count ) + 2dup >= if { i count } + 0 0 + new-str i int>str str-append s\" \040>= " count int>str + s" nth out of bounds: " ...throw-str + endif drop ( list i ) + cells swap ( c-offset list ) + MalList/start @ + @ ;; defcore first ( argv[coll] argc ) drop @ to-list -- cgit v1.2.3 From 224e09ed42325f000ee9a31a500bebe03a1ba97c Mon Sep 17 00:00:00 2001 From: Chouser Date: Wed, 18 Feb 2015 19:57:39 -0500 Subject: forth: Finish step 9 --- forth/core.fs | 131 ++++++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 114 insertions(+), 17 deletions(-) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index c333131..4216574 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -24,14 +24,16 @@ defcore <= args-as-native <= mal-bool ;; defcore >= args-as-native >= mal-bool ;; defcore list { argv argc } - MalList new { list } argc cells allocate throw { start } argv start argc cells cmove - argc list MalList/count ! - start list MalList/start ! - list ;; + start argc MalList. ;; + +defcore vector { argv argc } + argc cells allocate throw { start } + argv start argc cells cmove + start argc MalList. + MalVector new swap over MalVector/list ! ;; -defcore list? drop @ mal-type @ MalList = mal-bool ;; defcore empty? drop @ empty? ;; defcore count drop @ mal-count ;; @@ -83,19 +85,66 @@ defcore cons ( argv[item,coll] argc ) to-list conj ;; defcore concat { lists argc } - 0 lists argc cells + lists +do ( count ) - i @ to-list MalList/count @ + - cell +loop { count } - count cells allocate throw { start } - start lists argc cells + lists +do ( target ) - i @ to-list MalList/count @ cells 2dup i @ to-list MalList/start @ -rot ( target bytes src target bytes ) - cmove ( target bytes ) - + ( new-target ) - cell +loop - drop MalList new - start over MalList/start ! - count over MalList/count ! ;; + lists over MalList/start ! + argc over MalList/count ! + MalList/concat ;; + +defcore conj { argv argc } + argv @ ( coll ) + argc 1 ?do + argv i cells + @ swap conj + loop ;; + +defcore assoc { argv argc } + argv @ ( coll ) + argv argc cells + argv cell+ +do + i @ \ key + i cell+ @ \ val + rot assoc + 2 cells +loop ;; + +defcore keys ( argv argc ) + drop @ MalMap/list @ + dup MalList/start @ swap MalList/count @ { start count } + here + start count cells + start +do + i @ , + 2 cells +loop + here>MalList ;; + +defcore vals ( argv argc ) + drop @ MalMap/list @ + dup MalList/start @ swap MalList/count @ { start count } + here + start count cells + start cell+ +do + i @ , + 2 cells +loop + here>MalList ;; + +defcore dissoc { argv argc } + argv @ \ coll + argv argc cells + argv cell+ +do + i @ swap dissoc + cell +loop ;; + +defcore hash-map { argv argc } + MalMap/Empty + argc cells argv + argv +do + i @ i cell+ @ rot assoc + 2 cells +loop ;; + +defcore get { argv argc } + argc 3 < if mal-nil else argv cell+ cell+ @ endif + argv cell+ @ \ key + argv @ \ coll + get ;; + +defcore contains? { argv argc } + 0 + argv cell+ @ \ key + argv @ \ coll + get 0 <> mal-bool ;; defcore nth ( argv[coll,i] argc ) drop dup @ to-list ( argv list ) @@ -119,3 +168,51 @@ defcore first ( argv[coll] argc ) defcore rest ( argv[coll] argc ) drop @ to-list MalList/rest ;; + +defcore meta ( argv[obj] argc ) + drop @ mal-meta @ + ?dup 0= if mal-nil endif ;; + +defcore with-meta ( argv[obj,meta] argc ) + drop ( argv ) + dup cell+ @ swap @ ( meta obj ) + dup mal-type @ MalTypeType-struct @ ( meta obj obj-size ) + dup allocate throw { new-obj } ( meta obj obj-size ) + new-obj swap cmove ( meta ) + new-obj mal-meta ! ( ) + new-obj ;; + +defcore atom ( argv[val] argc ) + drop @ Atom. ;; + +defcore deref ( argv[atom] argc ) + drop @ Atom/val @ ;; + +defcore reset! ( argv[atom,val] argc ) + drop dup cell+ @ ( argv val ) + dup -rot swap @ Atom/val ! ;; + +defcore apply { argv argc -- val } + \ argv is (fn args... more-args) + argv argc 1- cells + @ to-list { more-args } + argc 2 - { list0len } + more-args MalList/count @ list0len + { final-argc } + final-argc cells allocate throw { final-argv } + argv cell+ final-argv list0len cells cmove + more-args MalList/start @ final-argv list0len cells + final-argc list0len - cells cmove + final-argv final-argc argv @ invoke ;; + + +defcore map? drop @ mal-type @ MalMap = mal-bool ;; +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 true? drop @ mal-true = mal-bool ;; +defcore false? drop @ mal-false = mal-bool ;; +defcore nil? drop @ mal-nil = mal-bool ;; + +defcore sequential? drop @ sequential? ;; + +defcore keyword drop @ unpack-str MalKeyword. ;; +defcore symbol drop @ unpack-str MalSymbol. ;; \ No newline at end of file -- cgit v1.2.3 From 6512bd80002eb106a304b035e9592847d90ef23c Mon Sep 17 00:00:00 2001 From: Chouser Date: Thu, 19 Feb 2015 18:34:59 -0500 Subject: forth: Self-hosted mal passes all tests --- forth/core.fs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'forth/core.fs') diff --git a/forth/core.fs b/forth/core.fs index 4216574..1a1cc4d 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -202,12 +202,16 @@ defcore apply { argv argc -- val } more-args MalList/start @ final-argv list0len cells + final-argc list0len - cells cmove final-argv final-argc argv @ invoke ;; +defcore throw ( argv argc -- ) + drop @ to exception-object + 1 throw ;; defcore map? drop @ mal-type @ MalMap = mal-bool ;; 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 atom? drop @ mal-type @ Atom = mal-bool ;; defcore true? drop @ mal-true = mal-bool ;; defcore false? drop @ mal-false = mal-bool ;; defcore nil? drop @ mal-nil = mal-bool ;; @@ -215,4 +219,6 @@ defcore nil? drop @ mal-nil = mal-bool ;; defcore sequential? drop @ sequential? ;; defcore keyword drop @ unpack-str MalKeyword. ;; -defcore symbol drop @ unpack-str MalSymbol. ;; \ No newline at end of file +defcore symbol drop @ unpack-str MalSymbol. ;; + +defcore time-ms 2drop utime d>s 1000 / MalInt. ;; -- cgit v1.2.3