From c3d5123ab0d3d8545a5342b23d45c2d5766b644e Mon Sep 17 00:00:00 2001
From: ccremers <ccremers@4f7d145f-a0d4-0310-ae10-d96cc04433c1>
Date: Sun, 15 Aug 2004 16:08:53 +0000
Subject: [PATCH] - Matching is now typed.

---
 src/binding.c  |   9 +++-
 src/compiler.c |   7 +++-
 src/mgu.c      | 112 +++++++++++++++++++++++++++++++++++--------------
 src/system.c   |   5 ++-
 src/term.c     |   2 +-
 5 files changed, 99 insertions(+), 36 deletions(-)

diff --git a/src/binding.c b/src/binding.c
index 9fc23c2..b9c9c9c 100644
--- a/src/binding.c
+++ b/src/binding.c
@@ -7,6 +7,7 @@
 #include "binding.h"
 #include "warshall.h"
 #include "memory.h"
+#include "debug.h"
 
 /*
  * Idea is the ev_from *has to* precede the ev_to
@@ -203,7 +204,13 @@ binding_add (int run_from, int ev_from, int run_to, int ev_to)
   Binding b;
 
   b = binding_create (run_from, ev_from, run_to, ev_to);
-  eprintf ("Adding binding (%i,%i) --->> (%i,%i)\n",run_from, ev_from, run_to, ev_to);
+#ifdef DEBUG
+  if (DEBUGL (5))
+    {
+      eprintf ("Adding binding (%i,%i) --->> (%i,%i)\n", run_from, ev_from,
+	       run_to, ev_to);
+    }
+#endif
   sys->bindings = list_insert (sys->bindings, b);
 
   /*
diff --git a/src/compiler.c b/src/compiler.c
index aa8840d..fd3fbee 100644
--- a/src/compiler.c
+++ b/src/compiler.c
@@ -701,8 +701,11 @@ protocolCompile (Symbol prots, Tac tc, Tac tcroles)
     {
       if (sys->engine == ARACHNE_ENGINE)
 	{
-	  pr->rolenames =
-	    termlistAppend (pr->rolenames, levelVar (tcroles->t1.sym));
+	  Term rolename;
+
+	  rolename = levelVar (tcroles->t1.sym);
+	  rolename->stype = termlistAdd (NULL, TERM_Agent);
+	  pr->rolenames = termlistAppend (pr->rolenames, rolename);
 	}
       else
 	{
diff --git a/src/mgu.c b/src/mgu.c
index 4af4332..bcdbc12 100644
--- a/src/mgu.c
+++ b/src/mgu.c
@@ -14,6 +14,85 @@
    New version yields a termlist with substituted variables, which can later be reset to NULL.
 */
 
