Unify.borg

{
?f() :: f[3];

is_bool(a) ::
   tag(a) = 27; `previous version: tag = 6`

is_false(a) ::
   (tag(a) = 27) & !a;

`EQUAL-functie`
`vars zijn equal als hun naam dezelfde is`
`tabellen zijn equal als elk van hun elementen equal is`
`functies zijn equal als de naam dezelfde is en de paramlists even lang zijn`
`op al de rest wordt "=" opgeroepen`
equal(e1, e2) :: {
   iter(count, res) ::
      if ((count <= 0) | !res,
         res,
         iter(count - 1, equal(e1[count], e2[count])));
   if (!(tag(e1) = tag(e2)),
      false,
      if (is_ref(e1),
         e1 ~ e2, `origineel: e1[1] = e2[1]`
         if (is_table(e1) & (size(e1) = size(e2)),
            iter(size(e1), true),
            if (is_fun(e1), `vgl v 2 functies: namen + lengte v paramlist gelijk`
               `(e1[1] = e2[1]) & (size(e1[2]) = size(e2[2])),`
               e1 ~ e2,
               e1 = e2))))
};

deepcopy(list) ::
  if (is_table(list), {
        res[size(list)] : void;
        for (i : size(list), i > 0, i := i - 1, res[i] := deepcopy(list[i]));
        res
     },
     list);

assoclist() :: [0, []];

assocsize(list) :: list[1];

noassoc(f) ::
   `return value wanneer we een key opzoeken die niet in de lijst zit`
   if (is_fun(f),
      text(f[1]) = "noassoc",
      false);

findassoc(list, key) :: {
  iter(rest) :: {
    if (size(rest) = 0, noassoc,
      if (equal(rest[1], key), rest[2], iter(rest[3])))
  };
  iter(list[2])
};

addassoc(list, key, value) :: {
   if (noassoc(findassoc(list, key)), {
         list[1] := list[1] + 1;
         list[2] := [key, value, list[2]];
         true
      },
     false)
};

setassoc(list, key, value) :: {
   iter(rest) ::
     if (size(rest) = 0, void,
        if (equal(rest[1], key), rest, iter(rest[3])));
   tmp : iter(list[2]);
   if (is_voi(tmp), false, { tmp[2] := value; true })
};

makelist() :: [0, void];

addelement(list, el) :: {
   list[1] := list[1] + 1;
   list[2] := [el, list[2]];
   list
};

foreach(list, function) ::
   for (rest : list[2], !is_voi(rest), rest := rest[2], function(rest[1]));

append(list1, list2) :: {
   iter(rest) ::
      if (is_voi(rest[2]),
         rest[2] := deepcopy(list2[2]),
         iter(rest[2]));
   newlist : deepcopy(list1);
   if (newlist[1] = 0,
      newlist[2] := deepcopy(list2[2]),
      iter(newlist[2]));
   newlist[1] := newlist[1] + list2[1];
   newlist
};

unifyfailed(f) ::
   `return value wanneer unificatie mislukt`
   if (is_fun(f),
      text(f[1]) = "unifyfailed",
      false);

complete(tbl) ::
   `1e element van return value bij gelukte unificatie waarbij alle variabelen ingevuld zijn`
   `return value v unificatie is tabel v 3 elementen`
   `1e el: complete of incomplete`
   `2e el; - bij complete: de volledig geunifieerde expressie`
   `        - bij incomplete: lijst van expressies waarin nog variabelen zitten`
   `3e el: associatielijst van bindingen`
   is_table(tbl) & equal(tbl[1], complete);

incomplete(tbl) ::
   `1e element van return value bij gelukte unificatie waarbij nog niet alle variableen`
   `ingevuld zijn`
   is_table(tbl) & equal(tbl[1], incomplete);

checkexp(exp) :: {
   `kijkt of in tabel exp nog variabelen voorkomen`
   iter(i, result) ::
      if (!result,
         false,
         if (i <= 0,
            result,
            iter (i - 1, checkexp(exp[i]))));
   if (is_table(exp),
      iter (size(exp), true),
      !is_ref(exp))
};

basicunify(exp1, exp2, result) :: {
   changed : false;
   replace(list, exp, val, count) ::
      if (count > 0, {
            tmp : list[count];
            if (is_table(tmp),
               list[count] := replace(tmp, exp, val, size(tmp)),
               if (is_ref(tmp),
                  if (equal(tmp, exp),
                     list[count] := val)));
            replace(list, exp, val, count - 1)
         },
         list);
   assignvar(exp, val) :: {
      noloops(rest, count, res) ::
         if (!res,
            false,
            if (count <= 0,
               res,
               if (is_table(rest[count]),
                  noloops(rest, count - 1, noloops(rest[count], size(rest[count]), true)),
                  noloops(rest, count - 1, !equal(rest[count], exp)))));
      if (is_table(val) & !noloops(val, size(val), true),
         false, {
            if (is_table(exp1), replace(exp1, exp, val, size(exp1)), if (equal(exp1, exp), exp1 := val));
            if (is_table(exp2), replace(exp2, exp, val, size(exp2)), if (equal(exp2, exp), exp2 := val));
            changed := true;
            addassoc(result, exp, val)
         })
   };
   looptab(t1, t2, count, res) ::
      if (!res,
         false,
         if (count <= 0,
            res,
            looptab(t1, t2, count - 1, loop(t1[count], t2[count]))));
   loop(a, b) ::
      if (is_table(a),
         if (is_table(b),
            if (size(a) = size(b),
               looptab(a, b, size(a), true),
               false),
            if (is_ref(b),
               assignvar(b, a),
               false)),
         if (is_ref(a),
            if (is_ref(b),
               true,
               assignvar(a, b)),
            if (is_ref(b),
               assignvar(b, a),
               equal(a, b))));
   iter() :: {
      changed := false;
      if (loop(exp1, exp2),
         if (changed,
            iter(),
            if (checkexp(exp1) & checkexp(exp2),
               [complete, exp1, result],
               if (equal(exp1, exp2),
                  [incomplete, [1, [exp1, void]], result],
                  [incomplete, [2, [exp1, [exp2, void]]], result]))),
         unifyfailed)
   };
   iter()
};

union(a, b) :: {
   `berekend unie van 2 associatielijsten, return value = false wanneer lijsten niet`
   `compatibel zijn, dus wanneer een variabele in beide lijsten andere waarde heeft`
   iter (rest, result) ::
     if (size(rest) = 0,
        result,
        if (noassoc(val : findassoc(result, rest[1])),
           iter(rest[3], { addassoc(result, rest[1], rest[2]); result }),
           if (equal(val, rest[2]),
              iter(rest[3], result),
              false)));
   tmp : iter(a[2], assoclist());
   if (is_table(tmp),
      iter (b[2], tmp),
      false)
};

expandexp(exp, assoclist) :: {
   `loopt tabel exp af en zal voor iedere variabele in deze tabel proberen een waarde te zoeken`
   `uit de assoclist, wanneer waarde gevonden wordt, zal variabele in tabel vervangen worden door`
   `haar waarde, anders blijft var staan.  Return value = geexpandeerde tabel.`
   iter(i) ::
      if (i <= 0,
         exp, {
            exp[i] := expandexp(exp[i], assoclist);
            iter(i - 1)
         });
   if (is_table(exp),
      iter(size(exp)),
      if (is_ref(exp) & !noassoc(tmp : findassoc(assoclist, exp)),
         expandexp(tmp, assoclist), `origineel: tmp`
         exp))
};

cleanuplist(inc) :: {
   `incomplete structuur opkuisen: uit lijst van tabellen met nog in te vullen vars kijken welke`
   `van deze tabellen nu wel volledig ingevuld zijn, en deze verwijderen.`
   `als er nog maar 1 tabel overblijft die volledig ingevuld is, mag deze blijven staan, dit is`
   `de volledig geunifieerde expressie, het keyword 'incomplete' in de return value wordt dan`
   `vervangen door 'complete'.`
   iter (prev, rest) ::
      if (is_voi(rest),
         inc,
         if (!checkexp(rest[1]),
            iter(rest, rest[2]),
            if (list[1] = 1,
               [complete, rest[1], inc[3]], {
                  list[1] := list[1] - 1;
                  if (is_voi(prev),
                     list[2] := rest[2],
                     prev[2] := rest[2]);
                  iter(prev, rest[2])
               })));
   list : inc[2];
   if (list[1] = 0,
      list,
      iter(void, list[2]))
};

retrieve(key, result) ::
   `het opzoeken van de waarde van een variabele in een complete of incomplete ding`
   expandexp(key,result[3]);

unify(exp1, exp2) :: {
   `deepcopys zijn nodig vermits algoritme destructief werkt op beide expressies`
   exp1 : deepcopy(exp1);
   exp2 : deepcopy(exp2);
   simpleiter(rest, exp, result) ::
      `dient om een expressie te unifieren met een lijst van andere expressies: een voor een`
      `unifieren en nieuwe bindingen in result rammen`
      if (is_voi(rest),
         cleanuplist(result), {
            expandexp(rest[1], result[3]);
            tmp : basicunify(rest[1], exp, result[3]);
            if (unifyfailed(tmp),
               unifyfailed,
               if (complete(tmp),
                  simpleiter(rest[2], exp, [incomplete, addelement(result[2], tmp[2]), tmp[3]]),
                  simpleiter(rest[2], exp, [incomplete, append(result[2], tmp[2]), tmp[3]])))
         });
   distriter(rest, list, result) ::
      `wordt gebruikt wanneer we 2 incomplete dingen met elkaar unifieren`
      `vergelijkbaar met distributiefe vermenigvuldiging: telkens een elementje uit 1e incomplete`
      `ding unifieren met het 2e te unifieren incomplete ding (zit in var 'list')`
      if (is_voi(rest),
         cleanuplist(result), {
            expandexp(rest[1], result[3]);
            tmp : simpleiter(list, rest[1], [incomplete, makelist(), result[3]]);
            if (unifyfailed(tmp),
               unifyfailed,
               if (complete(tmp),
                  distriter(rest[2], list, [incomplete, addelement(result[2], tmp[2]), tmp[3]]),
                  distriter(rest[2], list, [incomplete, append(result[2], tmp[2]), tmp[3]])))
         });
   `nu volgt een hele hoop if-kes die gaan zien van welk type de expressies zijn die we meegegeven`
   `hebben aan de unify-oproep en aan de hand van deze types de nodige acties ondernemen.`
   if (unifyfailed(exp1) | unifyfailed(exp2),
      unifyfailed, `1 of 2 unifyfailed => unifyfailed`
      if (incomplete(exp1),
         if (incomplete(exp2),
            if (is_false(tmp : union(exp1[3], exp2[3])),
               unifyfailed,
               { t1 : exp1[2]; t2 : exp2[2]; distriter(t1[2], t2[2], [incomplete, makelist(), tmp])}), `both incomplete`
            if (complete(exp2),
               if (is_false(tmp : union(exp1[3], exp2[3])),
                  unifyfailed,
                  { t : exp2[2]; simpleiter (expandexp(t[2], tmp), expandexp(exp2[2], tmp), [incomplete, makelist(), tmp])}), `exp1 inc, exp2 complete`
               { t : exp1[2]; simpleiter(t[2], expandexp(exp2, exp1[3]), [incomplete, makelist(), exp1[3]]) })), `exp1 inc, exp2 list`
         if (complete(exp1),
            if (incomplete(exp2),
               if (is_false(tmp : union(exp1[3], exp2[3])),
                  unifyfailed,
                  { t : exp2[2]; simpleiter(t[2], exp1[2], [incomplete, makelist(), tmp]) }), `exp1 complete, exp2 incomplete`
               if (complete(exp2),
                     if (is_false(tmp : union(exp1[3], exp2[3])),
                        unifyfailed,
                        basicunify(expandexp(exp1[2], tmp), expandexp(exp2[2], tmp), [incomplete, makelist(), tmp])), `exp1 complete, exp2 complete`
                  basicunify(exp1[2], expandexp(exp2, exp1[3]), [incomplete, makelist(), exp1[3]]))), `exp1 complete, exp2 list`
            if (incomplete(exp2),
               { t : exp2[2]; simpleiter(t[2], exp1, [incomplete, makelist(), exp2[3]]) }, `exp1 list, exp2 incomplete`
               if (complete(exp2),
                  basicunify(expandexp(exp1, exp2[3]), exp2[2], exp2[3]), `exp1 list, exp2 complete`
                  basicunify(exp1, exp2, assoclist())))))) `both lists`
};


display("display(unify([?x,?y],[[1,?y],[2,?x]]))"+eoln);
display("display(unify([2,[1,?x]],[?x,[1,?x]]))"+eoln);
display("display(unify([1,2,?a],[1,?b,3]))"+eoln);
display("display(unify([1,2,3],?a))"+eoln);
display("display(unify(?a,[1,2,?a]))"+eoln);
display("display(unify([1,2,3],[?a,2,1]))"+eoln+eoln);

display("display(tmp:unify([1, 2, [4, ?a, ?b]], [?c, 2, ?d]))"+eoln);
display("display(unify([?a, ?b],[1,?a]))"+eoln);
display("display(unify([?a, [1, ?a]], [10, [1, 10]]))"+eoln);
display("display(unify([1,2,[4,?a,?b]],[?a,?b,?c]))"+eoln);
display("display(unify([?a, [?b, ?c]], [?b, [?c, ?b]]))"+eoln+eoln);

display("tmp : unify([1, 2, [4, ?a, ?b]], [?c, 2, ?d])"+eoln);
display("t : unify(tmp, [1,2,[4,?e,5]])"+eoln); ` = `
display("res : unify(t,[1,2,[4,6,5]])"+eoln); `werkt, probleem zat in laatste regel van addelement`

display("t1 : unify([?a,?b,?c,4],[?a,?b,3,?d])"+eoln);
display("t2 : unify([?a,2,?c,?d],[1,?b,?c,?d])"+eoln);
display("res : unify(t1,t2)"+eoln) ` =   argument type conflict    + `
}