klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

kgequalp.c (2015B)

      1 /*
      2 ** kgequalp.h
      3 ** Equivalence up to mutation features for the ground environment
      4 ** See Copyright Notice in klisp.h
      5 */
      6 
      7 #include <assert.h>
      8 #include <stdio.h>
      9 #include <stdlib.h>
     10 #include <stdbool.h>
     11 #include <stdint.h>
     12 
     13 #include "kstate.h"
     14 #include "kobject.h"
     15 #include "kpair.h"
     16 #include "kvector.h" 
     17 #include "kstring.h" /* for kstring_equalp */
     18 #include "kbytevector.h" /* for kbytevector_equalp */
     19 #include "kcontinuation.h"
     20 #include "kerror.h"
     21 
     22 #include "kghelpers.h"
     23 #include "kgequalp.h"
     24 
     25 /* 4.3.1 equal? */
     26 /* 6.6.1 equal? */
     27 
     28 /*
     29 ** equal? is O(n) where n is the number of pairs.
     30 ** Based on [1] "A linear algorithm for testing equivalence of finite automata"
     31 ** by J.E. Hopcroft and R.M.Karp
     32 ** List merging from [2] "A linear list merging algorithm"
     33 ** by J.E. Hopcroft and J.D. Ullman
     34 ** Idea to look up these papers from srfi 85: 
     35 ** "Recursive Equivalence Predicates" by William D. Clinger
     36 */
     37 void equalp(klisp_State *K)
     38 {
     39     TValue *xparams = K->next_xparams;
     40     TValue ptree = K->next_value;
     41     TValue denv = K->next_env;
     42     klisp_assert(ttisenvironment(K->next_env));
     43     UNUSED(denv);
     44     UNUSED(xparams);
     45 
     46     int32_t pairs;
     47     check_list(K, true, ptree, &pairs, NULL);
     48 
     49     /* In this case we can get away without comparing the
     50        first and last element on a cycle because equal? is
     51        symetric, (cf: ftyped_bpred) */
     52     int32_t comps = pairs - 1;
     53     TValue tail = ptree;
     54     TValue res = KTRUE;
     55     while(comps-- > 0) {  /* comps could be -1 if ptree is nil */
     56         TValue first = kcar(tail);
     57         tail = kcdr(tail); /* tail only advances one place per iteration */
     58         TValue second = kcar(tail);
     59 
     60         if (!equal2p(K, first, second)) {
     61             res = KFALSE;
     62             break;
     63         }
     64     }
     65 
     66     kapply_cc(K, res);
     67 }
     68 
     69 /* init ground */
     70 void kinit_equalp_ground_env(klisp_State *K)
     71 {
     72     TValue ground_env = G(K)->ground_env;
     73     TValue symbol, value;
     74     /* 4.3.1 equal? */
     75     /* 6.6.1 equal? */
     76     add_applicative(K, ground_env, "equal?", equalp, 0);
     77 }