fun t -> match t with `Var _ -> None | x -> if arity_of_hd x <= 0 then None else hd_of x
) ((match p.div with Some t -> [(t :> i_n_var)] | _ -> []) @ p.ps)) in
(match heads with
- [] ->
- assert false
+ [] -> (
+ try
+ fst (List.find (((<) 0) ++ snd) (concat_map free_vars' (p.conv :> nf list)))
+ with
+ Not_found -> assert false
+ )
| x::_ ->
prerr_endline ("INSTANTIATING TO EAT " ^ string_of_var x);
x)
| n when n > 0 -> `Lam (false, lift 1 (make_lams t (n-1)))
| _ -> assert false
-let free_vars =
+let free_vars' =
let rec aux n = function
`N _ -> []
- | `Var(x,_) -> if x < n then [] else [x-n]
- | `I((x,_),args) ->
- (if x < n then [] else [x-n]) @
+ | `Var(x,ar) -> if x < n then [] else [(x-n,ar)]
+ | `I((x,ar),args) ->
+ (if x < n then [] else [(x-n,ar)]) @
List.concat (List.map (aux n) (Listx.to_list args))
| `Lam(_,t) -> aux (n+1) t
| `Match(t,_,liftno,bs,args) ->
List.concat (List.map (aux n) args)
in aux 0
;;
+let free_vars = (List.map fst) ++ free_vars';;
module ToScott =
struct
(* put t under n lambdas, lifting t accordingtly *)
val make_lams : nf -> int -> nf
val lift : int -> nf -> nf
+val free_vars' : nf -> var list
val free_vars : nf -> int list
module ToScott :
sig
] ["*"]
;;
+let n3 () = magic_conv
+(Some"b (k. c (c d e f)) (k. l. f (m. f) (m. f) (m. n. n))")
+[
+"b (g (k. e e)) (k. b (g (l. e e))) (g (h (k. i)) (k. e)) (f (k. f) (k. f) i) (i (k. c (c d e f)) (k. l. l) (k. g (h (l. i)) (k d) f) e) (k. l. h) (k. f (l. f) (l. f) (l. e)) (k. l. l (m. l))";
+"c d e (f i) (e e) (g e) (k. l. e) (k. c (g (k (l. i)))) (c d e (k. k))";
+"f (k. f) (k. f) (f h) (f h (c d e (f i))) (k. b) (c d e (f i) (e e) (f (k. h))) (g e (b (k. i)) (e e (e e)))";
+"f (k. f) (k. f) (k. e) (c d e (f i) (e e) (g e)) (k. e e) (k. l. m. e) (k. e)";
+"g e f (f (k. f) (f (k. f) (k. l. f)) (c d e b)) (f (k. f) (k. f) (k. l. l) b) (f (k. h)) (c d e (f i) (e e) (g e) (k. l. e)) (f (k. f) f)";
+][
+"b (g (k. e e)) (k. b (g (l. e e))) (g (h (k. i)) (k. e)) (f (k. f) (k. f) i) (i (k. c (c d e f)) (k. l. l) (k. g (h (l. i)) (k d) f) e) (k. l. h) (k. f (l. f) (l. f) (l. e)) a";
+"c d e (f i) (e e) (g e) (b (g (k. e e)) (k. c (g (h (l. i))) (l. f l))) (k. f (l. f) (l. f)) a";
+"e e (k. k d e (l. l)) (g e) (c d e b (e e (c (c d e f)))) (d (e e (k. k d e (l. l))) (k. k i)) (k. i (l. c (c d e f))) (k. h) a";
+"f (k. f) (k. f) (f h) (f h (c d e (f i))) (k. b) (f i (c d e)) (k. h) a";
+"g e f (f (k. f) (f (k. f) (k. l. f)) (c d e b)) (f (k. f) (k. f) (k. l. l) b) (f (k. h)) (c d e (f i) (e e) (g e) (k. l. e)) (f (k. f) f) (f (k. f) (k. f) (k. l. l) (c (k. i (l. c (c d e f))))) a";
+] ["*"];;
+
(* main ([p34]);; *)
main ([
m2 ;
] @ [
n1 ;
- n2
+ n2 ;
+ n3
]));;