adding string_to_term and a first version of exec

ocaml/Resolution.ml

@@ -123,6 +123,50 @@ let rec enat i =
 let make_const_add n m = 
   [[add Pos zero y y]; [add Neg x y z; add Pos (s x) y (s z)]; [add Neg (enat n) (enat m) r; r]] 
 
-let constellation = make_const_add 3 1 ;;
+let constellation = make_const_add 1 3 ;;
 
 print_dgraph (dgraph constellation) ;;
+
+(* test constellation cyclique déterministe *)
+(*let boucle = [[Func("c", Neg, [x]) ; Func("c", Pos, [x])]]
+print_dgraph (dgraph boucle);; *)
+
+(* exec graph *)
+
+let exec graph const = 
+  let rec aux graph sol = 
+    match graph with
+    | [] -> Some sol
+    | h::tail -> 
+      let rec aux2 glink sol = 
+        match glink, sol with
+        | [], _ -> aux tail sol
+        | ((i,j),(ri, rj))::t,(Some sola, solb) ->
+        aux2 t (solve [(substit (ray_to_term ri) sola,substit (ray_to_term rj) sola)] sola, (List.filter (fun a -> a <> ri) (List.nth const i))@solb )
+        | (_,(None,_)) -> None
+        in aux2 h sol
+  in aux graph (Some [],[]) ;;
+
+  (* Exec where it just keeps the last equation and re-tries to solve it as a whole instead of applying the solution of the previous equation *)
+
+  let exec2 graph const = 
+    let rec aux graph sol = 
+      match graph with
+      | [] -> Some sol
+      | h::tail -> 
+        let rec aux2 glink sol = 
+          match glink, sol with
+          | [], _ -> aux tail sol
+          | ((i,j),(ri, rj))::t,(Some sola, solb) ->
+          aux2 t (let eq = ((ray_to_term ri),(ray_to_term rj))::sola in 
+            if (solve eq []) = None then 
+              failwith "marchpo"
+            else Some eq,
+            (List.filter (fun a -> a <> ri) (List.nth const i))@solb )
+          | (_,(None,_)) -> None
+          in aux2 h sol
+    in aux graph (Some [],[]) ;;
+  
+
+exec (dgraph constellation) constellation;;
+exec2 (dgraph constellation) constellation;;

ocaml/Unification.ml

@@ -9,22 +9,23 @@ type term = Var of id | Func of (id * term list)
 type subst = id * term list
 type equation = term * term
 
-(* Affiche un term *)
+(* convert a term to a string *)
 
-let print_term t =
-   let rec aux t =
+let rec term_to_string t =
    match t with
    | Var id -> id
    | Func(f, tl) -> f ^ "(" ^
      let rec aux2 vl =
       match vl with
       | [] -> ""
-      | h::[] -> aux h
-      | h::t -> (aux h) ^ "," ^ (aux2 t) 
+      | h::[] -> term_to_string h
+      | h::t -> (term_to_string h) ^ "," ^ (aux2 t) 
       in (aux2 tl) ^ ")"
-   in print_string (aux t)
 
-(* Fonction de comparaison entre deux termes sur l'ordre lexicographique *)
+let print_term t =
+  print_string (term_to_string t)
+
+(* Compare to terms *)
 
 let rec compare_term t1 t2 =
    match t1, t2 with
@@ -35,21 +36,21 @@ let rec compare_term t1 t2 =
    else if comp < 0 then -1 
    else List.compare compare_term fs gs
 
-(* indom regarde si une variable est dans le domaine d'une substitution *)
+(* Look if there's a var to be substituted in the term in the substitution environment *)
 
 let rec indom t sl = 
   match t with
   | Var id -> List.exists (fun (a,_) -> a = id ) sl
   | Func(_, tl) -> List.exists (fun a -> indom a sl) tl
 
-(* occurs regarde si une variable apparaît dans un term *)
+(* occurs checks if given var is in term *)
 
 let rec occurs id t =
   match t with
   | Var i -> i = id 
   | Func(_, tl) -> List.exists (fun a -> occurs id a) tl
 
-(* extends_varname ajoute un suffixe à toutes les variables *)
+(* extends_varname adds suffix to all var names of a term *)
 
 let rec extends_varname t ext =
   match t with
@@ -57,7 +58,7 @@ let rec extends_varname t ext =
   | Func(f, tl) -> Func(f, List.map (fun a -> extends_varname a ext) tl)
 
 
-(* vars renvoie la liste de toutes les variables d'un term *)
+(* vars gives a list of all vars in a term *)
 
 let rec vars t =
   match t with
@@ -68,11 +69,11 @@ let rec vars t =
       Substitution
      ======================================== *)
 
-(* apply applique une substitution à une variable *)
+(* apply applies a substitution to a var *)
 
 let apply id sub = let (_,s) = try List.find (fun (a,_) -> a = id ) sub with Not_found -> (id,Var(id)) in s
 
-(* subst applique une substitution sur un terme *)
+(* subst applies all possible substition from an environment to a term *)
 
 let rec substit trm sub =
   match trm with
@@ -83,20 +84,20 @@ let rec substit trm sub =
       Unification
      ======================================== *)
 
-(* Résout une liste d'équations *)
+(* Solves an equation list by returning solution list *)
 
 let rec solve eq sub = 
   match eq with
   | [] -> Some sub
-  | (Var(x), term)::t -> if Var(x) = term then Some (solve t sub) else Some (elim x term t sub) (* Si x = x c'est une équation inutile, on passe donc à la suite *)
-  | (term, Var(x))::t -> Some (elim x term t sub) (*Inutile de vérifier si term = Var(x) ici car c'est déjà vérifié à la ligne ci-dessus*)
-  | (Func(f, fs), Func(g, gs))::t -> if f = g then Some (solve ((List.combine fs gs)@t) sub) else None (*si f et g ne sont pas égaux, on ne peut pas résoudre l'équation*)
+  | (Var(x), term)::t -> if Var(x) = term then (solve t sub) else (elim x term t sub) (* If x = x it's a useless equation *)
+  | (term, Var(x))::t -> (elim x term t sub) (*It's useless to check if term = Var(x) because it would be the same case as above *)
+  | (Func(f, fs), Func(g, gs))::t -> if f = g then (solve ((List.combine fs gs)@t) sub) else None (* If f and g are not equal, the equation can't be solved *)
 
 and elim id term eq sub =
   if eq = [] then Some sub
-  else if occurs id term then None (* l'équation n'est pas soluble, car on aurait quelque chose de la forme x = f(x) *)
+  else if occurs id term then None (* If that's the cas, we would have something like x = f(x) which can't be solved *)
   else let sigma_xy = [(id, term)] in
-  Some (solve (List.map (fun (a,b) -> (substit a sigma_xy, substit b sigma_xy)) eq) (sigma_xy@sub)) (* On substitue toutes les occurences d'id dans le système d'équation et on ajoute cette solution au système *)
+  (solve (List.map (fun (a,b) -> (substit a sigma_xy, substit b sigma_xy)) eq) (sigma_xy@sub)) (* We apply the sigma_xy substitution and we add it to the solution list *)
 
   (* ========================================
       Tests