home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / src / pl-modul.c < prev    next >
C/C++ Source or Header  |  1992-07-07  |  11KB  |  421 lines
  1. /*  pl-modul.c,v 1.3 1992/07/07 08:25:40 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: module management
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  13. Definition of modules.  A module consists of a  set  of  predicates.   A
  14. predicate  can be private or public.  By default predicates are private.
  15. A module contains two hash tables.  One that holds  all  predicates  and
  16. one that holds the public predicates of the module.
  17.  
  18. On trapping undefined  predicates  SWI-Prolog  attempts  to  import  the
  19. predicate  from  the  super  module  of the module.  The module `system'
  20. holds all system predicates and has no super module.  Module  `user'  is
  21. the  global  module  for  the  user  and imports from `system' all other
  22. modules import from `user' (and indirect from `system').
  23. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  24.  
  25. Module
  26. lookupModule(name)
  27. Atom name;
  28. { Symbol s;
  29.   Module m;
  30.  
  31.   if ((s = lookupHTable(moduleTable, name)) != (Symbol) NULL)
  32.     return (Module) s->value;
  33.  
  34.   m = (Module) allocHeap(sizeof(struct module));
  35.   m->name = name;
  36.   m->file = (SourceFile) NULL;
  37.   clearFlags(m);
  38.   set(m, UNKNOWN);
  39.  
  40.   if ( name == ATOM_user || name == ATOM_system )
  41.     m->procedures = newHTable(PROCEDUREHASHSIZE);
  42.   else
  43.     m->procedures = newHTable(MODULEPROCEDUREHASHSIZE);
  44.  
  45.   m->public = newHTable(PUBLICHASHSIZE);
  46.  
  47.   if ( name == ATOM_user || stringAtom(name)[0] == '$' )
  48.     m->super = MODULE_system;
  49.   else if ( name == ATOM_system )
  50.     m->super = NULL;
  51.   else
  52.     m->super = MODULE_user;
  53.  
  54.   if ( name == ATOM_system || stringAtom(name)[0] == '$' )
  55.     set(m, SYSTEM);
  56.  
  57.   addHTable(moduleTable, name, m);
  58.   statistics.modules++;
  59.   
  60.   return m;
  61. }
  62.  
  63. Module
  64. isCurrentModule(name)
  65. Atom name;
  66. { Symbol s;
  67.  
  68.   if ((s = lookupHTable(moduleTable, name)) != (Symbol) NULL)
  69.     return (Module) s->value;
  70.  
  71.   return (Module) NULL;
  72. }
  73.  
  74. void
  75. initModules()
  76. { moduleTable    = newHTable(MODULEHASHSIZE);
  77.   modules.system = lookupModule(ATOM_system);
  78.   modules.user   = lookupModule(ATOM_user);
  79.   modules.typein = modules.user;
  80.   modules.source = modules.user;
  81. }
  82.  
  83. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  84. stripModule() takes an atom or term, possible embedded in the :/2 module
  85. term.  It will assing *module with the associated module and return  the
  86. remaining term.
  87. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  88.  
  89. Word
  90. stripModule(term, module)
  91. register Word term;
  92. Module *module;
  93. { while(isTerm(*term) && functorTerm(*term) == FUNCTOR_module2)
  94.   { register Word mp;
  95.     mp = argTermP(*term, 0);
  96.     deRef(mp);
  97.     if (!isAtom(*mp) )
  98.     { warning("Illegal module specification");
  99.  
  100.       return (Word) NULL;
  101.     }
  102.     *module = lookupModule((Atom) *mp);
  103.     term = argTermP(*term, 1);
  104.     deRef(term);
  105.   }
  106.  
  107.   if (*module == (Module) NULL)
  108.     *module = contextModule(environment_frame);
  109.  
  110.   return term;
  111. }
  112.  
  113. bool
  114. isPublicModule(module, proc)
  115. Module module;
  116. Procedure proc;
  117. { return lookupHTable(module->public, proc->functor) == (Symbol) NULL ? FALSE
  118.                                       : TRUE;
  119. }
  120.  
  121. bool
  122. isSuperModule(m, s)
  123. Module m, s;
  124. { for( ; m; m = m->super )
  125.     if ( m == s )
  126.       succeed;
  127.  
  128.   fail;
  129. }
  130.  
  131.         /********************************
  132.         *       PROLOG CONNECTION       *
  133.         *********************************/
  134.  
  135. word
  136. pl_default_module(me, old, new)
  137. Word me, old, new;
  138. { Module m, s;
  139.  
  140.   if ( isVar(*me) )
  141.   { m = contextModule(environment_frame);
  142.     TRY( unifyAtomic(me, m->name) );
  143.   } else if ( isAtom(*me) )
  144.   { m = lookupModule((Atom) *me);
  145.   } else
  146.     return warning("super_module/2: instantiation fault");
  147.  
  148.   TRY( unifyAtomic(old, m->super ? m->super->name : ATOM_nil) );
  149.  
  150.   if ( !isAtom(*new) )
  151.     return warning("super_module/2: instantiation fault");
  152.  
  153.   s = (*new == (word) ATOM_nil ? (Module) NULL : lookupModule((Atom) *new));
  154.   m->super = s;
  155.  
  156.   succeed;
  157. }
  158.  
  159.  
  160. word
  161. pl_current_module(module, file, h)
  162. Word module, file;
  163. word h;
  164. { Module m;
  165.   Atom f;
  166.   Symbol symb;
  167.  
  168.   switch( ForeignControl(h) )
  169.   { case FRG_FIRST_CALL:
  170.       symb = firstHTable(moduleTable);
  171.       break;
  172.     case FRG_REDO:
  173.       symb = (Symbol) ForeignContextAddress(h);
  174.       break;
  175.     case FRG_CUTTED:
  176.     default:
  177.       succeed;
  178.   }
  179.  
  180.   for(; symb; symb = nextHTable(moduleTable, symb) )
  181.   { m = (Module) symb->value;
  182.     if ( stringAtom(m->name)[0] == '$' && !SYSTEM_MODE && isVar(*module) )
  183.       continue;
  184.     if (unifyAtomic(module, m->name) == FALSE)
  185.       continue;
  186.     f = (m->file == (SourceFile) NULL ? ATOM_nil : m->file->name);
  187.     if (unifyAtomic(file, f) == FALSE)
  188.       continue;
  189.  
  190.     if ((symb = nextHTable(moduleTable, symb)) == (Symbol) NULL)
  191.       succeed;
  192.  
  193.     ForeignRedo(symb);
  194.   }
  195.  
  196.   fail;
  197. }
  198.  
  199. word
  200. pl_strip_module(spec, module, term)
  201. Word spec, module, term;
  202. { Module m = (Module) NULL;
  203.  
  204.   if ( (spec = stripModule(spec, &m)) == (Word) NULL )
  205.     fail;
  206.   TRY(unifyAtomic(module, m->name) );
  207.  
  208.   return pl_unify(spec, term);
  209. }  
  210.  
  211. word
  212. pl_module(old, new)
  213. Word old, new;
  214. { TRY(unifyAtomic(old, modules.typein->name) );
  215.   if (!isAtom(*new) )
  216.     return warning("module/1: argument should be an atom");
  217.   modules.typein = lookupModule((Atom)*new);
  218.   
  219.   succeed;
  220. }
  221.  
  222. word
  223. pl_set_source_module(old, new)
  224. Word old, new;
  225. { TRY(unifyAtomic(old, modules.source->name) );
  226.   if (!isAtom(*new) )
  227.     return warning("$source_module/1: argument should be an atom");
  228.   modules.source = lookupModule((Atom)*new);
  229.   
  230.   succeed;
  231. }
  232.  
  233. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  234. Declare `name' to be a module with `file' as its source  file.   If  the
  235. module was already loaded its public table is cleared and all procedures
  236. in it are abolished.
  237. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  238.  
  239.  
  240. word
  241. pl_declare_module(name, file)
  242. Word name, file;
  243. { Module module;
  244.   Symbol s;
  245.   SourceFile sf;
  246.  
  247.   if (!isAtom(*name) || !isAtom(*file) )
  248.     return warning("$declare_module/2: instantiation fault");
  249.  
  250.   module = lookupModule((Atom)*name);
  251.  
  252.   sf = lookupSourceFile((Atom)*file);
  253.   if (module->file != (SourceFile) NULL && module->file != sf)
  254.     return warning("module/2: module %s already loaded from file %s (abandoned)", 
  255.                 stringAtom(module->name), 
  256.                 stringAtom(module->file->name) );
  257.   module->file = sf;
  258.  
  259.   modules.source = module;
  260.  
  261.   for_table(s, module->procedures)
  262.   { Procedure proc = (Procedure) s->value;
  263.     Definition def = proc->definition;
  264.     if ( def->module == module &&
  265.      false(def, DYNAMIC) &&
  266.      false(def, MULTIFILE) )
  267.       abolishProcedure(proc, module);
  268.   }
  269.   clearHTable(module->public);
  270.   
  271.   succeed;
  272. }
  273.  
  274. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  275. export_list(+Module, -PublicPreds)
  276. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  277.  
  278. word
  279. pl_export_list(modulename, list)
  280. Word modulename, list;
  281. { Module module;
  282.   Symbol s;
  283.  
  284.   if ( !isAtom(*modulename) )
  285.     return warning("export_list/2: instantiation fault");
  286.   
  287.   if ((module = isCurrentModule((Atom) *modulename)) == NULL)
  288.     fail;
  289.   
  290.   for_table(s, module->public)
  291.   { TRY(unifyFunctor(list, FUNCTOR_dot2));
  292.     TRY(unifyFunctor(HeadList(list), (FunctorDef)s->name));
  293.     list = TailList(list);
  294.     deRef(list);
  295.   }
  296.   
  297.   return unifyAtomic(list, ATOM_nil);
  298. }
  299.  
  300.  
  301. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  302. pl_export() exports a procedure specified by its name and arity from the
  303. context module.
  304. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  305.  
  306. word
  307. pl_export(head)
  308. Word head;
  309. { Procedure proc;
  310.   Module module = (Module) NULL;
  311.  
  312.   if ((head = stripModule(head, &module)) == (Word) NULL)
  313.     fail;
  314.  
  315.   if ( isAtom(*head) )
  316.     proc = lookupProcedure(lookupFunctorDef((Atom)*head, 0), module);
  317.   else if ( isTerm(*head) )
  318.     proc = lookupProcedure(functorTerm(*head), module);
  319.   else
  320.     return warning("export/1: illegal predicate specification");
  321.  
  322.   addHTable(module->public, proc->functor, proc);
  323.  
  324.   succeed;
  325. }
  326.  
  327. word
  328. pl_check_export()
  329. { Module module = contextModule(environment_frame);
  330.   Symbol s;
  331.  
  332.   for_table(s, module->public)
  333.   { Procedure proc = (Procedure) s->value;
  334.     if (isDefinedProcedure(proc) == FALSE)
  335.     { warning("Exported procedure %s:%s/%d is not defined", 
  336.                   stringAtom(module->name), 
  337.                   stringAtom(proc->functor->name), 
  338.                   proc->functor->arity);
  339.     }
  340.   }
  341.  
  342.   succeed;
  343. }
  344.  
  345. word
  346. pl_context_module(module)
  347. Word module;
  348. { return unifyAtomic(module, contextModule(environment_frame)->name);
  349. }
  350.  
  351. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  352. pl_import() imports the predicate specified with its argument  into  the
  353. current  context  module.   If  the  predicate is already defined in the
  354. context a warning is displayed and the predicate is  NOT  imported.   If
  355. the  predicate  is  not  on  the  public  list of the exporting module a
  356. warning is displayed, but the predicate is imported nevertheless.
  357. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  358.  
  359. word
  360. pl_import(pred)
  361. Word pred;
  362. { Module source = (Module) NULL;
  363.   Module destination = contextModule(environment_frame);
  364.   Procedure proc, old;
  365.  
  366.   if ((pred = stripModule(pred, &source)) == (Word) NULL)
  367.     fail;
  368.  
  369.   if (isAtom(*pred) )
  370.     proc = lookupProcedure(lookupFunctorDef((Atom)*pred, 0), source);
  371.   else if (isTerm(*pred) )
  372.     proc = lookupProcedure(functorTerm(*pred), source);
  373.   else
  374.     return warning("import/1: illegal predicate specification");
  375.  
  376.   if ((old = isCurrentProcedure(proc->functor, destination)) != (Procedure) NULL)
  377.   { if ( old->definition == proc->definition )
  378.       succeed;            /* already done this! */
  379.  
  380.     if ( !isDefinedProcedure(old) )
  381.     { old->definition = proc->definition;
  382.  
  383.       succeed;
  384.     }
  385.  
  386.     if ( old->definition->module == destination )
  387.       return warning("Cannot import %s into module %s: name clash", 
  388.              procedureName(proc), 
  389.              stringAtom(destination->name) );
  390.  
  391.     if (old->definition->module != source)
  392.     { warning("Cannot import %s into module %s: already imported from %s", 
  393.           procedureName(proc), 
  394.           stringAtom(destination->name), 
  395.           stringAtom(old->definition->module->name) );
  396.       fail;
  397.     }
  398.  
  399.     sysError("Unknown problem importing %s into module %s",
  400.          procedureName(proc),
  401.          stringAtom(destination->name));
  402.     fail;
  403.   }
  404.  
  405.   if (isPublicModule(source, proc) == FALSE)
  406.   { warning("import/1: %s is not declared public (still imported)", 
  407.         procedureName(proc));
  408.   }
  409.   
  410.   { Procedure nproc = (Procedure)  allocHeap(sizeof(struct procedure));
  411.   
  412.     nproc->type = PROCEDURE_TYPE;
  413.     nproc->functor = proc->functor;
  414.     nproc->definition = proc->definition;
  415.   
  416.     addHTable(destination->procedures, proc->functor, nproc);
  417.   }
  418.  
  419.   succeed;
  420. }
  421.