modules.c File Reference

modules More...

Go to the source code of this file.

Macros
#define	MAKE_PUBLIC   1
#define	MAKE_PRIVATE   2
#define	MAKE_FEATURE_PRIVATE   3

Functions
void	init_modules ()
	init_modules More...
ptr_module	find_module (char *module)
	find_module More...
ptr_module	create_module (char *module)
	ptr_module create_module(char *module) More...
ptr_module	set_current_module (ptr_module module)
	set_current_module More...
ptr_module	extract_module_from_name (char *str)
	extract_module_from_name More...
char *	strip_module_name (char *str)
	strip_module_name More...
char *	string_val (ptr_psi_term term)
	string_val More...
char *	make_module_token (ptr_module module, char *str)
	make_module_token More...
ptr_definition	new_definition (ptr_keyword key)
	new_definition More...
ptr_definition	update_symbol (ptr_module module, char *symbol)
	update_symbol More...
char *	print_symbol (ptr_keyword k)
	print_symbol More...
void	pretty_symbol (ptr_keyword k)
	pretty_symbol More...
void	pretty_quote_symbol (ptr_keyword k)
	pretty_quote_symbol More...
long	c_set_module ()
	c_set_module More...
long	c_open_module ()
	c_open_module More...
void	open_module_tree (ptr_node n, int *onefailed)
	open_module_tree More...
void	open_module_one (ptr_psi_term t, int *onefailed)
	open_module_one More...
long	make_public (ptr_psi_term term, long bool)
	make_public More...
void	traverse_tree (ptr_node n, int flag)
	traverse_tree More...
long	c_public ()
	c_public More...
long	c_private ()
	c_private More...
long	c_display_modules ()
	c_display_modules More...
long	c_display_persistent ()
	c_display_persistent More...
long	c_trace_input ()
	c_trace_input More...
void	rec_replace (ptr_definition, ptr_definition, ptr_psi_term)
	rec_replace More...
void	replace_attr (ptr_node, ptr_psi_term, ptr_definition, ptr_definition)
	replace_attr More...
void	replace (ptr_definition old, ptr_definition new, ptr_psi_term term)
	replace More...
long	c_replace ()
	c_replace More...
long	c_current_module ()
	c_current_module More...
long	c_module_access ()
	c_module_access More...
int	global_unify_attr (ptr_node, ptr_node)
	global_unify_attr More...
int	global_unify (ptr_psi_term u, ptr_psi_term v)
	global_unify More...
long	c_alias ()
	c_alias More...
int	get_module (ptr_psi_term psi, ptr_module *module)
	get_module More...
int	make_feature_private (ptr_psi_term term)
	make_feature_private More...
long	c_private_feature ()
	c_private_feature More...
ptr_definition	update_feature (ptr_module module, char *feature)
	update_feature More...
long	all_public_symbols ()
	all_public_symbols More...

Variables
ptr_node	module_table =NULL
ptr_module	current_module =NULL
ptr_module	no_module =NULL
ptr_module	bi_module =NULL
ptr_module	syntax_module =NULL
ptr_module	sys_module =NULL
ptr_module	user_module =NULL
ptr_module	x_module = NULL
long	display_modules =TRUE

Detailed Description

modules

RM: Jan 7 1993

This file implements a variation of the LIFE module system as specified by Dinesh Katiyar.

Definition in file modules.c.

Macro Definition Documentation

#define MAKE_FEATURE_PRIVATE   3

Definition at line 645 of file modules.c.

#define MAKE_PRIVATE   2

Definition at line 644 of file modules.c.

#define MAKE_PUBLIC   1

Definition at line 643 of file modules.c.

Function Documentation

long all_public_symbols

(

)

all_public_symbols

ALL_PUBLIC_SYMBOLS Returns all public symbols from all modules or a specific module.

Definition at line 1363 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, deref_ptr, first_definition, get_module(), get_two_args(), wl_definition::keyword, wl_keyword::module, wl_definition::next, NULL, wl_keyword::public, push_goal(), stack_cons(), stack_nil(), stack_psi_term(), TRUE, wl_psi_term::type, and unify.

