X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_notation%2FcicNotationUtil.ml;h=964c303ee91dbc27d646c191197a71b7193bfe77;hb=12cc5b2b8e7f7bb0b5e315094b008a293a4df6b1;hp=18e04640a48658bc0ab970dedebe94ec7e0f54b3;hpb=50377dde5b5b1a8e5c7b2fb48b47defde9508b50;p=helm.git diff --git a/helm/ocaml/cic_notation/cicNotationUtil.ml b/helm/ocaml/cic_notation/cicNotationUtil.ml index 18e04640a..964c303ee 100644 --- a/helm/ocaml/cic_notation/cicNotationUtil.ml +++ b/helm/ocaml/cic_notation/cicNotationUtil.ml @@ -161,7 +161,7 @@ let visit_layout k = function | Frac (t1, t2) -> Frac (k t1, k t2) | Sqrt t -> Sqrt (k t) | Root (arg, index) -> Root (k arg, k index) - | Break -> Break +(* | Break -> Break *) | Box (kind, terms) -> Box (kind, List.map k terms) let visit_magic k = function @@ -214,3 +214,100 @@ let rec strip_attributes t = in visit_ast ~special_k strip_attributes t +let meta_names_of_term term = + let rec names = ref [] in + let add_name n = + if List.mem n !names then () + else names := n :: !names + in + let rec aux = function + | AttributedTerm (_, term) -> aux term + | Appl terms -> List.iter aux terms + | Binder (_, _, body) -> aux body + | Case (term, indty, outty_opt, patterns) -> + aux term ; + aux_opt outty_opt ; + List.iter aux_branch patterns + | LetIn (_, t1, t2) -> + aux t1 ; + aux t2 + | LetRec (_, definitions, body) -> + List.iter aux_definition definitions ; + aux body + | Uri (_, Some substs) -> aux_substs substs + | Ident (_, Some substs) -> aux_substs substs + | Meta (_, substs) -> aux_meta_substs substs + + | Implicit + | Ident _ + | Num _ + | Sort _ + | Symbol _ + | Uri _ + | UserInput -> () + + | Magic magic -> aux_magic magic + | Variable var -> aux_variable var + + | _ -> assert false + and aux_opt = function + | Some term -> aux term + | None -> () + and aux_capture_var (_, ty_opt) = aux_opt ty_opt + and aux_branch (pattern, term) = + aux_pattern pattern ; + aux term + and aux_pattern (head, vars) = + List.iter aux_capture_var vars + and aux_definition (var, term, i) = + aux_capture_var var ; + aux term + and aux_substs substs = List.iter (fun (_, term) -> aux term) substs + and aux_meta_substs meta_substs = List.iter aux_opt meta_substs + and aux_variable = function + | NumVar name -> add_name name + | IdentVar name -> add_name name + | TermVar name -> add_name name + | FreshVar _ -> () + | Ascription _ -> assert false + and aux_magic = function + | Default (t1, t2) + | Fold (_, t1, _, t2) -> + aux t1 ; + aux t2 + | _ -> assert false + in + aux term ; + !names + +let rectangular matrix = + let columns = Array.length matrix.(0) in + try + Array.iter (fun a -> if Array.length a <> columns then raise Exit) matrix; + true + with Exit -> false + +let ncombine ll = + let matrix = Array.of_list (List.map Array.of_list ll) in + assert (rectangular matrix); + let rows = Array.length matrix in + let columns = Array.length matrix.(0) in + let lists = ref [] in + for j = 0 to columns - 1 do + let l = ref [] in + for i = 0 to rows - 1 do + l := matrix.(i).(j) :: !l + done; + lists := List.rev !l :: !lists + done; + List.rev !lists + +let string_of_literal = function + | `Symbol s + | `Keyword s + | `Number s -> s + +let boxify = function + | [ a ] -> a + | l -> Layout (Box ((H, false, false), l)) +