From: Helmut Eller <eller.helmut@gmail.com>
Date: Wed, 4 Jan 2017 10:11:14 +0000 (+0100)
Subject: Implement REQUIRE (Forth 2012)
X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/commitdiff_plain/5a30561336c83c45b348c1dc59fb9dc4dd15237c

Implement REQUIRE (Forth 2012)

This turned out to be simpler than I had thought, as we can use the
::::<filename> marker to detected already included files.

* fth/require.fth: New file

* fth/loadp4th.fth: Load it. As REQUIRE uses FINDNFA.FROM, the
file filefind.fth is no longer optional.

* fth/system.fth (INCLUDE.MARK.START): Allocate a temporary buffer for
the string.  PAD was problematic because the interpreter versions of
S" and C" also write to PAD, so something like C" foo.fth" $INCLUDE
would created the marker "::::::::".  Despite that, no standard words
should write to PAD.  Of course, neither S" and C" should use PAD.
That's a problem for another day.

* fth/t_file.fth: Restore tests for REQUIRE.
* fth/t_required-helper1.fth, fth/t_required-helper2.fth: Files needed
for tests.
---

diff --git a/fth/loadp4th.fth b/fth/loadp4th.fth
index 3d454f0..3dcb869 100644
--- a/fth/loadp4th.fth
+++ b/fth/loadp4th.fth
@@ -26,6 +26,8 @@ include? task-misc2.fth misc2.fth
 include? [if]    condcomp.fth
 include? save-input save-input.fth
 include? read-line  file.fth
+include? file?      filefind.fth
+include? require    require.fth
 
 \ load floating point support if basic support is in kernel
 exists? F*
@@ -37,7 +39,6 @@ exists? F*
 include? task-member.fth   member.fth
 include? :struct c_struct.fth
 include? smif{   smart_if.fth
-include? file?   filefind.fth
 include? see     see.fth
 include? words.like wordslik.fth
 include? trace   trace.fth
diff --git a/fth/require.fth b/fth/require.fth
new file mode 100644
index 0000000..c18d8c4
--- /dev/null
+++ b/fth/require.fth
@@ -0,0 +1,35 @@
+\ REQUIRE and REQUIRED
+\
+\ This code is part of pForth.
+\
+\ The pForth software code is dedicated to the public domain,
+\ and any third party may reproduce, distribute and modify
+\ the pForth software code or any derivative works thereof
+\ without any compensation or license.  The pForth software
+\ code is provided on an "as is" basis without any warranty
+\ of any kind, including, without limitation, the implied
+\ warranties of merchantability and fitness for a particular
+\ purpose and their equivalents under the laws of any jurisdiction.
+
+private{
+
+\ Has the file with name C-ADDR/U already been included?
+\
+\ This searches the "::::<filename>" marker created by INCLUDED.  This
+\ works for now, but may break if pForth ever receives wordlists.
+: INCLUDED? ( c-addr u -- flag )
+    s" ::::" here place         ( c-addr u )
+    here $append                ( )
+    here latest findnfa.from    ( x found? )
+    nip
+;
+
+\ FIXME: use real PARSE-NAME when available
+: (PARSE-NAME) ( "word" -- c-addr u ) bl parse-word ;
+
+}private
+
+: REQUIRED ( i*x c-addr u -- j*x ) 2dup included? IF 2drop ELSE included THEN ;
+: REQUIRE ( i*x "name" -- i*x ) (parse-name) required ;
+
+privatize
diff --git a/fth/system.fth b/fth/system.fth
index c1b7f66..5830cce 100644
--- a/fth/system.fth
+++ b/fth/system.fth
@@ -721,9 +721,11 @@ ustack 0stackp
 variable TRACE-INCLUDE
 
 : INCLUDE.MARK.START  ( c-addr u -- , mark start of include for FILE?)
-    " ::::"  pad $MOVE
-    pad $APPEND
-    pad ['] noop (:)
+    dup 5 + allocate throw >r
+    " ::::" r@ $move
+    r@ $append
+    r@ ['] noop (:)
+    r> free throw
 ;
 
 : INCLUDE.MARK.END  ( -- , mark end of include )
diff --git a/fth/t_file.fth b/fth/t_file.fth
index 388008c..7171a78 100644
--- a/fth/t_file.fth
+++ b/fth/t_file.fth
@@ -246,6 +246,21 @@ T{ FID1 @ CLOSE-FILE -> 0 }T
 \ Tidy the test folder
 T{ fn3 DELETE-FILE DROP -> }T
 
+\ ------------------------------------------------------------------------------
+TESTING REQUIRED REQUIRE INCLUDED
+\ Tests taken from Forth 2012 RfD
+
+T{ 0 S" t_required-helper1.fth" REQUIRED
+     REQUIRE t_required-helper1.fth
+     INCLUDE t_required-helper1.fth
+     -> 2 }T
+
+T{ 0 INCLUDE t_required-helper2.fth
+     S" t_required-helper2.fth" REQUIRED
+     REQUIRE t_required-helper2.fth
+     S" t_required-helper2.fth" INCLUDED
+     -> 2 }T
+
 \ ----------------------------------------------------------------------------
 TESTING two buffers available for S" and/or S\" (Forth 2012)
 
diff --git a/fth/t_required-helper1.fth b/fth/t_required-helper1.fth
new file mode 100644
index 0000000..910cef4
--- /dev/null
+++ b/fth/t_required-helper1.fth
@@ -0,0 +1,3 @@
+\ For testing REQUIRED etc
+
+1+
diff --git a/fth/t_required-helper2.fth b/fth/t_required-helper2.fth
new file mode 100644
index 0000000..910cef4
--- /dev/null
+++ b/fth/t_required-helper2.fth
@@ -0,0 +1,3 @@
+\ For testing REQUIRED etc
+
+1+