{
  ptr_psi_term arg1,arg2,funct,result;
  ptr_psi_term list;
  ptr_psi_term car;
  ptr_module module=NULL;
  ptr_definition d;
  
  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_two_args(funct->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
  
  if(arg1) {
    deref_ptr(arg1);
    (void)get_module(arg1,&module);
  }
  else
    module=NULL;
  
  list=stack_nil();
  
  for(d=first_definition;d;d=d->next)
    if(d->keyword->public && (!module || d->keyword->module==module)) {
      car=stack_psi_term(4);
      car->type=d;
      list=stack_cons(car,list);
    }
  
  push_goal(unify,result,list,NULL);
  
  return TRUE;
}

long c_alias

(

)

c_alias

C_ALIAS Alias one keyword to another.

Definition at line 1180 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_keyword::combined_name, wl_keyword::definition, deref_ptr, Errorline(), FALSE, get_two_args(), hash_lookup(), wl_definition::keyword, wl_module::module_name, wl_keyword::symbol, wl_module::symbol_table, TRUE, wl_psi_term::type, and warningline().

{
  long success=TRUE;
  ptr_psi_term arg1,arg2,g;
  ptr_keyword key;

  g=aim->aaaa_1;

  deref_ptr(g);
  get_two_args(g->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
  if (arg1 && arg2) {
    deref_ptr(arg1);
    deref_ptr(arg2);
    
    key=hash_lookup(current_module->symbol_table,arg1->type->keyword->symbol);
    if(key) {
      if(key->definition!=arg2->type) {
    warningline("alias: '%s' has now been overwritten by '%s'\n",
         key->combined_name,
         arg2->type->keyword->combined_name);
    
    key->definition=arg2->type;
      }
    }
    else
      Errorline("module violation: cannot alias '%s' from module \"%s\"\n",
        key->combined_name,
        current_module->module_name);
  }
  else {
    success=FALSE;
    Errorline("argument(s) missing in '%P'\n",g);
  }
  
  return success;
}

long c_current_module

(

)

c_current_module

C_CURRENT_MODULE Return the current module.

Definition at line 974 of file modules.c.

References wl_goal::aaaa_1, aim, wl_goal::bbbb_1, deref_ptr, heap_copy_string(), wl_module::module_name, NULL, push_goal(), quoted_string, resid_aim, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

{
  long success=TRUE;
  ptr_psi_term result,g,other;
  
  g=aim->aaaa_1;
  deref_ptr(g);
  result=aim->bbbb_1;
  deref_ptr(result);
  
  other=stack_psi_term(4);
  /* PVR 24.1.94 */
  other->type=quoted_string;
  other->value_3=(GENERIC)heap_copy_string(current_module->module_name);
  /*
    update_symbol(current_module,
    current_module->module_name)
    ->keyword->symbol
    );
*/ /* RM: 2/15/1994 */
  /* other->type=update_symbol(current_module,current_module->module_name); */
  resid_aim=NULL;
  push_goal(unify,result,other,NULL);
  
  return success;
}

long c_display_modules

(

)

c_display_modules

C_DISPLAY_MODULES(); Set the display modules switch.

Definition at line 739 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, display_modules, Errorline(), FALSE, get_two_args(), lf_false, lf_true, TRUE, and wl_psi_term::type.

{
  ptr_psi_term arg1,arg2;
  ptr_psi_term call;
  int success=TRUE;
  
  
  call=aim->aaaa_1;
  deref_ptr(call);
  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
  
  if(arg1) {
    deref_ptr(arg1);
    if(arg1->type==lf_true)
      display_modules=TRUE;
    else
      if(arg1->type==lf_false)
    display_modules=FALSE;
      else {
    Errorline("argument should be boolean in '%P'\n",call);
    success=FALSE;
      }
  }
  else /* No argument: toggle */
    display_modules= !display_modules;
  
  return success;
}

long c_display_persistent

(

)

c_display_persistent

C_DISPLAY_PERSISTENT(); Set the display persistent switch.

Definition at line 775 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, display_persistent, Errorline(), FALSE, get_two_args(), lf_false, lf_true, TRUE, and wl_psi_term::type.

{
  ptr_psi_term arg1,arg2;
  ptr_psi_term call;
  int success=TRUE;
  
  call=aim->aaaa_1;
  deref_ptr(call);
  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
  
  if(arg1) {
    deref_ptr(arg1);
    if(arg1->type==lf_true)
      display_persistent=TRUE;
    else
      if(arg1->type==lf_false)
    display_persistent=FALSE;
      else {
    Errorline("argument should be boolean in '%P'\n",call);
    success=FALSE;
      }
  }
  else /* No argument: toggle */
    display_persistent= !display_persistent;
  
  return success;
}

long c_module_access

(

)

c_module_access

C_MODULE_ACCESS Return the psi-term Module::Symbol

Definition at line 1008 of file modules.c.

References wl_goal::aaaa_1, aim, deref_ptr, FALSE, and warningline().

{
  long success=FALSE;
  //  ptr_psi_term result,module,symbol,call,other;
  ptr_psi_term call;
  
  
  call=aim->aaaa_1;
  deref_ptr(call);
  
  /*
    result=aim->bbbb_1;
    deref_ptr(result);
    get_two_args(call,(ptr_psi_term *)&module,(ptr_psi_term *)&symbol);
    
    if(module && symbol) {
    other=stack_psi_term(4);
    other->type=update_symbol(module_access,module_access->module_name);
    resid_aim=NULL;
    push_goal(unify,result,other,NULL);
    
    }
    */
  
  warningline("%P not implemented yet...\n",call);
  
  return success;
}

long c_open_module

(

)

c_open_module

C_OPEN_MODULE() Open one or more modules, that is, alias all the public words in the current module to the definitions in the argument. An error message is printed for each module that is not successfully opened. If at least one module was not successfully opened, the routine fails.

Definition at line 519 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, and open_module_tree().

{
  ptr_psi_term call;
  int onefailed=FALSE;
  call=aim->aaaa_1;
  deref_ptr(call);
  if (call->attr_list) {
    open_module_tree(call->attr_list, &onefailed);
 }
  else {
    Errorline("argument missing in '%P'\n",call);
  }
  
  return !onefailed;
}

long c_private

(

)

c_private

C_PRIVATE() The argument is a single symbol or a list of symbols. Make them private in the current module if they belong to it.

Definition at line 714 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, MAKE_PRIVATE, traverse_tree(), and TRUE.

{
  ptr_psi_term call;
  int success;
  
  call=aim->aaaa_1;
  deref_ptr(call);
  if (call->attr_list) {
    traverse_tree(call->attr_list,MAKE_PRIVATE);
    success=TRUE;
  } else {
    Errorline("argument missing in '%P'\n",call);
    success=FALSE;
  }
  
  return success;
}

long c_private_feature

(

)

c_private_feature

C_PRIVATE_FEATURE() The argument is a single symbol or a list of symbols. Make this feature private to the current module.

Definition at line 1302 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, MAKE_FEATURE_PRIVATE, traverse_tree(), and TRUE.

{
  //  ptr_psi_term arg1,arg2;
  ptr_psi_term call;
  int success;
  
  call=aim->aaaa_1;
  deref_ptr(call);
  if (call->attr_list) {
    traverse_tree(call->attr_list,MAKE_FEATURE_PRIVATE);
    success=TRUE;
  } else {
    Errorline("argument missing in '%P'\n",call);
    success=FALSE;
  }
  
  return success;
}

long c_public

(

)

c_public

C_PUBLIC() The argument(s) are symbols. Make them public in the current module if they belong to it.

Definition at line 687 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, MAKE_PUBLIC, traverse_tree(), and TRUE.

{
  //  ptr_psi_term arg1,arg2;
  ptr_psi_term call;
  int success;
  
  call=aim->aaaa_1;
  deref_ptr(call);
  if (call->attr_list) {
    traverse_tree(call->attr_list,MAKE_PUBLIC);
    success=TRUE;
  } else {
    Errorline("argument missing in '%P'\n",call);
    success=FALSE;
  }
  
  return success;
}

long c_replace

(

)

c_replace

C_REPLACE() Replace all occurrences of type ARG1 with ARG2 in ARG3.

Definition at line 936 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_node::data, deref_ptr, Errorline(), FALSE, FEATCMP, find(), get_two_args(), NULL, replace(), three, TRUE, and wl_psi_term::type.

{
  ptr_psi_term arg1=NULL;
  ptr_psi_term arg2=NULL;
  ptr_psi_term arg3=NULL;
  ptr_psi_term call;
  int success=FALSE;
  ptr_node n;
  
  call=aim->aaaa_1;
  deref_ptr(call);
  
  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
  n=find(FEATCMP,three,call->attr_list);
  if (n)
    arg3=(ptr_psi_term)n->data;
  
  if(arg1 && arg2 && arg3) {
    deref_ptr(arg1);
    deref_ptr(arg2);
    deref_ptr(arg3);
    replace(arg1->type,arg2->type,arg3);
    success=TRUE;
  }
  else {
    Errorline("argument missing in '%P'\n",call);
  }
  
  return success;
}

long c_set_module

(

)

c_set_module

C_SET_MODULE() This routine retrieves the necessary psi-term to determine the current state of the module mechanism from the heap.

Definition at line 488 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, create_module(), deref_ptr, Errorline(), FALSE, get_two_args(), set_current_module(), string_val(), and TRUE.

{
  ptr_psi_term arg1,arg2;
  ptr_psi_term call;
  
  call=aim->aaaa_1;
  deref_ptr(call);
  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
  
  if(arg1) {
    (void)set_current_module(create_module(string_val(arg1)));
    return TRUE;
  }
  else {
    Errorline("argument missing in '%P'\n",call);
    return FALSE;
  }
}

long c_trace_input

(

)

c_trace_input

C_TRACE_INPUT(); Set the trace_input switch.

Definition at line 810 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, get_two_args(), lf_false, lf_true, trace_input, TRUE, and wl_psi_term::type.

{
  ptr_psi_term arg1,arg2;
  ptr_psi_term call;
  int success=TRUE;
  
  call=aim->aaaa_1;
  deref_ptr(call);
  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
  
  if(arg1) {
    deref_ptr(arg1);
    if(arg1->type==lf_true)
      trace_input=TRUE;
    else
      if(arg1->type==lf_false)
    trace_input=FALSE;
      else {
    Errorline("argument should be boolean in '%P'\n",call);
    success=FALSE;
      }
  }
  else /* No argument: toggle */
    trace_input= !trace_input;
  
  return success;
}

ptr_module create_module

(

char *

module

)

ptr_module create_module(char *module)

CREATE_MODULE(module) Create a new module.

Definition at line 72 of file modules.c.

References find_module(), hash_create(), HEAP_ALLOC, heap_copy_string(), heap_insert(), input_file_name, NULL, and STRCMP.

{
  ptr_module new;


  new=find_module(module);
  if(!new) {
    new=HEAP_ALLOC(struct wl_module);
    new->module_name=(char *)heap_copy_string(module);
    new->source_file=(char *)heap_copy_string(input_file_name);
    new->open_modules=NULL;
    new->inherited_modules=NULL;
    new->symbol_table=hash_create(16); /*  RM: Feb  3 1993  */

    (void)heap_insert(STRCMP,new->module_name,&module_table,(GENERIC)new);

  }
  return new;
}

ptr_module extract_module_from_name

(

char *

str

)

extract_module_from_name

Parameters

str	- char *str

EXTRACT_MODULE_FROM_NAME Return the module corresponding to "module#symbol". Return NULL if only "#symbol".

Definition at line 116 of file modules.c.

References create_module(), legal_in_name(), and NULL.

{
  char *s;
  ptr_module result=NULL;

  s=str;
  while(legal_in_name(*s))
    s++;
  if(s!=str && *s=='#' /* && *(s+1)!=0 */) {
    *s=0;
    result=create_module(str);
    *s='#';
    /*
    printf("Extracted module name '%s' from '%s'\n",result->module_name,str);
    */
  }
  
  return result;
}

ptr_module find_module

(

char *

module

)

find_module

Parameters

module

char *module

FIND_MODULE(module) Return a module if it exists.

Definition at line 54 of file modules.c.

References wl_node::data, FEATCMP, find(), and NULL.

{
  ptr_node nodule;

  nodule=find(FEATCMP,(char *)module,module_table);
  if(nodule)
    return (ptr_module)(nodule->data);
  else
    return NULL;
}

int get_module	(	ptr_psi_term	psi,
		ptr_module *	module
	)

get_module

Parameters

psi	- ptr_psi_term psi
module	- ptr_module *module

GET_MODULE(psi,module,resid) Convert a psi-term to a module. The psi-term must be a string.

Definition at line 1226 of file modules.c.

References deref_ptr, Errorline(), FALSE, find_module(), wl_definition::keyword, NULL, overlap_type(), quoted_string, wl_keyword::symbol, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

{
  int success=TRUE;
  char *s;
  
  *module=NULL;
  
  deref_ptr(psi);
  if(overlap_type(psi->type,quoted_string) && psi->value_3)
    s=(char *)psi->value_3;
  else
    s=psi->type->keyword->symbol;
  
  *module=find_module(s);
  if(!(*module)) {
    Errorline("undefined module \"%s\"\n",s);
    success=FALSE;
  }
  
  return success;
}

int global_unify	(	ptr_psi_term	u,
		ptr_psi_term	v
	)

global_unify

Parameters

u	- ptr_psi_term u
v	- ptr_psi_term v

GLOBAL_UNIFY(u,v) Unify two psi-terms, where it is known that V is on the heap (a persistent variable).

This routine really matches U and V, it will only succeed if V is more general than U. U will then be bound to V.

Definition at line 1053 of file modules.c.

References wl_psi_term::attr_list, c_abort(), wl_psi_term::coref, deref_ptr, Errorline(), FALSE, glb(), global_unify_attr(), heap_pointer, overlap_type(), push_psi_ptr_value(), quoted_string, REAL, real, release_resid(), wl_psi_term::resid, traceline(), TRUE, wl_psi_term::type, and wl_psi_term::value_3.

{
  int success=TRUE;
  int compare;
  ptr_definition new_type;
  ptr_int_list new_code;

  deref_ptr(u);
  deref_ptr(v);

  traceline("match persistent %P with %P\n",u,v);

  /* printf("u=%ld, v=%ld, heap_pointer=%ld\n",u,v,heap_pointer);*/

  /* printf("u=%s, v=%s\n",
     u->type->keyword->symbol,
     v->type->keyword->symbol); */
  
  if((GENERIC)u>=heap_pointer) {
    Errorline("cannot unify persistent values\n");
    return c_abort();
  }
  
  /**** U is on the stack, V is on the heap ****/
  
  /**** Calculate their Greatest Lower Bound and compare them ****/
  compare=glb(u->type,v->type,&new_type,&new_code);
  
  /* printf("compare=%d\n",compare); */
  
  if (compare==1 || compare==3) { /* Match only */
    
    /**** Check for values ****/
    if(v->value_3) {
      if(u->value_3) {
    if(u->value_3!=v->value_3) { /* One never knows */
      if (overlap_type(v->type,real))
        success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
      else if (overlap_type(v->type,quoted_string))
        success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
      else
        return FALSE; /* Don't unify CUTs and STREAMs and things */
    }
      }
    }
    else
      if(u->value_3)
    return FALSE;
    
    if(success) {
      /**** Bind the two psi-terms ****/
      push_psi_ptr_value(u,(GENERIC *)&(u->coref));
      u->coref=v;
      
      /**** Match the attributes ****/
      success=global_unify_attr(u->attr_list,v->attr_list);

      /*
    if(!success)
    warningline("attributes don't unify in %P and %P\n",u,v);
    */
      
      if(success && u->resid)
    release_resid(u);
    }
  }
  else
    success=FALSE;
  
  return success;
}

int global_unify_attr	(	ptr_node	u,
		ptr_node	v
	)

global_unify_attr

Parameters

u	- ptr_node u
v	- ptr_node v

GLOBAL_UNIFY_ATTR(u,v) Unify the attributes of two terms, one on the heap, one on the stack. This is really matching, so all features of U must appear in V.

Definition at line 1135 of file modules.c.

References wl_node::data, dummy_printf(), FALSE, featcmp(), global_unify(), wl_node::key, wl_node::left, NULL, wl_node::right, and TRUE.

{
  int success=TRUE;
  ptr_node temp;
  long cmp;

  if(u)
    if(v) {
      /*  RM: Feb 16 1993  Avoid C optimiser bug */
      (void)dummy_printf("%s %s\n",u->key,v->key);
      
      cmp=featcmp(u->key,v->key);
      if(cmp<0) {
    temp=u->right;
    u->right=NULL;
    success=global_unify_attr(u,v->left) && global_unify_attr(temp,v);
    u->right=temp;
      }
      else
    if(cmp>0) {
      temp=u->left;
      u->left=NULL;
      success=global_unify_attr(u,v->right) && global_unify_attr(temp,v);
      u->left=temp;
    }
    else {
      success=
        global_unify_attr(u->left,v->left) &&
          global_unify_attr(u->right,v->right) &&
        global_unify((ptr_psi_term)u->data,(ptr_psi_term)v->data);
    }
    }
    else
      success=FALSE;
  
  return success;
}

void init_modules

(

)

init_modules

INIT_MODULES() Initialize the module system.

Definition at line 34 of file modules.c.

References create_module(), and set_current_module().

{
  bi_module=create_module("built_ins");
  no_module=create_module("no_module");
  x_module=create_module("x");
  syntax_module=create_module("syntax");
  user_module=create_module("user"); /*  RM: Jan 27 1993  */
  sys_module=create_module("sys");
  
  (void)set_current_module(syntax_module);
}

int make_feature_private

(

ptr_psi_term

term

)

make_feature_private

Parameters

term	- ptr_psi_term term

MAKE_FEATURE_PRIVATE(feature) Make a feature private.

Definition at line 1256 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, deref_ptr, hash_lookup(), wl_definition::keyword, wl_keyword::private_feature, wl_keyword::public, wl_keyword::symbol, wl_module::symbol_table, TRUE, wl_psi_term::type, update_symbol(), and warningline().

{
  int ok=TRUE;
  ptr_keyword key;
  ptr_definition def;

  deref_ptr(term);

  key=hash_lookup(current_module->symbol_table,term->type->keyword->symbol);
  
  if(key) {
    /*
      if(key->definition->keyword->module!=current_module) {
      warningline("local definition of '%s' overrides '%s'\n",
      key->definition->keyword->symbol,
      key->definition->keyword->combined_name);
      
      new_definition(key);
      }
    */
    
    key->private_feature=TRUE;
    def=key->definition;
  }
  else {
    def=update_symbol(current_module,term->type->keyword->symbol);
    def->keyword->private_feature=TRUE;
  }

  
  if(ok && def->keyword->public) {
    warningline("feature '%s' is now private, but was also declared public\n",
        def->keyword->combined_name);
  }
  
  return ok;
}

char* make_module_token	(	ptr_module	module,
		char *	str
	)

make_module_token

Parameters

module	- ptr_module module
str	- char *str

MAKE_MODULE_TOKEN(module,string) Write 'module::string' in module_buffer. If string is a qualified reference to a given module, then modify the calling module variable to reflect this.

The result must be immediately stored in a newly allocated string.

Definition at line 191 of file modules.c.

References extract_module_from_name(), module_buffer, and wl_module::module_name.

{
  ptr_module explicit;


  /* Check if the string already contains a module */
  explicit=extract_module_from_name(str);
  if(explicit)
    strcpy(module_buffer,str);
  else
    if(module!=no_module) {
      strcpy(module_buffer,module->module_name);
      strcat(module_buffer,"#");
      strcat(module_buffer,str);
    }
    else
      strcpy(module_buffer,str);
  
  return module_buffer;
}

long make_public	(	ptr_psi_term	term,
		long	bool
	)

make_public

Parameters

term	- ptr_psi_term term
bool	- long bool

MAKE_PUBLIC(term,bool) Make a term public.

Definition at line 613 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, deref_ptr, hash_lookup(), wl_definition::keyword, wl_keyword::module, new_definition(), wl_keyword::public, wl_keyword::symbol, wl_module::symbol_table, TRUE, wl_psi_term::type, update_symbol(), and warningline().

{
  int ok=TRUE;
  ptr_keyword key;
  ptr_definition def;
  
  deref_ptr(term);

  key=hash_lookup(current_module->symbol_table,term->type->keyword->symbol);
  if(key) {
    
    if(key->definition->keyword->module!=current_module && !bool) {
      warningline("local definition of '%s' overrides '%s'\n",
           key->definition->keyword->symbol,
           key->definition->keyword->combined_name);
      
      (void)new_definition(key);
    }
    
    key->public=bool;
  }
  else {
    def=update_symbol(current_module,term->type->keyword->symbol);
    def->keyword->public=bool;
  }
  
  return ok;
}

ptr_definition new_definition

(

ptr_keyword

key

)

new_definition

Parameters

key	- ptr_keyword key

NEW_DEFINITION(key) Create a definition for a key.

Definition at line 220 of file modules.c.

References wl_definition::already_loaded, wl_definition::always_check, wl_definition::children, wl_definition::code, wl_definition::date, wl_keyword::definition, wl_definition::evaluate_args, FALSE, first_definition, wl_definition::global_value, HEAP_ALLOC, wl_definition::init_value, wl_definition::keyword, wl_definition::next, NOT_CODED, NULL, wl_definition::op_data, wl_definition::parents, wl_definition::properties, wl_definition::protected, wl_definition::rule, TRUE, wl_definition::type_def, and undef_it.

{
  ptr_definition result;

  
  /* printf("*** New definition: %s\n",key->combined_name); */
  
  /* Create a new definition */
  result=HEAP_ALLOC(struct wl_definition);
  
  /*  RM: Feb  3 1993  */
  result->next=first_definition; /* Linked list of all definitions */
  first_definition=result;
        
  result->keyword=key;
  result->rule=NULL;
  result->properties=NULL;
  result->date=0;
  result->type_def=(def_type)undef_it;
  result->always_check=TRUE;
  result->protected=TRUE;
  result->evaluate_args=TRUE;
  result->already_loaded=FALSE;
  result->children=NULL;
  result->parents=NULL;
  result->code=NOT_CODED;
  result->op_data=NULL;
  result->global_value=NULL; /*  RM: Feb  8 1993  */
  result->init_value=NULL;   /*  RM: Mar 23 1993  */
  key->definition=result;

  return result;
}

void open_module_one	(	ptr_psi_term	t,
		int *	onefailed
	)

open_module_one

Parameters

t	= ptr_psi_term t
onefailed	- int *onefailed

Definition at line 562 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, Errorline(), FALSE, find_module(), hash_lookup(), HEAP_ALLOC, wl_int_list::next, wl_module::open_modules, wl_keyword::public, string_val(), wl_keyword::symbol, wl_module::symbol_table, TRUE, and wl_int_list::value_1.

{
  ptr_module open_module;
  ptr_int_list opens;
  ptr_keyword key1,key2;
  int i;
  int found=FALSE;

  open_module=find_module(string_val(t));
  if (open_module) {
    
    for (opens=current_module->open_modules;opens;opens=opens->next)
    if (opens->value_1 == (GENERIC)open_module) {
      /* warningline("module \"%s\" is already open\n",
         open_module->module_name); */ /*  RM: Jan 27 1993  */
      found=TRUE;
    }
    
    if (!found) {
    opens=HEAP_ALLOC(struct wl_int_list);
    opens->value_1=(GENERIC)open_module;
    opens->next=current_module->open_modules;
    current_module->open_modules=opens;

    /* Check for name conflicts */
    /*  RM: Feb 23 1993  */
    for (i=0;i<open_module->symbol_table->size;i++)
      if ((key1=open_module->symbol_table->data[i]) && key1->public) {
        key2=hash_lookup(current_module->symbol_table,key1->symbol);
        if (key2 && key1->definition!=key2->definition)
          Errorline("symbol clash '%s' and '%s'\n",
            key1->combined_name,
            key2->combined_name);
      }
    }
  }
  else {
    Errorline("module \"%s\" not found\n",string_val(t));
    *onefailed=TRUE;
  }
}

void open_module_tree	(	ptr_node	n,
		int *	onefailed
	)

open_module_tree

Parameters

n	- ptr_node n
onefailed	- int *onefailed

Definition at line 542 of file modules.c.

References wl_node::data, wl_node::left, open_module_one(), and wl_node::right.

{
  if (n) {
    ptr_psi_term t;
    open_module_tree(n->left,onefailed);

    t=(ptr_psi_term)n->data;
    open_module_one(t,onefailed);

    open_module_tree(n->right,onefailed);
  }
}

void pretty_quote_symbol

(

ptr_keyword

k

)

pretty_quote_symbol

Parameters

k	- ptr_keyword k

PRETTY_QUOTE_SYMBOL(k) Prints the string to be used to display keyword K, with quotes if required.

Definition at line 470 of file modules.c.

References wl_keyword::definition, display_modules, wl_definition::keyword, wl_keyword::module, wl_module::module_name, prettyf(), prettyf_quote(), and wl_keyword::symbol.

{
  k=k->definition->keyword;
  if(display_modules) {
    prettyf(k->module->module_name);
    prettyf("#");
  }
  prettyf_quote(k->symbol);
}

void pretty_symbol

(

ptr_keyword

k

)

pretty_symbol

Parameters

k	- ptr_keyword k

PRETTY_SYMBOL(k) Prints the string to be used to display keyword K.

Definition at line 452 of file modules.c.

References wl_keyword::definition, display_modules, wl_definition::keyword, wl_keyword::module, wl_module::module_name, prettyf(), and wl_keyword::symbol.

{
  k=k->definition->keyword;
  if(display_modules) {
    prettyf(k->module->module_name);
    prettyf("#");
  }
  prettyf(k->symbol);
}

char* print_symbol

(

ptr_keyword

k

)

print_symbol

OBSOLETE ptr_psi_term get_function_value(module,symbol)

ptr_module module; char *symbol;

{ ptr_node n; ptr_definition def; ptr_psi_term result=NULL; ptr_pair_list rule;

n=find(STRCMP,make_module_token(module,symbol),symbol_table); if(n) def=(ptr_definition)n->data; if(def && def->type==function) { rule=def->rule; while (rule && (!rule->aaaa_1 || !rule->bbbb_1)) rule=rule->next; if(rule) { result=(ptr_psi_term)rule->bbbb_1; deref_ptr(result); } } }

if(!result) Errorline("error in definition of '%s'\n",module_buffer);

return result; }

Parameters

k	- ptr_keyword k

PRINT_SYMBOL(k) Returns the string to be used to display keyword K.

Definition at line 435 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, display_modules, wl_definition::keyword, and wl_keyword::symbol.

{
  k=k->definition->keyword;
  if(display_modules)
    return k->combined_name;
  else
    return k->symbol;
}

void rec_replace	(	ptr_definition	old,
		ptr_definition	new,
		ptr_psi_term	term
	)

rec_replace

Parameters

old	- ptr_definition old
new	- ptr_definition new
term	- ptr_psi_term term

Definition at line 865 of file modules.c.

References wl_psi_term::attr_list, def_ptr, deref_ptr, insert_translation(), int_ptr, NULL, push_ptr_value(), replace_attr(), translate(), wl_psi_term::type, and wl_psi_term::value_3.

{
  ptr_psi_term done;
  long *info;  // some trouble w this - don't see
  ptr_node old_attr;
  
  deref_ptr(term);
  done=translate(term,&info);
  if(!done) {
    insert_translation(term,term,0);
    
    if(term->type==old && !term->value_3) {
      push_ptr_value(def_ptr,(GENERIC *)&(term->type));
      term->type=new;
    }
    old_attr=term->attr_list;
    if(old_attr) {
      push_ptr_value(int_ptr,(GENERIC *)&(term->attr_list));
      term->attr_list=NULL;
      replace_attr(old_attr,term,old,new);
    }
  }
}

void replace	(	ptr_definition	old,
		ptr_definition	new,
		ptr_psi_term	term
	)

replace

Parameters

old	- ptr_definition old
new	- ptr_definition new
term	- ptr_psi_term term)

