home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / src / pl-dwim.c < prev    next >
C/C++ Source or Header  |  1992-05-26  |  6KB  |  236 lines
  1. /*  pl-dwim.c,v 1.1.1.1 1992/05/26 11:52:17 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: Do What I Mean support functions
  8. */
  9.  
  10. #include "pl-incl.h"
  11. #include "pl-ctype.h"
  12.  
  13. forwards Atom    dwimMatch P((char *, char *));
  14. forwards bool    oneTypo P((char *, char *));
  15. forwards bool    twoTransposed P((char *, char *));
  16. forwards bool    oneInserted P((char *, char *));
  17. forwards bool    differentSeparated P((char *, char *));
  18. forwards char *    subWord P((char *, char *));
  19. forwards bool    subwordsTransposed P((char *, char *));
  20.  
  21. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  22. Strings are supposed to be meant identical iff one of the  following  is
  23. the case:
  24.  
  25.   - They ARE identical
  26.   - One character is different            (spy == spu)
  27.   - One character is inserted/deleted/added    (debug == deug)
  28.   - Two adjecent characters are transposed    (trace == tarce)
  29.   - `Sub-words' have been separated wrong    (aB == a_b == ab)
  30.   - Two `Sub-words' have been transposed    (exists_file == file_exists)
  31. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  32.  
  33. static Atom
  34. dwimMatch(str1, str2)
  35. char *str1, *str2;
  36. { int l1, l2;
  37.   register char *s1 = str1;
  38.   register char *s2 = str2;
  39.  
  40.   while(*s1 && *s1 == *s2)            /* delete common part */
  41.     s1++, s2++;
  42.   l2 = (int) strlen(s2);
  43.   l1 = (int) strlen(s1);
  44.  
  45.   if (abs(l1-l2) > 5)                /* speed up a bit */
  46.     fail;
  47.   
  48.   if ( l1 == 0 && l2 == 0 )            return ATOM_equal;
  49.   if ( (s1[0] == EOS || s1[1] == EOS || s1[2] == EOS) ||
  50.        (s2[0] == EOS || s2[1] == EOS || s2[2] == EOS))
  51.     fail;
  52.   if ( l1 == l2 && oneTypo(s1, s2) )        return ATOM_mismatched_char;
  53.   if ( l1 == l2 && twoTransposed(s1, s2) )    return ATOM_transposed_char;
  54.   if ( (l2 == l1 + 1 && oneInserted(s1, s2)) ||
  55.        (l1 == l2 + 1 && oneInserted(s2, s1)) )    return ATOM_inserted_char;
  56.   if ( differentSeparated(str1, str2) )        return ATOM_separated;
  57.   if ( subwordsTransposed(str1, str2) )        return ATOM_transposed_word;
  58.  
  59.   fail;
  60. }
  61.  
  62. static bool
  63. oneTypo(s1, s2)
  64. char *s1, *s2;
  65. { if (s1[1] == EOS || streq(&s1[1], &s2[1]) )
  66.     succeed;
  67.   fail;
  68. }
  69.  
  70. static
  71. bool
  72. twoTransposed(s1, s2)
  73. register char *s1, *s2;
  74. { if (s1[1] != EOS && s1[0] == s2[1] && s1[1] == s2[0] &&
  75.        (s1[2] == EOS || streq(&s1[2], &s2[2])))
  76.     succeed;
  77.   fail;
  78. }
  79.  
  80. static bool
  81. oneInserted(s1, s2)
  82. register char *s1, *s2;
  83. { if (streq(s1, &s2[1]) )
  84.     succeed;
  85.   fail;
  86. }
  87.  
  88. static bool
  89. differentSeparated(s1, s2)
  90. register char *s1, *s2;
  91. { register char c1, c2;
  92.  
  93.   if ( *s1 != *s2 || *s1 == EOS )
  94.     fail;
  95.  
  96.   c1 = *++s1, c2 = *++s2;
  97.   while(c1 && c1 == c2)
  98.   { if ((c1 = *++s1) == '_')
  99.     { c1 = *++s1;
  100.     } else
  101.     { if (isLower(s1[-1]) && isUpper(c1))
  102.         c1 = toLower(c1);
  103.     }
  104.     if ((c2 = *++s2) == '_')
  105.     { c2 = *++s2;
  106.     } else
  107.     { if (isLower(s2[-1]) && isUpper(c2))
  108.     c2 = toLower(c2);
  109.     }
  110.   }
  111.   if (c1 == EOS && c2 == EOS)
  112.     succeed;
  113.   fail;
  114. }
  115.  
  116. static char *
  117. subWord(s, store)
  118. register char *s, *store;
  119. { *store++ = (isUpper(*s) ? toLower(*s) : *s);
  120.   s++;
  121.  
  122.   for(;;)
  123.   { if (*s == EOS)
  124.     { *store = EOS;
  125.       return s;
  126.     }
  127.     if (*s == '_')
  128.     { *store = EOS;
  129.       return ++s;
  130.     }
  131.     if (isLower(s[-1]) && isUpper(s[0]) )
  132.     { *store = EOS;
  133.       return s;
  134.     }
  135.     *store++ = *s++;
  136.   }
  137. }    
  138.  
  139. static bool
  140. subwordsTransposed(s1, s2)
  141. char *s1, *s2;
  142. { char sw1a[1024], sw1b[1024];
  143.   char sw2a[1024], sw2b[1024];
  144.  
  145.   while(*s1 && *s2)
  146.   { s1 = subWord(s1, sw1a);
  147.     s2 = subWord(s2, sw2a);
  148.     if (!streq(sw1a, sw2a) )
  149.     { if (*s1 == EOS || *s2 == EOS)
  150.     fail;
  151.       s1 = subWord(s1, sw1b);
  152.       s2 = subWord(s2, sw2b);
  153.       if (!streq(sw1a, sw2b) || !streq(sw1b, sw2a) )
  154.     fail;
  155.     }
  156.   }
  157.   if (*s1 == EOS && *s2 == EOS)
  158.     succeed;
  159.   fail;
  160. }
  161.  
  162.         /********************************
  163.         *       PROLOG CONNECTION       *
  164.         *********************************/
  165.  
  166. word
  167. pl_dwim_match(a1, a2, mm)
  168. Word a1, a2, mm;
  169. { char *s1, *s2 = NULL;        /* initialise to make gcc happy */
  170.   bool rval;
  171.   Atom type;
  172.  
  173.   initAllocLocal();
  174.   rval = ((s1 = primitiveToString(*a1, TRUE)) != (char *)NULL &&
  175.       (s2 = primitiveToString(*a2, TRUE)) != (char *)NULL);
  176.   stopAllocLocal();
  177.   if ( !rval )
  178.     fail;
  179.  
  180.   if ( (type = dwimMatch(s1, s2)) == (Atom) NULL )
  181.     fail;
  182.  
  183.   return unifyAtomic(mm, type);
  184. }
  185.  
  186. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  187. $dwim_predicate(+Term, -Dwim) successively returns all predicates of the
  188. specified module or context module  that  match  in  a  DWIM  sence  the
  189. predicate head.
  190. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  191.  
  192. word
  193. pl_dwim_predicate(term, dwim, h)
  194. Word term, dwim;
  195. word h;
  196. { FunctorDef fdef;
  197.   Module module = (Module) NULL;
  198.   Procedure proc;
  199.   Symbol symb;
  200.  
  201.   if ( ForeignControl(h) == FRG_CUTTED )
  202.     succeed;
  203.  
  204.   if ((term = stripModule(term, &module)) == (Word) NULL)
  205.     fail;
  206.  
  207.   if (isAtom(*term) )
  208.     fdef = lookupFunctorDef((Atom)*term, 0);
  209.   else if (isTerm(*term) )
  210.     fdef = functorTerm(*term);
  211.   else
  212.     return warning("dwim_predicate/2: illegal term specification");
  213.       
  214.   if ( ForeignControl(h) == FRG_FIRST_CALL )
  215.     symb = firstHTable(module->procedures);
  216.   else
  217.     symb = (Symbol) ForeignContextAddress(h);
  218.  
  219.   for(; symb; symb = nextHTable(module->procedures, symb))
  220.   { proc = (Procedure) symb->value;
  221.     if ( dwimMatch(stringAtom(fdef->name), stringAtom(proc->functor->name)) &&
  222.          isDefinedProcedure(proc) &&
  223.          (stringAtom(proc->functor->name)[0] != '$' ||
  224.        SYSTEM_MODE) )
  225.     { if (unifyFunctor(dwim, proc->functor) == FALSE)
  226.     continue;
  227.       if ((symb = nextHTable(module->procedures, symb)) != (Symbol) NULL)
  228.     ForeignRedo(symb);
  229.  
  230.       succeed;
  231.     }
  232.   }
  233.  
  234.   fail;
  235. }
  236.