X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=ocaml%2Fnum.ml;h=aa9338c4c8d2d777fa45c5d0b74a85c376032dc7;hb=704fd9d9db0c01619264527d4174afe74bdff53d;hp=57cb19d068dee18d7df1cc070bc99cf448513e38;hpb=d97b1a852472085bf3449e34f3b25aee349686fd;p=fireball-separation.git

diff --git a/ocaml/num.ml b/ocaml/num.ml
index 57cb19d..aa9338c 100644
--- a/ocaml/num.ml
+++ b/ocaml/num.ml
@@ -99,19 +99,18 @@ let free_vars = (List.map fst) ++ free_vars';;
 module ToScott =
 struct
 
-let rec scott_of_nf =
- function
-  | `N n -> Scott.mk_n n
-  | `Var(v,_) -> Pure.V v
-  | `Match(t,_,liftno,bs,args) ->
-      let bs = List.map (fun (n,t) -> n, scott_of_nf (lift liftno (t :> nf))) !bs in
-      let t = scott_of_nf (t :> nf) in
-      let m = Scott.mk_match t bs in
-      List.fold_left (fun acc t -> Pure.A(acc,scott_of_nf t)) m (args :> nf list)
-  | `I((v,_), args) -> Listx.fold_left (fun acc t -> Pure.A(acc,scott_of_nf t)) (Pure.V v) (args :> nf Listx.listx)
-  | `Lam(b,f) -> Pure.L (scott_of_nf f)
-  | `Bottom -> let f x = Pure.A (x,x) in f (Pure.L (f (Pure.V 0)))
-  | `Pacman -> let f x = Pure.A (x,x) in f (Pure.L (Pure.L (f (Pure.V 0))))
+let rec scott_of_nf = function
+ | `N n -> Scott.mk_n n
+ | `Var(v,_) -> Pure.V v
+ | `Match(t,_,liftno,bs,args) ->
+ let bs = List.map (fun (n,t) -> n, scott_of_nf (lift liftno (t :> nf))) !bs in
+     let t = scott_of_nf (t :> nf) in
+     let m = Scott.mk_match t bs in
+     List.fold_left (fun acc t -> Pure.A(acc,scott_of_nf t)) m (args :> nf list)
+ | `I((v,_), args) -> Listx.fold_left (fun acc t -> Pure.A(acc,scott_of_nf t)) (Pure.V v) (args :> nf Listx.listx)
+ | `Lam(_,t) -> Pure.L (scott_of_nf t)
+ | `Bottom -> Pure.B
+ | `Pacman -> let f x = Pure.A (x,x) in f (Pure.L (Pure.L (f (Pure.V 0))))
 end
 
 
@@ -119,31 +118,36 @@ end
 
 (* 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) ->
-     "[match_"^ string_of_var v ^ (if debug_display_arities then ":"^ string_of_int ar else "") ^"_ " ^ 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;;
@@ -173,6 +177,7 @@ let cast_to_i_num_var =
     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)
@@ -245,6 +250,9 @@ and subst truelam delift_by_one what (with_what : nf(*_nob*)) (where : nf) =
    | `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
@@ -267,28 +275,6 @@ prerr_endline ("subst l:" ^ string_of_int l ^ " delift_by_one:" ^ string_of_bool
 
 (************ 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 =
@@ -309,8 +295,8 @@ 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) -> -1
+  | `Lam(_,t), `Bottom ->  1
   | `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)))
@@ -344,9 +330,9 @@ let rec eta_subterm sub t =
      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
@@ -370,6 +356,6 @@ let max_arity_tms n =
   | `Match(u,_,_,bs,args) -> max (max (aux l (u :> nf)) (aux_tms l (args :> nf list))) (aux_tms l (List.map snd !bs))
   | `N _ | `Bottom | `Pacman -> 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)
 ;;