REPLACE(old,new,term) Replace all occurrences of type OLD with NEW in TERM.

Definition at line 851 of file modules.c.

References clear_copy(), and rec_replace().

{
  clear_copy();
  rec_replace(old,new,term);
}

void replace_attr	(	ptr_node	old_attr,
		ptr_psi_term	term,
		ptr_definition	old,
		ptr_definition	new
	)

replace_attr

Parameters

old_attr	- ptr_node old_attr
term	- ptr_psi_term term
old	- ptr_definition old
new	- ptr_definition new

Definition at line 898 of file modules.c.

References wl_psi_term::attr_list, wl_keyword::combined_name, wl_node::data, FEATCMP, wl_node::key, wl_definition::keyword, wl_node::left, wl_keyword::private_feature, rec_replace(), wl_node::right, stack_insert(), and wl_keyword::symbol.

{
  ptr_psi_term value;
  char *oldlabel; /*  RM: Mar 12 1993  */
  char *newlabel;
  
  if(old_attr->left)
    replace_attr(old_attr->left,term,old,new);
  
  value=(ptr_psi_term)old_attr->data;
  rec_replace(old,new,value);
  
  if(old->keyword->private_feature)  /*  RM: Mar 12 1993  */
    oldlabel=old->keyword->combined_name;
  else
    oldlabel=old->keyword->symbol;
  
  if(new->keyword->private_feature)  /*  RM: Mar 12 1993  */
    newlabel=new->keyword->combined_name;
  else
    newlabel=new->keyword->symbol;
  
  if(!strcmp(old_attr->key,oldlabel))
    (void)stack_insert(FEATCMP,newlabel,&(term->attr_list),(GENERIC)value);
  else
    (void)stack_insert(FEATCMP,old_attr->key,&(term->attr_list),(GENERIC)value);
  
  if(old_attr->right)
    replace_attr(old_attr->right,term,old,new);
}

