open Util.Vars
open Pure
+(* debug options *)
+let debug_display_arities = false;;
+
(************ Syntax ************************************)
(* Normal forms*)
| `I _ as t -> "(" ^ string_of_term_no_pars_app l (t :> nf) ^ ")"
| `Lam _ as t -> "(" ^ string_of_term_no_pars_lam l t ^ ")"
| `Match(t,(v,ar),bs_lift,bs,args) ->
- "[match("^print_name l v ^ ":" ^ string_of_int ar^") " ^ 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)) !bs) ^ "] " ^
- String.concat " " (List.map (string_of_term l) args) ^ ")"
- and string_of_term_no_pars_app l = function
- | `I((n,ar), args) -> print_name l n ^ ":" ^ string_of_int ar ^ " " ^ String.concat " " (List.map (string_of_term_w_pars l) (Listx.to_list 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) ^ "] " ^
+ String.concat " " (List.map (string_of_term l) (args :> nf list)) ^ ")"
+ 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
| `Lam(_,t) -> let name = string_of_var (List.length l) in
- "λ" ^ name ^ ". " ^ (string_of_term_no_pars_lam (name::l) t)
+ "λ" ^ 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 : nf -> string = function
| `Lam _ as t -> string_of_term_no_pars_lam l t
prerr_endline (print (t :> nf));
assert false (* algorithm failed *)
-let set_arity arity = function
+let rec set_arity arity = function
| `Var(n,_) -> `Var(n,arity)
-| `Lam(false, `N _)
-| `Lam(false, `Lam _) as t -> t
-| `Lam(false, `Match(t,(n,_),bs_lift,bs,args)) -> `Lam(false, `Match(t,(n,arity),bs_lift,bs,args))
-| _ -> assert false
+| `N _ as t -> t
+| `Lam(false, t) -> `Lam(false, set_arity arity t)
+| `Match(t,(n,_),bs_lift,bs,args) -> `Match(t,(n,arity),bs_lift,bs,args)
+| `I _ | `Lam _ -> assert false
let minus1 n = if n = min_int then n else n - 1;;
| `I _ | `Var _ | `Match _ -> `Match(t,(n,ar),bs_lift,bs,args)
and subst truelam delift_by_one what (with_what : nf) (where : nf) =
- let aux_propagate_arity ar = function
- | `Lam(false,`Match(`I(v,args),(x,_),liftno,bs,args')) when not delift_by_one ->
- `Lam(false,`Match(`I(v,args),(x,ar),liftno,bs,args'))
+ let rec aux_propagate_arity ar = function
+ | `Lam(false, t) when not delift_by_one -> `Lam(false, aux_propagate_arity ar t)
+ | `Match(`I(v,args),(x,_),liftno,bs,args') when not delift_by_one ->
+ `Match(`I(v,args),(x,ar),liftno,bs,args')
| `Var(i,oldar) -> `Var(i, if truelam then (assert (oldar = min_int); ar) else oldar)
| _ as t -> t in
let rec aux_i_num_var l =
| `Match(u,ar,liftno,bs,args) ->
eta_subterm sub (u :> nf)
|| List.exists (fun (_, t) -> eta_subterm sub (lift liftno t)) !bs
- || List.exists (eta_subterm sub) args
- | `I(v, args) -> List.exists (eta_subterm sub) (Listx.to_list args) || (match sub with
- | `Var v' -> v = v'
- | `I(v', args') -> v = v'
+ || 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'
&& 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)) (Listx.to_list args'))
| _ -> false
| `Match(u,_,_,bs,args) -> max (max (aux l (u :> nf)) (aux_tms l args)) (aux_tms l (List.map snd !bs))
| `N _ -> None
and aux_tms l =
- List.fold_left (fun acc t -> Pervasives.max acc (aux l t)) None in
+ List.fold_left (fun acc t -> max acc (aux l t)) None in
fun tms -> aux_tms 0 (tms :> nf list)
;;