From 35a02bc61c073d908ce5ce2fb969f95489053d63 Mon Sep 17 00:00:00 2001 From: Brad Nelson Date: Sat, 23 Apr 2022 23:52:12 -0700 Subject: [PATCH] Adding needs, fixing include to be more like gforth. --- common/all_tests.fs | 22 +++++------ common/editor.fs | 2 +- common/forth_namespace_tests.fs | 3 ++ common/including.fs | 69 +++++++++++++++++++++++++++++---- 4 files changed, 77 insertions(+), 19 deletions(-) diff --git a/common/all_tests.fs b/common/all_tests.fs index c66e9b0..b6485fc 100644 --- a/common/all_tests.fs +++ b/common/all_tests.fs @@ -12,15 +12,15 @@ \ See the License for the specific language governing permissions and \ limitations under the License. -include common/testing.fs -include common/utils.fs -include common/base_tests.fs -include common/utils_tests.fs -include common/vocabulary_tests.fs -include common/locals_tests.fs -include common/doloop_tests.fs -include common/conditionals_tests.fs -include common/float_tests.fs -include common/forth_namespace_tests.fs -include common/structures_tests.fs +needs testing.fs +needs utils.fs +needs base_tests.fs +needs utils_tests.fs +needs vocabulary_tests.fs +needs locals_tests.fs +needs doloop_tests.fs +needs conditionals_tests.fs +needs float_tests.fs +needs forth_namespace_tests.fs +needs structures_tests.fs run-tests diff --git a/common/editor.fs b/common/editor.fs index 6b49c29..afd04d3 100644 --- a/common/editor.fs +++ b/common/editor.fs @@ -12,7 +12,7 @@ \ See the License for the specific language governing permissions and \ limitations under the License. -include posix/termios.fs +needs ../posix/termios.fs create keymap diff --git a/common/forth_namespace_tests.fs b/common/forth_namespace_tests.fs index 4eb9019..c963a1c 100644 --- a/common/forth_namespace_tests.fs +++ b/common/forth_namespace_tests.fs @@ -429,6 +429,9 @@ e: check-args ;e e: check-highlevel + out: needs + out: required + out: included? out: include out: included ;e diff --git a/common/including.fs b/common/including.fs index cbb4396..fb98386 100644 --- a/common/including.fs +++ b/common/including.fs @@ -13,13 +13,68 @@ \ limitations under the License. ( Including Files ) -: included ( a n -- ) - r/o open-file dup if nip throw else drop then + +internals definitions + +: dirname ( a n -- ) + begin dup while + 2dup 1- + c@ [char] / = if exit then 1- + repeat ; + +0 value sourcefilename& +0 value sourcefilename# +: sourcefilename ( -- a n ) sourcefilename& sourcefilename# ; +: sourcefilename! ( a n -- ) to sourcefilename# to sourcefilename& ; +: sourcedirname ( -- a n ) sourcefilename dirname ; + +: include-file ( fh -- ) dup file-size throw dup allocate throw - swap 2dup >r >r - rot dup >r read-file throw drop - r> close-file throw - r> r> over >r evaluate + swap over >r + rot read-file throw + r@ swap evaluate r> free throw ; -: include ( "name" -- ) bl parse included ; + +: raw-included ( a n -- ) + r/o open-file throw + dup >r include-file + r> close-file throw ; + +0 value included-files + +: path-join { a a# b b# -- a n } + a# b# + { r# } r# cell+ cell+ allocate throw { r } + 2 cells +to r + b c@ [char] / = if 0 to a# then + a r a# cmove b r a# + b# cmove + r# r cell - ! + r r# ; +: include+ 2 cells - { a } + included-files a ! a to included-files ; + +forth definitions internals + +: included ( a n -- ) + sourcefilename >r >r + >r >r sourcedirname r> r> path-join 2dup sourcefilename! + ['] raw-included catch + dup if ." Error including: " sourcefilename type cr then + sourcefilename& include+ + r> r> sourcefilename! + throw ; + +: include ( "name" -- ) bl parse included ; + +: included? { a n -- f } + sourcedirname a n path-join to n to a + included-files begin dup while + dup cell+ cell+ over cell+ @ a n str= if + a 2 cells - free throw drop -1 exit + then @ + repeat + a 2 cells - free throw ; + +: required ( a n -- ) 2dup included? if 2drop else included then ; +: needs ( "name" -- ) bl parse required ; + +forth