From e46223c2b7ac3579d174386df8e1c0aa8a48d2b0 Mon Sep 17 00:00:00 2001 From: Chouser Date: Sat, 21 Feb 2015 23:15:23 -0500 Subject: forth: Add . interop special operator and tests --- forth/stepA_interop.fs | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'forth/stepA_interop.fs') diff --git a/forth/stepA_interop.fs b/forth/stepA_interop.fs index 0a4050a..9a39889 100644 --- a/forth/stepA_interop.fs +++ b/forth/stepA_interop.fs @@ -261,6 +261,13 @@ defspecial try* { env list -- val } catch-env catch0 cell+ @ TCO-eval endif ;; +defspecial . { env coll -- rtn-list } + depth { old-depth } + coll to-list dup MalList/count @ swap MalList/start @ { count start } + count cells start + start cell+ +do + env i @ eval as-native + cell +loop ;; + MalSymbol extend mal-eval { env sym -- val } 0 sym env get -- cgit v1.2.3 From 3a17cb968281f7e833088fdb22cf793861810912 Mon Sep 17 00:00:00 2001 From: Chouser Date: Sat, 21 Feb 2015 18:50:50 -0500 Subject: forth: Clean up symbol eval for better perf --- forth/stepA_interop.fs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'forth/stepA_interop.fs') diff --git a/forth/stepA_interop.fs b/forth/stepA_interop.fs index 9a39889..4d48ae7 100644 --- a/forth/stepA_interop.fs +++ b/forth/stepA_interop.fs @@ -270,10 +270,12 @@ defspecial . { env coll -- rtn-list } MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym as-native s" '" ...throw-str + else + @ endif ;; drop -- cgit v1.2.3 From a631063f3fa2eaed473369b376a5499df92209bd Mon Sep 17 00:00:00 2001 From: Chouser Date: Sun, 22 Feb 2015 13:20:31 -0500 Subject: forth: Add map-hint to symbols for better perf --- forth/stepA_interop.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'forth/stepA_interop.fs') diff --git a/forth/stepA_interop.fs b/forth/stepA_interop.fs index 4d48ae7..af5f5d8 100644 --- a/forth/stepA_interop.fs +++ b/forth/stepA_interop.fs @@ -273,7 +273,7 @@ MalSymbol sym env env/get-addr dup 0= if drop - 0 0 s" ' not found" sym as-native s" '" ...throw-str + 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; -- cgit v1.2.3