11 The optional File-Access word set

11.6.2.2144.50 REQUIRED FILE EXT

( i * x c-addr u -- i * x )

If the file specified by c-addr u has been INCLUDED or REQUIRED already, but not between the definition and execution of a marker (or equivalent usage of FORGET), discard c-addr u; otherwise, perform the function of INCLUDED.

An ambiguous condition exists if a file is REQUIRED while it is being REQUIRED or INCLUDED.

An ambiguous condition exists, if a marker is defined outside and executed inside a file or vice versa, and the file is REQUIRED again.

An ambiguous condition exists if the same file is REQUIRED twice using different names (e.g., through symbolic links), or different files with the same name are REQUIRED (by doing some renaming between the invocations of REQUIRED).

An ambiguous condition exists if the stack effect of including the file is not ( i * x -- i * x ).

See:

Rationale:

Typical use:
S" filename" REQUIRED

Implementation:

This implementation does not implement the requirements with regard to MARKER and FORGET (REQUIRED only includes each file once, whether a marker was executed or not), so it is not a correct implementation on systems that support these words. It extends the definition of INCLUDED to record the name of files which have been either included or required previously. The names are recorded in a linked list held in the included-names variable.

: save-mem ( addr1 u -- addr2 u ) \ gforth
\ copy a memory block into a newly allocated region in the heap
   SWAP >R
   DUP ALLOCATE THROW
   SWAP 2DUP R> ROT ROT MOVE ;

: name-add ( addr u listp -- )
   >R save-mem ( addr1 u )
   3 CELLS ALLOCATE THROW \ allocate list node
   R@ @ OVER ! \ set next pointer
   DUP R> ! \ store current node in list var
   CELL+ 2! ;

: name-present? ( addr u list -- f )
   ROT ROT 2>R BEGIN ( list R: addr u )
     DUP
   WHILE
     DUP CELL+ 2@ 2R@ COMPARE 0= IF
       DROP 2R> 2DROP TRUE EXIT
     THEN
     @
   REPEAT
   ( DROP 0 ) 2R> 2DROP ;

: name-join ( addr u list -- )
   >R 2DUP R@ @ name-present? IF
     R> DROP 2DROP
   ELSE
     R> name-add
   THEN ;

VARIABLE included-names 0 included-names !

: included ( i*x addr u -- j*x )
   2DUP included-names name-join
   INCLUDED ;

: REQUIRED ( i*x addr u -- i*x )
   2DUP included-names @ name-present? 0= IF
     included
   ELSE
     2DROP
   THEN ;

Testing:

This test requires two additional files: required-helper1.fs and required-helper2.fs. Both of which hold the text:
1+
As for the test themselves:

T{ 0 
   S" required-helper1.fs" REQUIRED \ Increment TOS 
   REQUIRE required-helper1.fs \ Ignore - already loaded 
   INCLUDE required-helper1.fs \ Increment TOS 
-> 2 }T
T{ 0 
   INCLUDE required-helper2.fs \ Increment TOS 
   S" required-helper2.fs" REQUIRED \ Ignored - already loaded 
   REQUIRE required-helper2.fs \ Ignored - already loaded 
   S" required-helper2.fs" INCLUDED \ Increment TOS 
-> 2 }T

ContributeContributions