Commit c3c51c6d authored by Pietro Abate's avatar Pietro Abate

[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 =
vars = Env.add x (Stack env.stack_size) env.vars;
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)
......@@ -159,7 +159,7 @@ let compile_eval env e = [ Push (compile_expr env e); Pop ]
let compile_let_decl env decl =
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)
let compile_rec_funs env funs =
......
......@@ -275,6 +275,7 @@ let run rule ppf ppf_err input =
with exn -> catch_exn ppf_err exn; false
let topinput = run Parser.top_phrases
let script = run Parser.prog
ifdef ML_INTERFACE then
let check_ml cu id out_dir out =
......
val toplevel: 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 dump_env : Format.formatter -> unit
......
......@@ -40,8 +40,21 @@ module String : T with type t = string = struct
type t = string
let dump = Format.pp_print_string
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 serialize = Serialize.Put.string
let deserialize = Serialize.Get.string
......
......@@ -4,11 +4,13 @@
open Schema_types
open Schema_xml
(*
(** parse a schema from a PXP source *)
val parse_schema: Pxp_types.source -> schema
(** parse a schema from a PXP node *)
val schema_of_node: pxp_node -> schema
*)
(** shortand for "parse_schema (Pxp_types.from_file <fname>)" *)
val schema_of_file: string -> schema
......
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 IdMap = IdSet.Map
module Env = Map.Make(Id)
type id = Id.t
type 'a id_map = 'a IdMap.map
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
......
......@@ -27,8 +27,7 @@ and node = {
id : int;
mutable descr : descr;
accept : Types.Node.t;
fv : fv;
fv_list : id list;
fv : fv
} and descr = Types.t * fv * d
......@@ -36,7 +35,6 @@ and node = {
let id x = x.id
let descr x = x.descr
let fv x = x.fv
let fv_list x = x.fv_list
let accept x = Types.internalize x.accept
let printed = ref []
......@@ -83,9 +81,7 @@ let counter = State.ref "Patterns.counter" 0
let dummy = (Types.empty,IdSet.empty,Dummy)
let make fv =
incr counter;
{ id = !counter; descr = dummy; accept = Types.make (); fv = fv;
fv_list = fv;
}
{ id = !counter; descr = dummy; accept = Types.make (); fv = fv }
let define x ((accept,fv,_) as d) =
(* assert (x.fv = fv); *)
......@@ -146,7 +142,6 @@ module Node = struct
l := SMemo.add n.id !l;
Types.Node.serialize t n.accept;
IdSet.serialize t n.fv;
Serialize.Put.list Id.serialize t n.fv_list;
serialize_descr t n.descr
)
and serialize_descr s (_,_,d) =
......@@ -193,10 +188,8 @@ module Node = struct
with Not_found ->
let accept = Types.Node.deserialize t in
let fv = IdSet.deserialize t in
let fv_list = Serialize.Get.list Id.deserialize t in
incr counter;
let n = { id = !counter; descr = dummy; accept = accept; fv = fv;
fv_list = fv_list } in
let n = { id = !counter; descr = dummy; accept = accept; fv = fv } in
l := DMemo.add id n !l;
n.descr <- deserialize_descr t;
n
......@@ -1058,7 +1051,7 @@ struct
if Types.is_empty (Types.cap t td) then t else
Types.diff t td 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
let pl = Array.map (fun x -> [x]) (Array.of_list brs) in
......
......@@ -24,11 +24,6 @@ val constant: id -> Types.const -> descr
val id: node -> int
val descr: node -> descr
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 *)
......
......@@ -11,7 +11,7 @@ type Example = <example code=Latin1 title=Latin1>Latin1
(** Command line **)
let input =
match argv with
match argv [] with
| [ s ] -> s
| _ -> 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