ptr_module set_current_module

(

ptr_module

module

)

set_current_module

Parameters

module

- ptr_module module

SET_CURRENT_MODULE(module) Set the current module to a given string.

Definition at line 100 of file modules.c.

References current_module.

{
  current_module=module;
  /* printf("*** Current module: '%s'\n",current_module->module_name); */
  return current_module;
}

char* string_val

(

ptr_psi_term

term

)

string_val

Parameters

term	- ptr_psi_term term

STRING_VAL(term) Return a string defined by a term, that is: if term is a string, return the value, otherwise return the symbol for that term.

Definition at line 169 of file modules.c.

References deref_ptr, wl_definition::keyword, quoted_string, wl_keyword::symbol, wl_psi_term::type, and wl_psi_term::value_3.

{
  deref_ptr(term);
  if(term->value_3 && term->type==quoted_string)
    return (char *)term->value_3;
  else
    return term->type->keyword->symbol;
}

char* strip_module_name

(

char *

str

)

strip_module_name

Parameters

str	- char *str

STRIP_MODULE_NAME(symbol) Return the sub-string of symbol without the module prefix.

Definition at line 144 of file modules.c.

References legal_in_name().

{
  char *s=str;

  while(legal_in_name(*s))
    s++;
  if(s!=str && *s=='#' /* && *(s+1)!=0 */) {
    s++;
    /* printf("Stripped module from '%s' yielding '%s'\n",str,s); */
    return s;
  }
  else
    return str;
}

