home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / src / pl-util.c < prev    next >
C/C++ Source or Header  |  1992-05-26  |  6KB  |  231 lines
  1. /*  pl-util.c,v 1.1.1.1 1992/05/26 11:52:27 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: asorted handy functions
  8. */
  9.  
  10. #include "pl-incl.h"
  11. #include "pl-ctype.h"
  12.  
  13. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  14. Transform a Prolog word into an integer.   Accepts  integers  and  reals
  15. that are by accident integer.
  16. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  17.  
  18. bool
  19. wordToInteger(w, n)
  20. word w;
  21. long *n;
  22. { real f;
  23.  
  24.   if (isInteger(w) )
  25.   { *n = valNum(w);
  26.     succeed;
  27.   }
  28.   if (isReal(w) )
  29.   { f = valReal(w);
  30.     if (f == (real)((long)f))
  31.     { *n = (long) f;
  32.       succeed;
  33.     }      
  34.   }
  35.   fail;
  36. }  
  37.  
  38. /*  Transform a Prolog word into a real.  Accepts integers and reals.
  39.  
  40.  ** Fri Jun 10 10:45:18 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  41.  
  42. bool
  43. wordToReal(w, f)
  44. word w;
  45. real *f;
  46. { if (isInteger(w) )
  47.   { *f = (real) valNum(w);
  48.     succeed;
  49.   }
  50.   if (isReal(w) )
  51.   { *f = valReal(w);
  52.     succeed;
  53.   }
  54.   fail;
  55. }  
  56.  
  57. /*  Return the character representing some digit.
  58.  
  59.  ** Fri Jun 10 10:45:40 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  60.  
  61. char
  62. digitName(n, small)
  63. int n;
  64. bool small;
  65. { if (n <= 9)
  66.     return n + '0';
  67.   return n + (small ? 'a' : 'A') - 10;
  68. }
  69.  
  70. /*  Return the value of a digit when transforming a number of base 'b'.
  71.     Return '-1' if it is an illegal digit.
  72.  
  73.  ** Fri Jun 10 10:46:40 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  74.  
  75. #if PROTO
  76. int
  77. digitValue(int b, char c)
  78. #else
  79. int
  80. digitValue(b, c)
  81. int b;
  82. char c;
  83. #endif
  84. { DEBUG(9, printf("digitValue(%d, %c)\n", b, c));
  85.   if (b == 0)
  86.   { if (c & 0x80)
  87.       return -1;
  88.     return c;
  89.   }
  90.   if (b == 1)
  91.     return -1;
  92.   if (b <= 10)
  93.   { if (c - '0' < b)
  94.       return c - '0';
  95.     return -1;
  96.   }
  97.   if (c <= '9')
  98.     return c - '0';
  99.   if (isUpper(c))
  100.     c = toLower(c);
  101.   c = c - 'a' + 10;
  102.   if (c < b)
  103.     return c;
  104.   return -1;
  105. }
  106.  
  107. /*  return the name of a procedure as a string.  The result is stored in
  108.     static  area and should be copied away before the next call if it is
  109.     to be preserved.
  110.  
  111.  ** Sun Aug 28 13:21:07 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  112.  
  113. char *
  114. procedureName(proc)
  115. Procedure proc;
  116. { static char tmp[256];
  117.  
  118.   if ( proc->definition->module == MODULE_user ||
  119.        isUserSystemProcedure(proc) )
  120.     sprintf(tmp, "%s/%d", stringAtom(proc->functor->name), 
  121.               proc->functor->arity);
  122.   else
  123.     sprintf(tmp, "%s:%s/%d", stringAtom(proc->definition->module->name), 
  124.                  stringAtom(proc->functor->name), 
  125.                  proc->functor->arity);
  126.  
  127.   return tmp;
  128. }
  129.  
  130. /*  succeeds if proc is a system predicate exported to the public module.
  131.  
  132.  ** Fri Sep  2 17:03:43 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  133.  
  134. bool
  135. isUserSystemProcedure(proc)
  136. Procedure proc;
  137. { if ( true(proc->definition, SYSTEM) &&
  138.        isCurrentProcedure(proc->functor, MODULE_user) != (Procedure) NULL)
  139.     succeed;
  140.  
  141.   fail;
  142. }
  143.  
  144. word
  145. notImplemented(name, arity)
  146. char *name;
  147. int arity;
  148. { return warning("%s/%d is not implemented in this version");
  149. }
  150.  
  151.         /********************************
  152.         *             STRING            *
  153.         *********************************/
  154.  
  155.  
  156. bool
  157. strprefix(string, prefix)
  158. register char *string, *prefix;
  159. { while(*prefix && *string == *prefix)
  160.     prefix++, string++;
  161.   if (*prefix == EOS )
  162.     succeed;
  163.   fail;
  164. }
  165.  
  166. bool
  167. strpostfix(string, postfix)
  168. char *string, *postfix;
  169. { long offset = strlen(string) - strlen(postfix);
  170.  
  171.   if ( offset < 0 )
  172.     fail;
  173.  
  174.   return streq(&string[offset], postfix);
  175. }
  176.  
  177. bool
  178. strsub(string, sub)
  179. register char *string, *sub;
  180. { register char *s, *sb;
  181.  
  182.   while( *(s = string++) )
  183.   { for(sb=sub; *sb && *s == *sb; )
  184.       s++, sb++;
  185.     if ( *sb == EOS )
  186.       succeed;
  187.   }
  188.   fail;
  189. }
  190.  
  191.         /********************************
  192.         *        CHARACTER TYPES        *
  193.         *********************************/
  194.  
  195. char char_type[] = {
  196. /* ^@  ^A  ^B  ^C  ^D  ^E  ^F  ^G  ^H  ^I  ^J  ^K  ^L  ^M  ^N  ^O    0-15 */
  197.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  198. /* ^P  ^Q  ^R  ^S  ^T  ^U  ^V  ^W  ^X  ^Y  ^Z  ^[  ^\  ^]  ^^  ^_   16-31 */
  199.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  200. /* sp   !   "   #   $   %   &   '   (   )   *   +   ,   -   .   /   32-47 */
  201.    SP, SO, DQ, SY, SY, SO, SY, SQ, PU, PU, SY, SY, PU, SY, SY, SY, 
  202. /*  0   1   2   3   4   5   6   7   8   9   :   ;   <   =   >   ?   48-63 */
  203.    DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY, 
  204. /*  @   A   B   C   D   E   F   G   H   I   J   K   L   M   N   O   64-79 */
  205.    SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, 
  206. /*  P   Q   R   S   T   U   V   W   X   Y   Z   [   \   ]   ^   _   80-95 */
  207.    UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC, 
  208. /*  `   a   b   c   d   e   f   g   h   i   j   k   l   m   n   o   96-111 */
  209.    SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, 
  210. /*  p   q   r   s   t   u   v   w   x   y   z   {   |   }   ~  ^?   112-127 */
  211.    LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, SP, 
  212.               /* 128-255 */
  213.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  214.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  215.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  216.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  217.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  218.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  219.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, 
  220.    SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP, SP };
  221.  
  222. void
  223. systemMode(accept)
  224. bool accept;
  225. { char_type[(int)'$'] = (accept ? LC : SY);
  226.   if ( accept )
  227.     debugstatus.styleCheck |= DOLLAR_STYLE;
  228.   else
  229.     debugstatus.styleCheck &= ~DOLLAR_STYLE;
  230. }
  231.