Commit c3c51c6d authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-05-23 11:00:56 by afrisch] Simplify idents

Original author: afrisch
Date: 2004-05-23 11:00:57+00:00
parent b6bd8da3
...@@ -125,7 +125,7 @@ and compile_branch env tail br = ...@@ -125,7 +125,7 @@ and compile_branch env tail br =
vars = Env.add x (Stack env.stack_size) env.vars; vars = Env.add x (Stack env.stack_size) env.vars;
stack_size = env.stack_size + 1 } stack_size = env.stack_size + 1 }
) env (Patterns.fv_list br.Typed.br_pat) in ) env (Patterns.fv br.Typed.br_pat) in
(br.Typed.br_pat, compile env tail br.Typed.br_body) (br.Typed.br_pat, compile env tail br.Typed.br_body)
...@@ -159,7 +159,7 @@ let compile_eval env e = [ Push (compile_expr env e); Pop ] ...@@ -159,7 +159,7 @@ let compile_eval env e = [ Push (compile_expr env e); Pop ]
let compile_let_decl env decl = let compile_let_decl env decl =
let pat = decl.Typed.let_pat in let pat = decl.Typed.let_pat in
let (env,code) = enter_globals env (Patterns.fv_list pat) in let (env,code) = enter_globals env (Patterns.fv pat) in
(env, (Push (compile_expr env decl.Typed.let_body)) :: (Split pat) :: code) (env, (Push (compile_expr env decl.Typed.let_body)) :: (Split pat) :: code)
let compile_rec_funs env funs = let compile_rec_funs env funs =
......
...@@ -275,6 +275,7 @@ let run rule ppf ppf_err input = ...@@ -275,6 +275,7 @@ let run rule ppf ppf_err input =
with exn -> catch_exn ppf_err exn; false with exn -> catch_exn ppf_err exn; false
let topinput = run Parser.top_phrases let topinput = run Parser.top_phrases
let script = run Parser.prog
ifdef ML_INTERFACE then ifdef ML_INTERFACE then
let check_ml cu id out_dir out = let check_ml cu id out_dir out =
......
val toplevel: bool ref val toplevel: bool ref
val verbose: bool ref val verbose: bool ref
val script : Format.formatter -> Format.formatter -> char Stream.t -> bool
val topinput : Format.formatter -> Format.formatter -> char Stream.t -> bool val topinput : Format.formatter -> Format.formatter -> char Stream.t -> bool
val dump_env : Format.formatter -> unit val dump_env : Format.formatter -> unit
......
...@@ -40,8 +40,21 @@ module String : T with type t = string = struct ...@@ -40,8 +40,21 @@ module String : T with type t = string = struct
type t = string type t = string
let dump = Format.pp_print_string let dump = Format.pp_print_string
let check s = () let check s = ()
let equal : t -> t -> bool = (=)
let compare : t -> t -> int = Pervasives.compare let rec compare_string_aux s1 s2 l =
if (l == 0) then 0
else
let l = pred l in
let c1 = Char.code (String.unsafe_get s1 l)
and c2 = Char.code (String.unsafe_get s2 l) in
if c1 != c2 then c2 - c1 else compare_string_aux s1 s2 l
let compare s1 s2 =
let l1 = String.length s1 and l2 = String.length s2 in
if l1 != l2 then l2 - l1 else compare_string_aux s1 s2 l1
let equal x y = compare x y = 0
let hash = Hashtbl.hash let hash = Hashtbl.hash
let serialize = Serialize.Put.string let serialize = Serialize.Put.string
let deserialize = Serialize.Get.string let deserialize = Serialize.Get.string
......
...@@ -4,11 +4,13 @@ ...@@ -4,11 +4,13 @@
open Schema_types open Schema_types
open Schema_xml open Schema_xml
(*
(** parse a schema from a PXP source *) (** parse a schema from a PXP source *)
val parse_schema: Pxp_types.source -> schema val parse_schema: Pxp_types.source -> schema
(** parse a schema from a PXP node *) (** parse a schema from a PXP node *)
val schema_of_node: pxp_node -> schema val schema_of_node: pxp_node -> schema
*)
(** shortand for "parse_schema (Pxp_types.from_file <fname>)" *) (** shortand for "parse_schema (Pxp_types.from_file <fname>)" *)
val schema_of_file: string -> schema val schema_of_file: string -> schema
......
module U = Encodings.Utf8 module U = Encodings.Utf8
module Id = Pool.Make(U)
module IdPool = Weak.Make(U)
let id_pool = IdPool.create 17
module Id = struct
include U
let mk = IdPool.merge id_pool
let value x = x
end
type id = U.t
let ident = Id.mk
let to_string id = U.to_string (Id.value id)
let print ppf id = Format.fprintf ppf "%s" (to_string id)
module IdSet = SortedList.Make(Id) module IdSet = SortedList.Make(Id)
module IdMap = IdSet.Map module IdMap = IdSet.Map
module Env = Map.Make(Id) module Env = Map.Make(Id)
type id = Id.t
type 'a id_map = 'a IdMap.map type 'a id_map = 'a IdMap.map
type fv = IdSet.t type fv = IdSet.t
let ident = Id.mk
let to_string id =
U.to_string (Id.value id)
let print ppf id =
Format.fprintf ppf "%s" (to_string id)
module Label = Ns.QName module Label = Ns.QName
......
...@@ -27,8 +27,7 @@ and node = { ...@@ -27,8 +27,7 @@ and node = {
id : int; id : int;
mutable descr : descr; mutable descr : descr;
accept : Types.Node.t; accept : Types.Node.t;
fv : fv; fv : fv
fv_list : id list;
} and descr = Types.t * fv * d } and descr = Types.t * fv * d
...@@ -36,7 +35,6 @@ and node = { ...@@ -36,7 +35,6 @@ and node = {
let id x = x.id let id x = x.id
let descr x = x.descr let descr x = x.descr
let fv x = x.fv let fv x = x.fv
let fv_list x = x.fv_list
let accept x = Types.internalize x.accept let accept x = Types.internalize x.accept
let printed = ref [] let printed = ref []
...@@ -83,9 +81,7 @@ let counter = State.ref "Patterns.counter" 0 ...@@ -83,9 +81,7 @@ let counter = State.ref "Patterns.counter" 0
let dummy = (Types.empty,IdSet.empty,Dummy) let dummy = (Types.empty,IdSet.empty,Dummy)
let make fv = let make fv =
incr counter; incr counter;
{ id = !counter; descr = dummy; accept = Types.make (); fv = fv; { id = !counter; descr = dummy; accept = Types.make (); fv = fv }
fv_list = fv;
}
let define x ((accept,fv,_) as d) = let define x ((accept,fv,_) as d) =
(* assert (x.fv = fv); *) (* assert (x.fv = fv); *)
...@@ -146,7 +142,6 @@ module Node = struct ...@@ -146,7 +142,6 @@ module Node = struct
l := SMemo.add n.id !l; l := SMemo.add n.id !l;
Types.Node.serialize t n.accept; Types.Node.serialize t n.accept;
IdSet.serialize t n.fv; IdSet.serialize t n.fv;
Serialize.Put.list Id.serialize t n.fv_list;
serialize_descr t n.descr serialize_descr t n.descr
) )
and serialize_descr s (_,_,d) = and serialize_descr s (_,_,d) =
...@@ -193,10 +188,8 @@ module Node = struct ...@@ -193,10 +188,8 @@ module Node = struct
with Not_found -> with Not_found ->
let accept = Types.Node.deserialize t in let accept = Types.Node.deserialize t in
let fv = IdSet.deserialize t in let fv = IdSet.deserialize t in
let fv_list = Serialize.Get.list Id.deserialize t in
incr counter; incr counter;
let n = { id = !counter; descr = dummy; accept = accept; fv = fv; let n = { id = !counter; descr = dummy; accept = accept; fv = fv } in
fv_list = fv_list } in
l := DMemo.add id n !l; l := DMemo.add id n !l;
n.descr <- deserialize_descr t; n.descr <- deserialize_descr t;
n n
...@@ -1058,7 +1051,7 @@ struct ...@@ -1058,7 +1051,7 @@ struct
if Types.is_empty (Types.cap t td) then t else if Types.is_empty (Types.cap t td) then t else
Types.diff t td in*) Types.diff t td in*)
let t' = Types.diff t (Types.descr (accept p)) in let t' = Types.diff t (Types.descr (accept p)) in
(t', (p',(fv_list p, e)) :: brs) (t', (p',(fv p, e)) :: brs)
) (t,[]) brs in ) (t,[]) brs in
let pl = Array.map (fun x -> [x]) (Array.of_list brs) in let pl = Array.map (fun x -> [x]) (Array.of_list brs) in
......
...@@ -24,11 +24,6 @@ val constant: id -> Types.const -> descr ...@@ -24,11 +24,6 @@ val constant: id -> Types.const -> descr
val id: node -> int val id: node -> int
val descr: node -> descr val descr: node -> descr
val fv : node -> fv val fv : node -> fv
val fv_list : node -> id list
(* fv_list retains the original order of fv, which can
change during serialization/deserialization --> issue
with compilation *)
(* Pattern matching: static semantics *) (* Pattern matching: static semantics *)
......
...@@ -11,7 +11,7 @@ type Example = <example code=Latin1 title=Latin1>Latin1 ...@@ -11,7 +11,7 @@ type Example = <example code=Latin1 title=Latin1>Latin1
(** Command line **) (** Command line **)
let input = let input =
match argv with match argv [] with
| [ s ] -> s | [ s ] -> s
| _ -> raise "Please specify an input file on the command line" | _ -> raise "Please specify an input file on the command line"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment