home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / SOURCE / BI_TYPE.C < prev    next >
C/C++ Source or Header  |  1996-06-14  |  17KB  |  725 lines
  1. /*                                    tab:4
  2.  *
  3.  * bi_type.c - builtins for doing type heierachy stuff
  4.  *
  5.  * Copyright (c) 1992 Digital Equipment Corporation
  6.  * All Rights Reserved.
  7.  *
  8.  * The standard digital prl copyrights exist and where compatible
  9.  * the below also exists.
  10.  * Permission to use, copy, modify, and distribute this
  11.  * software and its documentation for any purpose and without
  12.  * fee is hereby granted, provided that the above copyright
  13.  * notice appear in all copies.  Copyright holder(s) make no
  14.  * representation about the suitability of this software for
  15.  * any purpose. It is provided "as is" without express or
  16.  * implied warranty.
  17.  *
  18.  */
  19. /*     $Id: bi_type.c,v 1.2 1994/12/08 23:08:52 duchier Exp $     */
  20.  
  21. #ifndef lint
  22. static char vcid[] = "$Id: bi_type.c,v 1.2 1994/12/08 23:08:52 duchier Exp $";
  23. #endif /* lint */
  24.  
  25. #include "extern.h"
  26. #include "trees.h"
  27. #include "login.h"
  28. #include "parser.h"
  29. #include "copy.h"
  30. #include "token.h"
  31. #include "print.h"
  32. #include "lefun.h"
  33. #include "memory.h"
  34. #include "modules.h"
  35. #ifndef OS2_PORT
  36. #include "built_ins.h"
  37. #else
  38. #include "built_in.h"
  39. #endif
  40.  
  41. #include "error.h"
  42.  
  43. #ifdef X11
  44. #include "xpred.h"
  45. #endif
  46.  
  47. /******** C_CHILDREN
  48.   Return a list of roots of the children types of T (except bottom).
  49. */
  50. static long c_children()   /*  RM: Dec 14 1992  Re-wrote most of the routine */
  51. {
  52.   long success=TRUE;
  53.   ptr_psi_term funct,result,arg1,arg2,t,p1;
  54.   ptr_int_list p;
  55.   
  56.   funct=aim->a;
  57.   deref_ptr(funct);
  58.   result=aim->b;
  59.   get_two_args(funct->attr_list,&arg1,&arg2);
  60.   
  61.   if (!arg1) {
  62.     curry();
  63.     return success;
  64.   }
  65.  
  66.   deref(arg1);
  67.   deref_args(funct,set_1);
  68.   resid_aim=NULL;
  69.   
  70.   if (arg1->type==top)
  71.     t=collect_symbols(greatest_sel); /*  RM: Feb  3 1993  */
  72.   else {
  73.     p=arg1->type->children;
  74.  
  75.     /* Hack: check there's enough memory to build the list */
  76.     /*  RM: Jul 22 1993  */
  77.     /*
  78.       { int count=0;
  79.       while(p) {
  80.       count++;
  81.       p=p->next;
  82.       }
  83.       if (heap_pointer-stack_pointer < 3*count*sizeof(psi_term)) {
  84.       goal_stack=aim;
  85.       garbage();
  86.       return success;
  87.       }
  88.       */
  89.     
  90.     t=stack_nil();
  91.     if (!(arg1->type==real && arg1->value)) /* PVR 15.2.94 */
  92.       while (p) {
  93.         ptr_definition ptype;
  94.  
  95.         ptype = (ptr_definition) p->value;
  96.         if (hidden_type(ptype)) { p=p->next; continue; }
  97.         p1 = stack_psi_term(0);
  98.         p1->type = ptype;
  99.         t=stack_cons(p1,t);
  100.         p = p->next;
  101.       }
  102.   }
  103.   push_goal(unify,result,t,NULL);
  104.  
  105.   return success;
  106. }
  107.  
  108.  
  109.  
  110. /******** C_PARENTS
  111.   Return a list of roots of the parent types of T.
  112. */
  113. static long c_parents()
  114. {
  115.   long success=TRUE;
  116.   ptr_psi_term funct,result,arg1,arg2,t,p1;
  117.   ptr_int_list p;
  118.  
  119.   funct=aim->a;
  120.   deref_ptr(funct);
  121.   result=aim->b;
  122.   get_two_args(funct->attr_list,&arg1,&arg2);
  123.   if (arg1) {
  124.     deref(arg1);
  125.     deref_args(funct,set_1);
  126.     resid_aim=NULL;
  127.     t=stack_nil();  /*  RM: Dec 14 1992  */
  128.     p = arg1->type->parents;
  129.     if (arg1->type!=top && p==NULL) {
  130.       /* Top is the only parent */
  131.       p1 = stack_psi_term(4);
  132.       p1->type = (ptr_definition) top;
  133.       t=stack_cons(p1,t); /*  RM: Dec 14 1992  */
  134.     }
  135.     else {
  136.       if ((arg1->type==quoted_string || arg1->type==integer ||
  137.           arg1->type==real) && arg1->value!=NULL) {
  138.         /* arg1 is a string, long or real: return a list with arg1 as
  139.            argument, where arg1->value = NULL, MH */
  140.         p1 = stack_psi_term(4);
  141.         p1->type = arg1->type;
  142.         t=stack_cons(p1,t); /*  RM: Dec 14 1992  */
  143.       }
  144.       else {
  145.         /* Look at the parents list */
  146.         while (p) {
  147.           ptr_definition ptype;
  148.  
  149.           ptype = (ptr_definition) p->value;
  150.           if (hidden_type(ptype)) { p=p->next; continue; }
  151.           p1 = stack_psi_term(4);
  152.           p1->type = ptype;
  153.       t=stack_cons(p1,t); /*  RM: Dec 14 1992  */
  154.           p = p->next;
  155.         }
  156.       }
  157.     }
  158.     push_goal(unify,result,t,NULL);
  159.   }
  160.   else
  161.     curry();
  162.  
  163.   return success;
  164. }
  165.  
  166.  
  167.  
  168.  
  169. /******** C_SMALLEST
  170.   Return the parents of bottom.
  171.   This function has no arguments.
  172. */
  173. static long c_smallest()
  174. {
  175.   long success=TRUE;
  176.   ptr_psi_term result, g, t;
  177.  
  178.   g=aim->a;
  179.   deref_args(g,set_empty);
  180.   result=aim->b;
  181.   t=collect_symbols(least_sel); /*  RM: Feb  3 1993  */
  182.   push_goal(unify,result,t,NULL);
  183.   
  184.   return success;
  185. }
  186.  
  187. isSubTypeValue(arg1, arg2)
  188. ptr_psi_term arg1, arg2;
  189. {
  190.   long ans=TRUE;
  191.   
  192.   /* we already know that either arg1->type == arg2->type or that at both
  193.    * of the two are either long or real
  194.    */
  195.   
  196.   if (arg2->value) {
  197.     if (arg1->value) {
  198.       if (arg1->type==real || arg1->type==integer) {
  199.         ans=( *(REAL *)arg1->value == *(REAL *)arg2->value);
  200.       }
  201.       else if (arg1->type==quoted_string) {
  202.         ans=strcmp((char *)arg1->value,(char *)arg2->value)==0;
  203.       }
  204.     }
  205.     else
  206.       ans=FALSE;
  207.   }
  208.   else {
  209.     if (arg1->value && (arg1->type==real || arg1->type==integer)) {
  210.       if (arg2->type==integer)
  211.         ans=(*(REAL *)arg1->value == floor(*(REAL *)arg1->value));
  212.       else
  213.         ans=TRUE;
  214.     }
  215.   }
  216.   return ans;
  217. }
  218.  
  219. /* Boolean utility function that implements isa */
  220. static long isa(arg1,arg2)
  221. ptr_psi_term arg1, arg2;
  222. {
  223.   long ans;
  224.  
  225.   if (  arg1->type==arg2->type
  226.      || (  (arg1->type==real || arg1->type==integer)
  227.         && (arg2->type==real || arg2->type==integer)
  228.         && (arg1->value || arg2->value)
  229.         )
  230.      ) {
  231.  
  232.     if(arg1->type==cut) /*  RM: Jan 21 1993  */
  233.       ans=TRUE;
  234.     else
  235.       ans=isSubTypeValue(arg1, arg2);
  236.   }
  237.   else {
  238.     matches(arg1->type, arg2->type, &ans);
  239.   }
  240.  
  241.   /*Errorline("isa %P %P -> %d\n",arg1,arg2,ans);*/
  242.  
  243.   return ans;
  244. }
  245.   
  246.  
  247. #define isa_le_sel 0
  248. #define isa_lt_sel 1
  249. #define isa_ge_sel 2
  250. #define isa_gt_sel 3
  251. #define isa_eq_sel 4
  252. #define isa_nle_sel 5
  253. #define isa_nlt_sel 6
  254. #define isa_nge_sel 7
  255. #define isa_ngt_sel 8
  256. #define isa_neq_sel 9
  257. #define isa_cmp_sel 10
  258. #define isa_ncmp_sel 11
  259.  
  260. /* Utility that selects one of several isa functions */
  261. static long isa_select(arg1,arg2,sel)
  262. ptr_psi_term arg1,arg2;
  263. long sel;
  264. {
  265.   long ans;
  266.  
  267.   switch (sel) {
  268.   case isa_le_sel: ans=isa(arg1,arg2);
  269.     break;
  270.   case isa_lt_sel: ans=isa(arg1,arg2) && !isa(arg2,arg1);
  271.     break;
  272.   case isa_ge_sel: ans=isa(arg2,arg1);
  273.     break;
  274.   case isa_gt_sel: ans=isa(arg2,arg1) && !isa(arg1,arg2);
  275.     break;
  276.   case isa_eq_sel: ans=isa(arg1,arg2) && isa(arg2,arg1);
  277.     break;
  278.  
  279.   case isa_nle_sel: ans= !isa(arg1,arg2);
  280.     break;
  281.   case isa_nlt_sel: ans= !(isa(arg1,arg2) && !isa(arg2,arg1));
  282.     break;
  283.   case isa_nge_sel: ans= !isa(arg2,arg1);
  284.     break;
  285.   case isa_ngt_sel: ans= !(isa(arg2,arg1) && !isa(arg1,arg2));
  286.     break;
  287.   case isa_neq_sel: ans= !(isa(arg1,arg2) && isa(arg2,arg1));
  288.     break;
  289.  
  290.   case isa_cmp_sel: ans=isa(arg1,arg2) || isa(arg2,arg1);
  291.     break;
  292.   case isa_ncmp_sel: ans= !(isa(arg1,arg2) || isa(arg2,arg1));
  293.     break;
  294.   }
  295.   return ans;
  296. }
  297.  
  298. /******** C_ISA_MAIN
  299.   Main routine to handle all the isa built-in functions.
  300. */
  301. static long c_isa_main(sel)
  302. long sel;
  303. {
  304.   long success=TRUE,ans;
  305.   ptr_psi_term arg1,arg2,funct,result;
  306.  
  307.   funct=aim->a;
  308.   deref_ptr(funct);
  309.   result=aim->b;
  310.   get_two_args(funct->attr_list,&arg1,&arg2);
  311.   if (arg1 && arg2) {
  312.     deref(arg1);
  313.     deref(arg2);
  314.     deref_args(funct,set_1_2);
  315.     ans=isa_select(arg1,arg2,sel);
  316.     unify_bool_result(result,ans);
  317.   }
  318.   else curry();
  319.  
  320.   return success;
  321. }
  322.  
  323. /******** C_ISA_LE
  324.   Type t1 isa t2 in the hierarchy, i.e. t1 is less than or equal to t2.
  325.   This boolean function requires two arguments and never residuates.
  326.   It will curry if insufficient arguments are given.
  327.   It works correctly on the 'value' types, i.e. on integers, reals, strings,
  328.   and lists.  For lists, it looks only at the top level, i.e. whether the
  329.   object is nil or a cons cell.
  330. */
  331. static long c_isa_le()
  332. {
  333.   return c_isa_main(isa_le_sel);
  334. }
  335.  
  336. static long c_isa_lt()
  337. {
  338.   return c_isa_main(isa_lt_sel);
  339. }
  340.  
  341. static long c_isa_ge()
  342. {
  343.   return c_isa_main(isa_ge_sel);
  344. }
  345.  
  346. static long c_isa_gt()
  347. {
  348.   return c_isa_main(isa_gt_sel);
  349. }
  350.  
  351. static long c_isa_eq()
  352. {
  353.   return c_isa_main(isa_eq_sel);
  354. }
  355.  
  356. static long c_isa_nle()
  357. {
  358.   return c_isa_main(isa_nle_sel);
  359. }
  360.  
  361. static long c_isa_nlt()
  362. {
  363.   return c_isa_main(isa_nlt_sel);
  364. }
  365.  
  366. static long c_isa_nge()
  367. {
  368.   return c_isa_main(isa_nge_sel);
  369. }
  370.  
  371. static long c_isa_ngt()
  372. {
  373.   return c_isa_main(isa_ngt_sel);
  374. }
  375.  
  376. static long c_isa_neq()
  377. {
  378.   return c_isa_main(isa_neq_sel);
  379. }
  380.  
  381. static long c_isa_cmp()
  382. {
  383.   return c_isa_main(isa_cmp_sel);
  384. }
  385.  
  386. static long c_isa_ncmp()
  387. {
  388.   return c_isa_main(isa_ncmp_sel);
  389. }
  390.  
  391.  
  392.  
  393. /******** C_IS_FUNCTION
  394.   Succeed iff argument is a function (built-in or user-defined).
  395. */
  396. static int c_is_function() /*  RM: Jan 29 1993  */
  397. {
  398.   int success=TRUE,ans;
  399.   ptr_psi_term arg1,funct,result;
  400.  
  401.   funct=aim->a;
  402.   deref_ptr(funct);
  403.   result=aim->b;
  404.   get_one_arg(funct->attr_list,&arg1);
  405.   if (arg1) {
  406.     deref(arg1);
  407.     deref_args(funct,set_1);
  408.     ans=(arg1->type->type==function);
  409.     unify_bool_result(result,ans);
  410.   }
  411.   else curry();
  412.  
  413.   return success;
  414. }
  415.  
  416.  
  417.  
  418. /******** C_IS_PERSISTENT
  419.   Succeed iff argument is a quoted persistent or on the heap.
  420. */
  421. static int c_is_persistent() /*  RM: Feb  9 1993  */
  422. {
  423.   int success=TRUE,ans;
  424.   ptr_psi_term arg1,glob,result;
  425.  
  426.   glob=aim->a;
  427.   deref_ptr(glob);
  428.   result=aim->b;
  429.   get_one_arg(glob->attr_list,&arg1);
  430.   if (arg1) {
  431.     deref(arg1);
  432.     deref_args(glob,set_1);
  433.     ans=(
  434.      arg1->type->type==global &&
  435.      (GENERIC)arg1->type->global_value>=heap_pointer
  436.      ) ||
  437.        (GENERIC)arg1>=heap_pointer;
  438.     unify_bool_result(result,ans);
  439.   }
  440.   else curry();
  441.   
  442.   return success;
  443. }
  444.  
  445.  
  446.  
  447. /******** C_IS_PREDICATE
  448.   Succeed iff argument is a predicate (built-in or user-defined).
  449. */
  450. static int c_is_predicate() /*  RM: Jan 29 1993  */
  451. {
  452.   int success=TRUE,ans;
  453.   ptr_psi_term arg1,funct,result;
  454.  
  455.   funct=aim->a;
  456.   deref_ptr(funct);
  457.   result=aim->b;
  458.   get_one_arg(funct->attr_list,&arg1);
  459.   if (arg1) {
  460.     deref(arg1);
  461.     deref_args(funct,set_1);
  462.     ans=(arg1->type->type==predicate);
  463.     unify_bool_result(result,ans);
  464.   }
  465.   else curry();
  466.  
  467.   return success;
  468. }
  469.  
  470.  
  471.  
  472. /******** C_IS_SORT
  473.   Succeed iff argument is a sort (built-in or user-defined).
  474. */
  475. static int c_is_sort() /*  RM: Jan 29 1993  */
  476. {
  477.   int success=TRUE,ans;
  478.   ptr_psi_term arg1,funct,result;
  479.  
  480.   funct=aim->a;
  481.   deref_ptr(funct);
  482.   result=aim->b;
  483.   get_one_arg(funct->attr_list,&arg1);
  484.   if (arg1) {
  485.     deref(arg1);
  486.     deref_args(funct,set_1);
  487.     ans=(arg1->type->type==type);
  488.     unify_bool_result(result,ans);
  489.   }
  490.   else curry();
  491.  
  492.   return success;
  493. }
  494.  
  495.  
  496.  
  497. /******** C_IS_VALUE
  498.   Return true iff argument has a value, i.e. if it is implemented in
  499.   a quirky way in Wild_Life.  This is true for integers, reals,
  500.   strings (which are potentially infinite sets of objects), and list objects.
  501. */
  502. static long c_is_value()
  503. {
  504.   long success=TRUE,ans;
  505.   ptr_psi_term arg1,arg2,funct,result;
  506.  
  507.   funct=aim->a;
  508.   deref_ptr(funct);
  509.   result=aim->b;
  510.   get_two_args(funct->attr_list,&arg1,&arg2);
  511.   if (arg1) {
  512.     deref(arg1);
  513.     deref_args(funct,set_1);
  514.     ans=(arg1->value!=NULL);
  515.     unify_bool_result(result,ans);
  516.   }
  517.   else curry();
  518.  
  519.   return success;
  520. }
  521.  
  522.  
  523.  
  524. /******** C_IS_NUMBER
  525.   Return true iff argument is an actual number.
  526. */
  527. static long c_is_number()
  528. {
  529.   long success=TRUE,ans;
  530.   ptr_psi_term arg1,arg2,funct,result;
  531.  
  532.   funct=aim->a;
  533.   deref_ptr(funct);
  534.   result=aim->b;
  535.   get_two_args(funct->attr_list,&arg1,&arg2);
  536.   if (arg1) {
  537.     deref(arg1);
  538.     deref_args(funct,set_1);
  539.     ans=sub_type(arg1->type,real) && (arg1->value!=NULL);
  540.     unify_bool_result(result,ans);
  541.   }
  542.   else curry();
  543.  
  544.   return success;
  545. }
  546.  
  547.  
  548. /******** C_ISA_SUBSORT(A,B)
  549.   if A is a subsort of B => succeed and residuate on B
  550.   else             => fail
  551. */
  552. c_isa_subsort()
  553. {
  554.   ptr_psi_term pred,arg1,arg2;
  555.  
  556.   pred=aim->a;
  557.   deref_ptr(pred);
  558.   get_two_args(pred->attr_list,&arg1,&arg2);
  559.  
  560.   if (!arg1) reportAndAbort(pred,"no first argument");
  561.   deref(arg1);
  562.   
  563.   if (!arg2) reportAndAbort(pred,"no second argument");
  564.   deref(arg2);
  565.  
  566.   deref_args(pred, set_1_2);
  567.  
  568.   if (isa(arg1, arg2))
  569.   {
  570.       residuate(arg2);
  571.       return TRUE;
  572.   }
  573.   return FALSE;
  574. }
  575.  
  576.  
  577.  
  578. isValue(p)
  579. ptr_psi_term p;
  580. {
  581.     return (p->value != NULL);
  582. }
  583.  
  584.  
  585.  
  586. /******** C_GLB(A,B)
  587.   Return glb(A,B).  Continued calls will return each following type in
  588.   the disjunction of the glb of A,B.
  589. */
  590. c_glb()
  591. {
  592.   ptr_psi_term func,arg1,arg2, result, other;
  593.   ptr_definition ans;
  594.   ptr_int_list complexType;
  595.   ptr_int_list decodedType = NULL;
  596.   long ret;
  597.   
  598.   func=aim->a;
  599.   deref_ptr(func);
  600.   get_two_args(func->attr_list,&arg1,&arg2);
  601.  
  602.   if ((!arg1) || (!arg2)) {
  603.     curry();
  604.     return TRUE;
  605.   }
  606.   result = aim->b;
  607.   deref(result);
  608.   deref(arg1);
  609.   deref(arg2);
  610.   deref_args(func, set_1_2);
  611.  
  612.   if ((ret=glb(arg1->type, arg2->type, &ans, &complexType)) == 0)
  613.     return FALSE;
  614.  
  615.   if ((ret != 4)&&(isValue(arg1)||isValue(arg2))) {
  616.     /* glb is one of arg1->type or arg2->type AND at least one is a value */
  617.     if (!isSubTypeValue(arg1, arg2) && !isSubTypeValue(arg2, arg1))
  618.       return FALSE;
  619.   }
  620.   if (!ans) {
  621.     decodedType = decode(complexType);
  622.     ans = (ptr_definition)decodedType->value;
  623.     decodedType = decodedType->next;
  624.   }
  625.   other=makePsiTerm(ans);
  626.  
  627.   if (isValue(arg1)) other->value=arg1->value;
  628.   if (isValue(arg2)) other->value=arg2->value;
  629.     
  630.   if (isValue(arg1) || isValue(arg2)) {
  631.     if (decodedType) {
  632.       Errorline("glb of multiple-inheritance value sorts not yet implemented.\n");
  633.       return FALSE;
  634.     }
  635.   }
  636.     
  637.   if (decodedType)
  638.     push_choice_point(type_disj, result, decodedType, NULL);
  639.  
  640.   resid_aim = NULL;
  641.   push_goal(unify,result,other,NULL);
  642.   return TRUE;
  643. }
  644.  
  645.  
  646.  
  647. /******** C_LUB(A,B)
  648.   Return lub(A,B).  Continued calls will return each following type in
  649.   the disjunction of the lub of A,B.
  650. */
  651. c_lub()
  652. {
  653.   ptr_psi_term func,arg1,arg2, result, other;
  654.   ptr_definition ans=NULL;
  655.   ptr_int_list decodedType = NULL;
  656.   
  657.   func=aim->a;
  658.   deref_ptr(func);
  659.   get_two_args(func->attr_list,&arg1,&arg2);
  660.  
  661.   if ((!arg1) || (!arg2))
  662.   {
  663.     curry();
  664.     return TRUE;
  665.   }
  666.   result = aim->b;
  667.   deref(result);
  668.   deref(arg1);
  669.   deref(arg2);
  670.   deref_args(func, set_1_2);
  671.  
  672.   /* now lets find the list of types that is the lub */
  673.   
  674.   decodedType = lub(arg1, arg2, &other);
  675.  
  676.   if (decodedType) {
  677.     ans = (ptr_definition)decodedType->value;
  678.     decodedType = decodedType->next;
  679.     other = makePsiTerm(ans);
  680.   }
  681.  
  682.   if (decodedType)
  683.     push_choice_point(type_disj, result, decodedType, NULL);
  684.     
  685.   resid_aim = NULL;
  686.   push_goal(unify,result,other,NULL);
  687.   return TRUE;
  688. }
  689.  
  690.  
  691.  
  692. void insert_type_builtins() /*  RM: Jan 29 1993  */
  693. {
  694.   /* Sort comparisons */
  695.   new_built_in(syntax_module,":=<",function,c_isa_le);
  696.   new_built_in(syntax_module,":<",function,c_isa_lt);
  697.   new_built_in(syntax_module,":>=",function,c_isa_ge);
  698.   new_built_in(syntax_module,":>",function,c_isa_gt);
  699.   new_built_in(syntax_module,":==",function,c_isa_eq);
  700.   new_built_in(syntax_module,":><",function,c_isa_cmp);
  701.   new_built_in(syntax_module,":\\=<",function,c_isa_nle);
  702.   new_built_in(syntax_module,":\\<",function,c_isa_nlt);
  703.   new_built_in(syntax_module,":\\>=",function,c_isa_nge);
  704.   new_built_in(syntax_module,":\\>",function,c_isa_ngt);
  705.   new_built_in(syntax_module,":\\==",function,c_isa_neq);
  706.   new_built_in(syntax_module,":\\><",function,c_isa_ncmp);
  707.  
  708.  
  709.   /* Type checks */
  710.   new_built_in(bi_module,"is_value",function,c_is_value);
  711.   new_built_in(bi_module,"is_number",function,c_is_number);
  712.   new_built_in(bi_module,"is_function",function,c_is_function);
  713.   new_built_in(bi_module,"is_predicate",function,c_is_predicate);
  714.   new_built_in(bi_module,"is_sort",function,c_is_sort);
  715.   new_built_in(bi_module,"is_persistent",function,c_is_persistent);
  716.   
  717.   /* Sort hierarchy maneuvering */
  718.   new_built_in(bi_module,"children",function,c_children);
  719.   new_built_in(bi_module,"parents",function,c_parents);
  720.   new_built_in(bi_module,"least_sorts",function,c_smallest);
  721.   new_built_in(bi_module,"subsort",predicate,c_isa_subsort);
  722.   new_built_in(bi_module,"glb",function,c_glb);
  723.   new_built_in(bi_module,"lub",function,c_lub);
  724. }
  725.