+//! Global constant. If true, typed checking
+int welltyped = 1;
+
+void
+showSubst (Term t)
+{
+#ifdef DEBUG
+  if (!DEBUGL (5))
+    return;
+
+  indent ();
+  printf ("Substituting ");
+  termPrint (t);
+  printf (", typed ");
+  termlistPrint (t->stype);
+  if (realTermLeaf (t->subst))
+    {
+      printf ("->");
+      termlistPrint (t->subst->stype);
+    }
+  else
+    {
+      printf (", composite term");
+    }
+  if (t->type != VARIABLE)
+    {
+      printf (" (bound roleconstant)");
+    }
+  printf ("\n");
+#endif
+}
+
+//! See if a substitution is valid
+__inline__ int
+goodsubst (Term tvar, Term tsubst)
+{
+  if (tvar->stype == NULL || (!welltyped))
+    {
+      return 1;
+    }
+  else
+    {
+      /**
+       * Check if each type of the substitution is allowed in the variable
+       */
+      if (!realTermLeaf (tsubst))
+	{
+	  // Typed var cannot match with non-leaf
+	  return 0;
+	}
+      else
+	{
+	  // It's a leaf, but what type?
+	  if (termlistContained (tvar->stype, tsubst->stype))
+	    {
+	      return 1;
+	    }
+	  else
+	    {
+#ifdef DEBUG
+	      if (DEBUGL (5))
+		{
+		  eprintf ("Substitution fails on ");
+		  termPrint (tvar);
+		  eprintf (" -/-> ");
+		  termPrint (tsubst);
+		  eprintf (", because type: \n");
+		  termlistPrint (tvar->stype);
+		  eprintf (" does not contain ");
+		  termlistPrint (tsubst->stype);
+		  eprintf ("\n");
+		}
+#endif
+	      return 0;
+	    }
+	}
+    }
+}
+
 //! Undo all substitutions in a list of variables.
 /**
  * The termlist should contain only variables.
@@ -43,34 +122,6 @@ termMguTerm (Term t1, Term t2)
   if (t1 == t2)
     return NULL;
 
-#ifdef DEBUG
-  void showSubst (Term t)
-  {
-    if (!DEBUGL (5))
-      return;
-
-    indent ();
-    printf ("Substituting ");
-    termPrint (t);
-    printf (", typed ");
-    termlistPrint (t->stype);
-    if (realTermLeaf (t->subst))
-      {
-	printf ("->");
-	termlistPrint (t->subst->stype);
-      }
-    else
-      {
-	printf (", composite term");
-      }
-    if (t->type != VARIABLE)
-      {
-	printf (" (bound roleconstant)");
-      }
-    printf ("\n");
-  }
-#endif
-
   if (!(hasTermVariable (t1) || hasTermVariable (t2)))
     {
       if (isTermEqual (t1, t2))
@@ -86,7 +137,7 @@ termMguTerm (Term t1, Term t2)
   /* symmetrical tests for single variable */
   if (realTermVariable (t1))
     {
-      if (termOccurs (t2, t1))
+      if (termOccurs (t2, t1) || !goodsubst (t1, t2))
 	return MGUFAIL;
       else
 	{
@@ -99,7 +150,7 @@ termMguTerm (Term t1, Term t2)
     }
   if (realTermVariable (t2))
     {
-      if (termOccurs (t1, t2))
+      if (termOccurs (t1, t2) || !goodsubst (t2, t1))
 	return MGUFAIL;
       else
 	{
@@ -265,4 +316,3 @@ termMguSubTerm (Term t1, Term t2, int (*iterator) (),
     }
   return flag;
 }
-
diff --git a/src/system.c b/src/system.c
index ba7f622..f71f14f 100644
--- a/src/system.c
+++ b/src/system.c
@@ -597,6 +597,7 @@ roleInstance (const System sys, const Protocol protocol, const Role role,
 	      // Make new var for this run
 	      newt = makeTermType (VARIABLE, newt->left.symb, rid);
 	      artefacts = termlistAdd (artefacts, newt);
+	      newt->stype = oldt->stype;
 	      // Copy substitution
 	      newt->subst = oldt->subst;
 	      // Remove any old substitution! It is now propagated!
@@ -604,7 +605,9 @@ roleInstance (const System sys, const Protocol protocol, const Role role,
 	    }
 	  // Add to agent list, possibly
 	  if (inTermlist (protocol->rolenames, oldt))
-	    runs[rid].agents = termlistAdd (runs[rid].agents, newt);
+	    {
+	      runs[rid].agents = termlistAdd (runs[rid].agents, newt);
+	    }
 	  fromlist = termlistAdd (fromlist, oldt);
 	  tolist = termlistAdd (tolist, newt);
 
diff --git a/src/term.c b/src/term.c
index 2520220..7928e83 100644
--- a/src/term.c
+++ b/src/term.c
@@ -297,7 +297,7 @@ termPrint (Term term)
       return;
     }
 #ifdef DEBUG
-  if (!DEBUGL (1))
+  if (!DEBUGL (4))
     {
       term = deVar (term);
     }