void traverse_tree	(	ptr_node	n,
		int	flag
	)

traverse_tree

Parameters

n	- ptr_node n
flag	- int flag

Do for all arguments, for the built-ins c_public, c_private, and c_private_feature.

Definition at line 656 of file modules.c.

References wl_node::data, deref_ptr, FALSE, wl_node::left, MAKE_FEATURE_PRIVATE, make_feature_private(), MAKE_PRIVATE, make_public(), MAKE_PUBLIC, wl_node::right, and TRUE.

{
  if (n) {
    ptr_psi_term t;
    traverse_tree(n->left,flag);

    t=(ptr_psi_term)n->data;
    deref_ptr(t);
    switch (flag) {
    case MAKE_PUBLIC:
      (void)make_public(t,TRUE);
      break;
    case MAKE_PRIVATE:
      (void)make_public(t,FALSE);
      break;
    case MAKE_FEATURE_PRIVATE:
      (void)make_feature_private(t);
      break;
    }
    traverse_tree(n->right,flag);
  }
}

ptr_definition update_feature	(	ptr_module	module,
		char *	feature
	)

update_feature

Parameters

module	- ptr_module module
feature	- char *feature

UPDATE_FEATURE(module,feature) Look up a FEATURE. May return NULL if the FEATURE is not visible from MODULE.

