removed check_star parameter from exec, moved test to main.ml and added comments

ocaml/Resolution.ml

@@ -12,6 +12,10 @@ type star = ray list
 type constellation = star list
 type graph = (int * int) * (ray * ray) list
 
+(* token is a couple of a family number and a star number in the constellation *)
+type token = int * int
+type process = token list
+
 (* List monad *)
 let return x = [x] (*plongement dans la monade de liste*)
 let (>>=) xs k = List.flatten (List.map k xs)
@@ -21,6 +25,11 @@ let guard c x = if c then return x else []
      Useful functions
    ======================================== *)
 
+let make_const_pol pol c = Func (c, pol, [])
+let make_const c = make_const_pol Npol c
+
+
+(* Takes a list and remove doubles from it *)
 let remove_double list =
   List.fold_left (fun l a -> if not(List.mem a l) then (a::l) else l) [] list
 
@@ -30,7 +39,7 @@ let pol_to_string pol id =
     else if pol = Neg then "-" ^ id 
     else id
 
-(* Convert a ray (which is polarized) to a term *)
+(* Convert a ray (which is polarized) to a term (which isn't)*)
 let rec ray_to_term r =
   match r with
   | Var id -> (Var(id) : term)
@@ -121,6 +130,7 @@ let rec const_to_string const =
 (*print a constellation*)
 let print_const const =
   print_string (const_to_string const)  
+
 (* ========================================
      Constellation graph
    ======================================== *)
@@ -145,6 +155,7 @@ let link_to_string dg =
     | ((i,j),(r1, r2))::t -> ("(" ^ string_of_int i ^ ", " ^ string_of_int j ^ ")" ^ "," ^ "(" ^ term_to_string (ray_to_term r1) ^ ", " ^ term_to_string (ray_to_term r2) ^ ")") ^ "+" ^ (aux t)
   in aux dg ;;
 
+(* Convert an equation list (which is a link without the index) to a string *)
 let eq_to_string eq = 
   let rec aux dgl =
     match dgl with
@@ -153,14 +164,15 @@ let eq_to_string eq =
     | ((r1, r2))::t -> ("(" ^ term_to_string (ray_to_term r1) ^ " = " ^ term_to_string (ray_to_term r2) ^ ")") ^ "\n" ^ (aux t)
   in aux eq;;
 
-
+(* print an equation list*)
 let print_eq eq =
   print_string (eq_to_string eq)
 
+(* remove empty list from a dgraph *)
 let clean_dgraph g =
   List.filter (fun a -> a <> []) g
 
-  (* Print a dgraph *)
+(* Print a dgraph *)
 let print_dgraph dg =
   let rec aux dgl =
     match dgl with
@@ -169,38 +181,10 @@ let print_dgraph dg =
     | h::t -> (link_to_string h) ^ "\n" ^ aux t 
   in print_string (aux (clean_dgraph dg));;
 
-(* _________ Examples _________ *)
-let make_const_pol pol c = Func (c, pol, [])
-let make_const c = make_const_pol Npol c
-
-let y = Var("y")
-let x = Var("x")
-let z = Var("z")
-let r = Var("r")
-let zero = make_const "0"
-let s x = Func("s", Npol, [x])
-let add p x y z = Func("add", p, [x;y;z])
-
-(* Convert int to term *)
-let rec enat i = 
-  if i = 0 then zero else s (enat (i-1))
-
-(* makes the constellation corresponding to an addition *)
-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 1 3 ;;
-
-(*print_dgraph (dgraph constellation) ;;*)
-
-(* token is a couple of a family number and a star number in the constellation *)
-type token = int * int
-type process = token list
-
-(* get a star using its number in the list from a constellation *)
+  (* get a star using its number in the list from a constellation *)
 let get_star const i =
   List.nth const i
-
+  
 (* Takes a constellation, a ray and a (ray,ray) list and extracts rays from stars number i (respectively j) that are  not ri (respectively rj) when ri (respectively rj) isn't in the prob list *)
 let star_filter const ((i, j),(ri,rj)) prob =
   let (prob_a, prob_b) = List.split prob in
@@ -215,61 +199,52 @@ let star_filter const ((i, j),(ri,rj)) prob =
 let link_to_eq prob =
   List.map (fun (ra, rb) -> (ray_to_term (inv_pol_ray ra)), ray_to_term rb) prob
 
-(* removes prob rays from stars *)
+(* removes rays from prob from the star *)
 let star_postfilter star prob =
   let (prob_a, prob_b) = List.split prob in
   List.filter (fun a -> not(List.mem a prob_a) && not(List.mem a prob_b )) star
 
 (* takes a token, a graph and a constellation and returns the list of tokens to check next and a list of solvable equation *)
-let divide_token (fam, n_star) toklist graph const prob fstar checked_stars =
+let divide_token (fam, n_star) toklist graph const prob fstar =
   let links = List.filter (fun ((i, _),(_, _)) -> i = n_star) graph in
-    let rec aux l tokl prob_aux star_aux checked_stars_aux =
+    let rec aux l tokl prob_aux star_aux =
       match l with
-        [] -> Some (tokl,prob_aux,star_aux,checked_stars_aux,fam)
+        [] -> Some (tokl,prob_aux,star_aux,fam)
         | ((i, j),(ri,rj))::tl -> 
         if fam > (List.length prob_aux) || prob_aux = [] then (* We check if the family number is the same as the number of equations lists in prob. If it's superior, we add a new list in prob instead of filling the first equation list because it means we're treating a new family *)
-          if Option.is_some (*((solve (link_to_eq [(ri, rj)])) [])*)(dual_check ri rj) then 
-            aux tl ((fam, j)::tokl) ([(ri, rj)]::prob_aux) ( (( star_filter const ((i, j),(ri,rj)) [] ))::star_aux ) (i::checked_stars_aux)
+          if Option.is_some (dual_check ri rj) then 
+            aux tl ((fam, j)::tokl) ([(ri, rj)]::prob_aux) ( (( star_filter const ((i, j),(ri,rj)) [] ))::star_aux )
           else None
         else 
           if Option.is_some (solve (link_to_eq ((ri, rj)::(List.nth prob_aux fam))) []) then (* We made sure prob_aux head would not be empty*)
-            let _ = Printf.printf "ri=%s rj=%s \n" (term_to_string (ray_to_term ri)) (term_to_string (ray_to_term rj)) in
-            aux tl ((fam, j)::tokl) (((ri, rj)::(List.hd prob_aux))::(List.tl prob_aux)) ( (( star_filter const ((i, j),(ri,rj)) (List.hd prob_aux) )@(List.hd star_aux))::(List.tl star_aux) ) (i::checked_stars_aux) (*We use List.hd because the current family we're working on should be the current first*)
+            
+            aux tl ((fam, j)::tokl) (((ri, rj)::(List.hd prob_aux))::(List.tl prob_aux)) ( (( star_filter const ((i, j),(ri,rj)) (List.hd prob_aux) )@(List.hd star_aux))::(List.tl star_aux) ) (*We use List.hd because the current family we're working on should be the current first*)
           else
-            let _ = Printf.printf "equation list= \n %s \n last added equation: \n%s = %s" (eq_to_string((ri, rj)::(List.nth prob_aux fam))) (term_to_string (ray_to_term ri)) (term_to_string (ray_to_term rj)) in
             None
-    in if links = [] then Some (toklist,prob,fstar,n_star::checked_stars,fam) 
-    else aux links toklist prob fstar checked_stars
+    in if links = [] then Some (toklist,prob,fstar,fam) 
+    else aux links toklist prob fstar
 
 (* should be deterministic exec, graph shouldn't be empty, takes a constellation and a list of stars that are gonna be beginning points *)
 (* Start_star_list, the second argument, should not be empty*)
-(* checked_stars is probabbly now be useless, to be removed*)
 let exec const start_star_list =
   let const_ext = extends_varname_const const in
   let graph = List.flatten (clean_dgraph (dgraph const_ext)) in
   let max_fam = List.length start_star_list in
-  let rec aux (toklist,prob,star,checked_stars,current_fam) = (*toklist is a list of tokens (int of family number and the number of a star), prob is the current list of equations, current_fam is the current family number  *)
+  let rec aux (toklist,prob,star,current_fam) = (*toklist is a list of tokens (int of family number and the number of a star), prob is the current list of equations, current_fam is the current family number  *)
     begin match toklist with
-      | [] -> (*let gen_token = List.filter (fun ((i,_),(_,_)) -> not( List.mem i checked_stars)) graph in *) 
+      | [] -> 
           if current_fam = max_fam-1 then star,prob 
-          else aux ([(current_fam+1, List.nth start_star_list (current_fam+1))], prob, star, checked_stars, current_fam+1)
-      | h::t -> aux (Option.get (divide_token h t graph const_ext prob star checked_stars))
+          else aux ([(current_fam+1, List.nth start_star_list (current_fam+1))], prob, star, current_fam+1)
+      | h::t -> aux (Option.get (divide_token h t graph const_ext prob star ))
     end              
-  (*in let ((i,_),(_,_)) = (List.hd graph)*)
   in if start_star_list = [] then
     failwith "star_star_list is empty"
   else  
     let i = List.hd start_star_list
-  in let (constf, prob_tmp) = aux ([(0,i)],[],[],[],0) 
+  in let (constf, prob_tmp) = aux ([(0,i)],[],[],0) 
   in let probf = List.rev prob_tmp
-  (*in let _ = Printf.printf "prob = %s \n" (eq_to_string (List.hd probf))*)
   in let indexed_final_const = index_constellation constf
   in List.map (fun (fam_star, a) -> 
     let fam_prob = List.nth probf fam_star
     in let substit_list = (List.map (fun (i,b) -> (i,term_to_ray b)) (Option.get (solve (link_to_eq fam_prob) [])))
-    in substit_star (remove_double (star_postfilter a fam_prob)) substit_list) indexed_final_const
-
-(* test constellation non-cyclique déterministe *)
-let test = [ [Func("c", Neg, [x]); x] ; [Func("c", Pos, [Func("f", Npol, [y])]) ; Func("c", Npol, [x]) ] ] ;;
-(*print_dgraph (dgraph test);;
-exec test ;;*)
+    in substit_star (remove_double (star_postfilter a fam_prob)) substit_list) indexed_final_const

ocaml/StellarCircuits.ml

@@ -1,6 +1,5 @@
-(*open Circuits
+open Circuits
 open Resolution
-*)
 (* ============================================
                Stellar Circuits
    ============================================ *)
@@ -53,9 +52,4 @@ let prop_logic : constellation = [
   [call_cor Pos (make_const "0") (make_const "1") (make_const "1")];
   [call_cor Pos (make_const "1") (make_const "0") (make_const "1")];
   [call_cor Pos (make_const "1") (make_const "1") (make_const "1")]
-]
-
-let test2 = (const_of_circuit (make_em_circ 1));;
-let testprop = ((const_of_circuit (make_em_circ 1))@[[Func("or", Pos, [Func("0", Npol, []); Func("1", Npol, []); Func("1", Npol, [])])];[Func("neg",Pos, [Func("1", Npol, []); Func("0", Npol, [])])]]);;
-
-let extest2 = exec test2 [0];;
+]

ocaml/Unification.ml

@@ -90,47 +90,3 @@ and elim id term eq sub =
   if occurs id term then (*failwith (Printf.sprintf "id=%s is in term" id)*) None (* If that's the case, we would have something like x = f(x) which can't be solved *)
   else let sigma_xy = [(id, term)] in
   solve (List.map (fun (a,b) -> (substit a sigma_xy, substit b sigma_xy)) eq) ((List.map (fun (i, t) -> (i, substit t sigma_xy)) sub)@sigma_xy) (* We apply the sigma_xy substitution to the equations and the solution list and we add it to the solution list *)
-
-  (* ========================================
-      Tests
-     ======================================== *)
-(*
-let x = Var("x")
-let v = Var("v")
-let z = Var("z")
-let y = Var("y")
-
-let f x y z = Func("f", [x; y; z]);;
-
-let terme = Func("f",[x; v; Func("g",[z; y])]) ;;
-
-let terme2 = Func("g",[z; Func("h",[x; v; y]); y]) ;;
-
-let subd = [("x", Func("Malenia",[y])); ("y", Func("Ranni",[z]))];;
-
-
-print_term terme ;;
-print_term terme2 ;;
-
-compare_term terme terme2 ;;
-compare_term terme2 terme ;;
-compare_term terme terme ;;
-
-print_term (extends_varname terme "cc") ;;
-
-occurs "x" terme ;;
-
-vars terme ;;
-apply "x" subd ;;
-print_term terme ;;
-print_term (substit terme subd) ;;
-
-let melina = Var("Melina")
-let sieg = Var("Sieg")
-let hyetta = Var("Hyetta")
-let adeline = Var("Adeline")
-
-let terme3 = Func("f",[ melina ; sieg; Func("g",[Func("h",[hyetta]); adeline])]) ;;
-
-solve [(terme,terme3)] [] ;;
-*)

ocaml/main.ml

@@ -0,0 +1,47 @@
+open Resolution
+open Circuits
+open StellarCircuits
+
+  (* ========================================
+      Tests
+     ======================================== *)
+
+(* _________ Tests on Resolution _________ *)
+let y = Var("y")
+let x = Var("x")
+let z = Var("z")
+let r = Var("r")
+let zero = make_const "0"
+let s x = Func("s", Npol, [x])
+let add p x y z = Func("add", p, [x;y;z])
+
+(* Convert int to term *)
+let rec enat i = 
+  if i = 0 then zero else s (enat (i-1))
+
+(* makes the constellation corresponding to an addition *)
+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 1 3 ;;
+
+print_dgraph (dgraph constellation) ;;
+
+(* determinist constellation test*)
+let test = [ [Func("c", Neg, [x]); x] ; [Func("c", Pos, [Func("f", Npol, [y])]) ; Func("c", Npol, [x]) ] ] ;;
+print_dgraph (dgraph test);;
+exec test ;;
+
+(* _________ Tests on exec using Stellar Circuits _________ *)
+
+(* Constellation of excluded middle without boolean doors *)
+let excl_mid_no_prop = (const_of_circuit (make_em_circ 1));;
+
+(* Constellation of excluded middle with boolean doors *)
+let excl_mid_prop = ((const_of_circuit (make_em_circ 1))@[[Func("or", Pos, [Func("0", Npol, []); Func("1", Npol, []); Func("1", Npol, [])])];[Func("neg",Pos, [Func("1", Npol, []); Func("0", Npol, [])])]]);;
+
+let exec_exmid_noprop = exec excl_mid_no_prop [0];;
+(* should return 1*)
+let exec_exmid_prop = exec excl_mid_prop [0];;
+
+print_const exec_exmid_prop;;