git.gag.com Git - debian/pforth/blob - fth/require.fth

   1 \ REQUIRE and REQUIRED
   2 \
   3 \ This code is part of pForth.
   4 \
   5 \ Permission to use, copy, modify, and/or distribute this
   6 \ software for any purpose with or without fee is hereby granted.
   7 \
   8 \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
   9 \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  10 \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  11 \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  12 \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  13 \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  14 \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  15 \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  16
  17 private{
  18
  19 \ Has the file with name C-ADDR/U already been included?
  20 \
  21 \ This searches the "::::<filename>" marker created by INCLUDED.  This
  22 \ works for now, but may break if pForth ever receives wordlists.
  23 : INCLUDED? ( c-addr u -- flag )
  24     s" ::::" here place         ( c-addr u )
  25     here $append                ( )
  26     here find nip 0<>           ( found? )
  27 ;
  28
  29 \ FIXME: use real PARSE-NAME when available
  30 : (PARSE-NAME) ( "word" -- c-addr u ) bl parse-word ;
  31
  32 }private
  33
  34 : REQUIRED ( i*x c-addr u -- j*x ) 2dup included? IF 2drop ELSE included THEN ;
  35 : REQUIRE ( i*x "name" -- i*x ) (parse-name) required ;
  36
  37 privatize