Definition at line 1331 of file modules.c.

References current_module, wl_keyword::definition, extract_module_from_name(), hash_lookup(), NULL, wl_keyword::private_feature, wl_module::symbol_table, and update_symbol().

{
  ptr_keyword key;
  ptr_module explicit;

  /* Check if the feature already contains a module name */

  if(!module)
    module=current_module;
  
  explicit=extract_module_from_name(feature);
  if(explicit)
    if(explicit!=module)
      return NULL; /* Feature isn't visible */
    else
      return update_symbol(NULL,feature);

  /* Now we have a simple feature to look up */
  key=hash_lookup(module->symbol_table,feature);
  if(key && key->private_feature)
    return key->definition;
  else
    return update_symbol(module,feature);
}

ptr_definition update_symbol	(	ptr_module	module,
		char *	symbol
	)

update_symbol

Parameters

module	- ptr_module module
symbol	- char *symbol

UPDATE_SYMBOL(m,s) S is a string of characters encountered during parsing, M is the module it belongs too.

if M is NULL then extract the module name from S. If that fails then use the current module.

Then, retrieve the keyword for 'module::symbol'. Then find the correct definition by scanning the opened modules.

Definition at line 270 of file modules.c.

References wl_keyword::combined_name, current_module, wl_keyword::definition, error_psi_term, Errorline(), extract_module_from_name(), FALSE, hash_insert(), hash_lookup(), HEAP_ALLOC, heap_copy_string(), make_module_token(), wl_keyword::module, wl_module::module_name, new_definition(), wl_int_list::next, NULL, wl_module::open_modules, wl_keyword::private_feature, wl_keyword::public, strip_module_name(), wl_keyword::symbol, wl_module::symbol_table, wl_psi_term::type, wl_int_list::value_1, and warningline().

