(* let rec string_of_term l = fun _ -> "";; *)
-let rec string_of_term l =
- let rec string_of_term_w_pars l = function
- | `Var(n,ar) -> print_name l n ^ (if debug_display_arities then ":" ^ string_of_int ar else "")
+let rec string_of_term =
+ let boundvar x = "v" ^ string_of_int x in
+ let varname lev l n =
+ if n < lev then boundvar (lev-n-1)
+ else if n < List.length l then List.nth l (n-lev)
+ else "`" ^ string_of_int (n-lev) in
+ let rec string_of_term_w_pars lev l = function
+ | `Var(n,ar) -> varname lev l n ^ (if debug_display_arities then ":" ^ string_of_int ar else "")
| `N n -> string_of_int n
- | `I _ as t -> "(" ^ string_of_term_no_pars_app l t ^ ")"
+ | `I _ as t -> "(" ^ string_of_term_no_pars_app lev l t ^ ")"
| `Lam(_,`Bottom) -> "BOMB"
- | `Lam _ as t -> "(" ^ string_of_term_no_pars_lam l t ^ ")"
+ | `Lam _ as t -> "(" ^ string_of_term_no_pars_lam lev l t ^ ")"
| `Match(t,(v,ar),bs_lift,bs,args) ->
- "["^ string_of_var v ^ (if debug_display_arities then ":"^ string_of_int ar else "") ^",match " ^ string_of_term_no_pars l (t :> nf) ^
- " with " ^ String.concat " | " (List.map (fun (n,t) -> string_of_int n ^ " => " ^ string_of_term l (lift bs_lift (t :> nf))) !bs) ^ "] " ^
+ (* assert (bs_lift = lev); *)
+ "(["^ varname lev l v ^ (if debug_display_arities then ":"^ string_of_int ar else "") ^",match " ^ string_of_term_no_pars lev l (t :> nf) ^
+ " with " ^ String.concat " | " (List.map (fun (n,t) -> string_of_int n ^ " => " ^ string_of_term l (t :> nf)) !bs) ^ "] " ^
String.concat " " (List.map (string_of_term l) (args :> nf list)) ^ ")"
| `Bottom -> "BOT"
| `Pacman -> "PAC"
- and string_of_term_no_pars_app l = function
- | `I((n,ar), args) -> print_name l n ^ (if debug_display_arities then ":" ^ string_of_int ar else "") ^ " " ^ String.concat " " (List.map (string_of_term_w_pars l) (Listx.to_list args :> nf list))
- | #nf as t -> string_of_term_w_pars l t
- and string_of_term_no_pars_lam l = function
+ and string_of_term_no_pars_app lev l = function
+ | `I((n,ar), args) -> varname lev l n ^ (if debug_display_arities then ":" ^ string_of_int ar else "") ^ " " ^ String.concat " " (List.map (string_of_term_w_pars lev l) (Listx.to_list args :> nf list))
+ | #nf as t -> string_of_term_w_pars lev l t
+ and string_of_term_no_pars_lam lev l = function
| `Lam(_,`Bottom) -> "BOMB"
- | `Lam(_,t) -> let name = string_of_var (List.length l) in
- "λ" ^ name ^ ". " ^ (string_of_term_no_pars_lam (name::l) t)
- | _ as t -> string_of_term_no_pars l t
- and string_of_term_no_pars l = function
- | `Lam _ as t -> string_of_term_no_pars_lam l t
- | #nf as t -> string_of_term_no_pars_app l t
- in string_of_term_no_pars l
+ | `Lam(_,t) -> "λ" ^ boundvar lev ^ ". " ^ (string_of_term_no_pars_lam (lev+1) l t)
+ | _ as t -> string_of_term_no_pars lev l t
+ and string_of_term_no_pars lev l = function
+ | `Lam _ as t -> string_of_term_no_pars_lam lev l t
+ | #nf as t -> string_of_term_no_pars_app lev l t
+ in string_of_term_no_pars 0
;;
let print ?(l=[]) = string_of_term l;;
assert false (* algorithm failed *)
let rec set_arity arity = function
+(* FIXME because onlt variables should be in branches of matches, one day *)
| `Var(n,_) -> `Var(n,arity)
| `N _ | `Bottom | `Pacman as t -> t
| `Lam(false, t) -> `Lam(false, set_arity arity t)
| `N _ as x -> x
| `Match(t,v,bs_lift,bs,args) ->
let bs_lift = bs_lift + if delift_by_one then -1 else 0 in
+ (* Warning! It now applies again the substitution in branches of matches.
+ But careful, it does it many times, for every occurrence of
+ the match. This is okay because what does not occur in with_what. *)
let l' = l - bs_lift in
let with_what' = lift l' (with_what :> nf) in
(* The following line should be the identity when delift_by_one = true because we
(************ Parsing ************************************)
-let parse' strs =
- let fix_arity = function
- | `I((n,_),args) -> `I((n,1+Listx.length args),args)
- | _ -> assert false in
- let (tms, free) = Parser.parse_many strs in
- (* Replace pacmans and bottoms *)
- let n_bot = try Util.index_of "BOT" free with Not_found -> min_int in
- let n_pac = try Util.index_of "PAC" free with Not_found -> min_int in
- let n_bomb = try Util.index_of "BOMB" free with Not_found -> min_int in
- let fix lev v =
- if v = lev + n_bot then `Bottom
- else if v = lev + n_pac then `Pacman
- else if v = lev + n_bomb then `Lam(true, `Bottom)
- else `Var(v,1) in (* 1 by default when variable not applied *)
- (* Fix arity *)
- let rec aux lev = function
- | Parser.Lam t -> `Lam (true, aux (lev+1) t)
- | Parser.App (t1, t2) -> fix_arity (mk_app (aux lev t1) (aux lev t2))
- | Parser.Var v -> fix lev v in
- List.map (aux 0) tms, free
-;;
-
(************** Algorithm(s) ************************)
let eta_compare x y =
| `Pacman, `Pacman -> 0
| `Lam _, `N _ -> -1
| `N _, `Lam _ -> 1
- | `Bottom, `Lam _
- | `Lam _, `Bottom -> assert false (* TO BE UNDERSTOOD *)
+ | `Bottom, `Lam(_,t) -> prerr_endline "(* TO BE UNDERSTOOD *)"; aux `Bottom t
+ | `Lam(_,t), `Bottom -> prerr_endline "(* TO BE UNDERSTOOD *)"; aux t `Bottom
| `Lam(_,t1), `Lam(_,t2) -> aux t1 t2
| `Lam(_,t1), t2 -> - aux t1 (mk_app (lift 1 t2) (`Var(0,-666)))
| t2, `Lam(_,t1) -> aux t1 (mk_app (lift 1 t2) (`Var(0,-666)))
eta_subterm sub (u :> nf)
|| List.exists (fun (_, t) -> eta_subterm sub (lift liftno t)) !bs
|| List.exists (eta_subterm sub) (args :> nf list)
- | `I(v, args) -> List.exists (eta_subterm sub) ((Listx.to_list args) :> nf list) || (match sub with
- | `Var v' -> v = v'
- | `I(v', args') -> v = v'
+ | `I((v,_), args) -> List.exists (eta_subterm sub) ((Listx.to_list args) :> nf list) || (match sub with
+ | `Var(v',_) -> v = v'
+ | `I((v',_), args') -> v = v'
&& Listx.length args' < Listx.length args
&& List.for_all (fun (x,y) -> eta_eq x y) (List.combine (Util.take (Listx.length args') (Listx.to_list args :> nf list)) (Listx.to_list args' :> nf list))
| _ -> false
projects / fireball-separation.git / blobdiff