/**
 * (C) 2000 - 2001 Guido Draheim
 *
 * @see LGPL for license
 * @description
 *	this wordset implements a simple module-system.
 *      the basic module-system is based on the three
 *      words MODULE/END-MODULE/EXPORT - these three were
 *      present TEK' mforth, here the MPE' forth is used
 *      as an example for the naming scheme. This 
 *      implementation has also mpe's EXPOSE-MODULE,
 *      and it has a serious form of mpe's REQUIRES
 *      under the name ALSO-MODULE which clarifies that
 *      the search-order is modified. Note also that
 *      pfe defines a REQUIRES in require-ext that works
 *      like INCLUDE-ONCE
 */

#define _P4_SOURCE 1
#include <pfe/pfe-base.h>
#include <string.h>
#include <pfe/forth-83-ext.h>
#include <pfe/forth-usual-ext.h>

/* the name of the hidden wordlist in a module vocabulary */

static const char hidden[] = "HIDDEN'";

/** MODULE ( "name" -- old-current )
 * create a new WORDLIST with the given name. It
 * will also have an implicit hidden vocabulary just as
 * well and all DEFINITIONS will go into that
 * hidden wordlist. Therefore the old CURRENT is
 * memorized on the cs-stack.
 *
 * effectivly, CONTEXT[1] will have the wordlist-id
 * of the public wordlist "name" and CONTEXT[0] will
 * have the hidden wordlist contained in "name" - the
 * hidden wordlist will always be known as HIDDEN' so
 * that it can be re-referenced without need to use
 * ALSO just to access a single definition from 
 * just another vocabulary. Note that HIDDEN' is 
 * defined immediate (a VOCABULARY' ) to modify
 * the ORDER inside a colon definition.
 : MODULE
   CURRENT @ ( -- old-current )
   VOCABULARY
   ALSO LATEST NAME> EXECUTE ALSO DEFINITIONS
   C" HIDDEN'" $CREATE WORDLIST CONTEXT !
 ;
 */
FCode (p4_module)
{
    FX_PUSH (CURRENT);
    FX (p4_also); FX (p4_also);
    FX_HEADER; 
    FX_RUNTIME1 (p4_vocabulary);
    CONTEXT[1] = CURRENT = p4_make_wordlist (LAST);
    p4_header_comma(hidden, strlen(hidden), CURRENT); FX_IMMEDIATE;
    FX_RUNTIME1 (p4_vocabulary);
    CONTEXT[0] = CURRENT = p4_make_wordlist (LAST);
}

/** END-MODULE ( old-current -- )
 * clean up the cs-stack from the last MODULE 
 * definition. Effectivly, MODULE definitions can
 * be nested.
 : END-MODULE ( old-current )
   PREVIOUS PREVIOUS CURRENT ! 
 */
FCode (p4_end_module)
{
    FX (p4_previous);
    FX (p4_previous);
    CURRENT = (Wordl*) FX_POP;
}

/** EXPORT ( old-current "name" -- old-current )
 * the named word in the hidden dictionary (i.e. 
 * the wordlist referenced in CURRENT) is exported
 * into the public wordlist of it (i.e. which is in
 * this implementation CONTEXT[1]). The actual
 * implemenation will create a DEFER-word in the
 * public wordlist withits parameter area pointing
 * to the cfa of the hidden implementation.
 : EXPORT
   CURRENT @ CONTEXT CELL+ @ CURRENT !
   DEFER CURRENT !
   LATEST COUNT CURRENT @ SEARCH-WORDLIST
   IF LATEST NAME> >BODY ! ELSE ABORT" can't find word to export" THEN
 ;
 */
FCode (p4_export)
{
    extern FCode (p4_defer);
    register Wordl* hidden; 
    register p4char* nfa;

    FX (p4_Q_exec);
    hidden = CURRENT; CURRENT = CONTEXT[1];
    FX (p4_defer);    CURRENT = hidden;
    nfa = p4_search_wordlist (PFE.last+1, NFACNT(*PFE.last), hidden);
    if (! nfa) { p4_abortq ("can't find word to export "); }
    *p4_to_body (p4_name_from(PFE.last)) = /* DEFER BODY !! => IS */
        (p4cell) p4_name_from(nfa);
}

/** EXPOSE-MODULE ( "name" -- )
 * affects the search order, ALSO module-wid CONTEXT ! hidden'
 : EXPOSE-MODULE 
    ALSO S" HIDDEN'" 
    ' DUP VOC? ABORT?" is no vocabulary" >VOC 
    SEARCH-WORDLIST 0= IF " no hidden vocabulary found" THEN
    DUP VOC? ABORT?" hidden is no vocabulary" EXECUTE
 ;
 */
FCode (p4_expose_module)
{
    register p4char* nfa;
    auto p4xt xt;

    xt = p4_tick_cfa (FX_VOID);
    if (*P4_TO_CODE(xt) != PFX(p4_vocabulary_RT)) 
    { p4_abortq ("is no vocabulary"); }
    nfa = p4_search_wordlist (hidden, strlen(hidden), p4_to_wordlist(xt));
    if (! nfa) 
    { p4_abortq ("no hidden vocabulary found"); }
    xt = p4_name_from(nfa);
    if (*P4_TO_CODE(xt) != PFX(p4_vocabulary_RT)) 
    { p4_abortq ("hidden is no voc"); }
    FX (p4_also);
    CONTEXT[0] = p4_to_wordlist(xt);
}

/** ALSO-MODULE ( "name" -- )
 * affects the search-order, ALSO module-wid CONTEXT ! 
 : ALSO-MODULE
   ' DUP VOC? ABORT?" is no vocabulary" 
   ALSO EXECUTE
 ;
 */
FCode (p4_also_module)
{
    register p4xt xt = p4_tick_cfa (FX_VOID);
    if (*P4_TO_CODE(xt) != PFX(p4_vocabulary_RT)) 
    { p4_abortq ("is no vocabulary"); }
    FX (p4_also);
    CONTEXT[0] = p4_to_wordlist(xt);
}

P4_LISTWORDS(module) =
{
     (, ),
     (,               ),
     (,           ),
     (,               ),
     (,        ),
     (,          ),
};
P4_COUNTWORDS(module, "MODULE - simple module implementation");

/*
 * Local variables:
 * c-file-style: "stroustrup"
 * End:
 */