(*********************************************************************)
(*                                                                   *)
(*                         terminaison par LPO                       *)
(*                                                                   *)
(*                          Jean-Yves Moyen                          *)
(*                              Mars 2001                            *)
(*                                                                   *)
(*********************************************************************)

open Langage
open Ordering

let rec lexico comp l1 l2 = (*extension lexicographique*)
  match l1,l2 with
      [],[] -> 0
    | [],_ -> -1
    | _,[] -> 1
    | (a1::r1),(a2::r2) ->
	let b=comp a1 a2 in
	  if b=0
	  then lexico comp r1 r2
	  else b
    
let rec lpo mapf t1 t2 =
  if t1=t2 
  then 0
  else
    match t1,t2 with
	(Var x),(Var y) -> if x=y then 0 else raise Incomparables
      | (Var x),_ -> if subterm t1 t2 then -1 else raise Incomparables
      | (Con(c1,tl1)),(Con(c2,tl2)) ->
	  if  subterm t1 t2 then -1
	  else 
	    if subterm t2 t1 then 1 
	    else raise Incomparables
      | (Con(c1,tl1)),(Fun(f2,tl2)) ->
	  if List.for_all (fun t->(lpo mapf t t2)= ~-1) tl1 then -1
	  else 
	    if List.exists (subterm t2) tl1 then 1
	    else raise Incomparables
      | (Fun(f1,tl1)),(Fun(f2,tl2)) ->
	  (match prec mapf f1 f2 with
	       -1 -> ~-(all_same 1 (List.map (lpo mapf t2) tl1))
	     | 0 -> 
		 let b = lexico (lpo mapf) tl1 tl2 in
		   (match b with
			-1 -> ~-(all_same 1 (List.map (lpo mapf t2) tl1))
		      | 0 -> 0
		      | 1 -> all_same 1 (List.map (lpo mapf t1) tl2)
		      | _ -> failwith "grou ?")
	     | 1 -> (all_same 1 (List.map (lpo mapf t1) tl2))
	     | _ -> failwith "grou ?")
      | _ -> ~-(lpo mapf t2 t1)	  

	  
let is_lpo_eq = is_ord_eq lpo

let is_lpo = is_ord lpo

let lpo_prg prg = is_lpo prg

let chklpo s=
  lpo_prg (Parser.prog Lexer.token (Lexing.from_string s))
	