{
  ptr_keyword key;
  ptr_definition result=NULL;
  ptr_int_list opens;
  ptr_module opened;
  ptr_keyword openkey;
  ptr_keyword tempkey;
  
  /* First clean up the arguments and find out which module to use */

  if(!module) {
    module=extract_module_from_name(symbol);
    if(!module)
      module=current_module;
    symbol=strip_module_name(symbol);
  }
  
  /* printf("looking up %s#%s\n",module->module_name,symbol); */
  
  /* Now look up 'module#symbol' in the symbol table */
  key=hash_lookup(module->symbol_table,symbol);
  
  if(key)
    if(key->public || module==current_module)
      result=key->definition;
    else {
      Errorline("qualified call to private symbol '%s'\n",
        key->combined_name);
      
      result=error_psi_term->type;
    }
  else
    if(module!=current_module) {
      Errorline("qualified call to undefined symbol '%s#%s'\n",
        module->module_name,symbol);
      result=error_psi_term->type;
    }
    else
      {
    /* Add 'module#symbol' to the symbol table */
    key=HEAP_ALLOC(struct wl_keyword);
    key->module=module;
    key->symbol=(char *)heap_copy_string(symbol);
    key->combined_name=heap_copy_string(make_module_token(module,symbol));
    key->public=FALSE;
    key->private_feature=FALSE; /*  RM: Mar 11 1993  */
    key->definition=NULL;
    
    hash_insert(module->symbol_table,key->symbol,key);
    
    
    /* Search the open modules of 'module' for 'symbol' */
    opens=module->open_modules;
    openkey=NULL;
    while(opens) {
      opened=(ptr_module)(opens->value_1);
      if(opened!=module) {
        
        tempkey=hash_lookup(opened->symbol_table,symbol);
        
        if(tempkey)
          if(openkey && openkey->public && tempkey->public) {
        if(openkey->definition==tempkey->definition) {
          warningline("benign module name clash: %s and %s\n",
                  openkey->combined_name,
                  tempkey->combined_name);
        }
        else {
          Errorline("serious module name clash: \"%s\" and \"%s\"\n",
                openkey->combined_name,
                tempkey->combined_name);
          
          result=error_psi_term->type;
        }
          }
          else
        if(!openkey || !openkey->public)
          openkey=tempkey;
      }
      
      opens=opens->next;
    }
    
    if(!result) { /*  RM: Feb  1 1993  */
      
      if(openkey && openkey->public) {
        /* Found the symbol in an open module */
        
        if(!openkey->public)
          warningline("implicit reference to non-public symbol: %s\n",
              openkey->combined_name);
        
        result=openkey->definition;
        key->definition=result;
        
        /*
          printf("*** Aliasing %s#%s to %s#%s\n",
          key->module->module_name,
          key->symbol,
          openkey->module->module_name,
          openkey->symbol);
          */
        
      }
      else { /* Didn't find it */
        result=new_definition(key);
      }
    }
      }
  
  return result;
}

Variable Documentation

ptr_module bi_module =NULL

Definition at line 17 of file modules.c.

ptr_module current_module =NULL

Definition at line 15 of file modules.c.

long display_modules =TRUE

Definition at line 25 of file modules.c.

ptr_node module_table =NULL

Definition at line 14 of file modules.c.

ptr_module no_module =NULL

Definition at line 16 of file modules.c.

ptr_module syntax_module =NULL

Definition at line 18 of file modules.c.

ptr_module sys_module =NULL

Definition at line 19 of file modules.c.

ptr_module user_module =NULL

Definition at line 22 of file modules.c.

ptr_module x_module = NULL

Definition at line 23 of file modules.c.