1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6(* *) 7(* Copyright 1996 Institut National de Recherche en Informatique et *) 8(* en Automatique. *) 9(* *) 10(* All rights reserved. This file is distributed under the terms of *) 11(* the GNU Lesser General Public License version 2.1, with the *) 12(* special exception on linking described in the file LICENSE. *) 13(* *) 14(**************************************************************************) 15 16type t = 17 Pident of Ident.t 18 | Pdot of t * string * int 19 | Papply of t * t 20 21let nopos = -1 22 23let rec same p1 p2 = 24 match (p1, p2) with 25 (Pident id1, Pident id2) -> Ident.same id1 id2 26 | (Pdot(p1, s1, _pos1), Pdot(p2, s2, _pos2)) -> s1 = s2 && same p1 p2 27 | (Papply(fun1, arg1), Papply(fun2, arg2)) -> 28 same fun1 fun2 && same arg1 arg2 29 | (_, _) -> false 30 31let rec compare p1 p2 = 32 match (p1, p2) with 33 (Pident id1, Pident id2) -> Ident.compare id1 id2 34 | (Pdot(p1, s1, _pos1), Pdot(p2, s2, _pos2)) -> 35 let h = compare p1 p2 in 36 if h <> 0 then h else String.compare s1 s2 37 | (Papply(fun1, arg1), Papply(fun2, arg2)) -> 38 let h = compare fun1 fun2 in 39 if h <> 0 then h else compare arg1 arg2 40 | ((Pident _ | Pdot _), (Pdot _ | Papply _)) -> -1 41 | ((Pdot _ | Papply _), (Pident _ | Pdot _)) -> 1 42 43let rec isfree id = function 44 Pident id' -> Ident.same id id' 45 | Pdot(p, _s, _pos) -> isfree id p 46 | Papply(p1, p2) -> isfree id p1 || isfree id p2 47 48let rec binding_time = function 49 Pident id -> Ident.binding_time id 50 | Pdot(p, _s, _pos) -> binding_time p 51 | Papply(p1, p2) -> max (binding_time p1) (binding_time p2) 52 53let kfalse _ = false 54 55let rec name ?(paren=kfalse) = function 56 Pident id -> Ident.name id 57 | Pdot(p, s, _pos) -> 58 name ~paren p ^ if paren s then ".( " ^ s ^ " )" else "." ^ s 59 | Papply(p1, p2) -> name ~paren p1 ^ "(" ^ name ~paren p2 ^ ")" 60 61let rec head = function 62 Pident id -> id 63 | Pdot(p, _s, _pos) -> head p 64 | Papply _ -> assert false 65 66let heads p = 67 let rec heads p acc = match p with 68 | Pident id -> id :: acc 69 | Pdot (p, _s, _pos) -> heads p acc 70 | Papply(p1, p2) -> 71 heads p1 (heads p2 acc) 72 in heads p [] 73 74let rec last = function 75 | Pident id -> Ident.name id 76 | Pdot(_, s, _) -> s 77 | Papply(_, p) -> last p 78 79let is_uident s = 80 assert (s <> ""); 81 match s.[0] with 82 | 'A'..'Z' -> true 83 | _ -> false 84 85type typath = 86 | Regular of t 87 | Ext of t * string 88 | LocalExt of Ident.t 89 | Cstr of t * string 90 91let constructor_typath = function 92 | Pident id when is_uident (Ident.name id) -> LocalExt id 93 | Pdot(ty_path, s, _) when is_uident s -> 94 if is_uident (last ty_path) then Ext (ty_path, s) 95 else Cstr (ty_path, s) 96 | p -> Regular p 97 98let is_constructor_typath p = 99 match constructor_typath p with 100 | Regular _ -> false 101 | _ -> true 102