Adding needs, fixing include to be more like gforth.

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
+needs testing.fs
-include common/utils.fs
+needs utils.fs
-include common/base_tests.fs
+needs base_tests.fs
-include common/utils_tests.fs
+needs utils_tests.fs
-include common/vocabulary_tests.fs
+needs vocabulary_tests.fs
-include common/locals_tests.fs
+needs locals_tests.fs
-include common/doloop_tests.fs
+needs doloop_tests.fs
-include common/conditionals_tests.fs
+needs conditionals_tests.fs
-include common/float_tests.fs
+needs float_tests.fs
-include common/forth_namespace_tests.fs
+needs forth_namespace_tests.fs
-include common/structures_tests.fs
+needs structures_tests.fs
 run-tests

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
 

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

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
+   swap over >r
-   rot dup >r read-file throw drop
+   rot read-file throw
-   r> close-file throw
+   r@ swap evaluate
-   r> r> over >r 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