Commit d82aa4fb authored by Pietro Abate's avatar Pietro Abate

[r2005-05-07 20:13:53 by afrisch] Simplification

Original author: afrisch
Date: 2005-05-07 20:13:54+00:00
parent 9c9b2bde
......@@ -142,7 +142,8 @@ OBJECTS = \
driver/config.cmo \
misc/stats.cmo \
misc/serialize.cmo misc/custom.cmo \
misc/state.cmo misc/pool.cmo misc/encodings.cmo misc/bool.cmo \
misc/state.cmo misc/pool.cmo misc/encodings.cmo misc/myweak.cmo \
misc/bool.cmo \
misc/pretty.cmo misc/ns.cmo misc/inttbl.cmo misc/imap.cmo \
misc/html.cmo \
\
......
......@@ -14,8 +14,14 @@ misc/pool.cmx: misc/state.cmx misc/serialize.cmx misc/custom.cmx \
misc/pool.cmi
misc/encodings.cmo: misc/serialize.cmi misc/custom.cmo misc/encodings.cmi
misc/encodings.cmx: misc/serialize.cmx misc/custom.cmx misc/encodings.cmi
misc/bool.cmo: misc/serialize.cmi misc/custom.cmo misc/bool.cmi
misc/bool.cmx: misc/serialize.cmx misc/custom.cmx misc/bool.cmi
misc/myweak.cmo: misc/myweak.cmi
misc/myweak.cmx: misc/myweak.cmi
misc/memo.cmo: misc/memo.cmi
misc/memo.cmx: misc/memo.cmi
misc/bool.cmo: misc/serialize.cmi misc/myweak.cmi misc/memo.cmi \
misc/custom.cmo misc/bool.cmi
misc/bool.cmx: misc/serialize.cmx misc/myweak.cmx misc/memo.cmx \
misc/custom.cmx misc/bool.cmi
misc/pretty.cmo: misc/pretty.cmi
misc/pretty.cmx: misc/pretty.cmi
misc/ns.cmo: misc/state.cmi misc/serialize.cmi misc/pool.cmi \
......@@ -115,9 +121,9 @@ typing/typed.cmo: types/types.cmi types/patterns.cmi misc/ns.cmi \
typing/typed.cmx: types/types.cmx types/patterns.cmx misc/ns.cmx \
parser/location.cmx types/ident.cmx
typing/typepat.cmo: types/types.cmi types/sequence.cmi types/patterns.cmi \
parser/location.cmi types/ident.cmo types/chars.cmi typing/typepat.cmi
types/ident.cmo types/chars.cmi typing/typepat.cmi
typing/typepat.cmx: types/types.cmx types/sequence.cmx types/patterns.cmx \
parser/location.cmx types/ident.cmx types/chars.cmx typing/typepat.cmi
types/ident.cmx types/chars.cmx typing/typepat.cmi
typing/typer.cmo: types/types.cmi typing/typepat.cmi typing/typed.cmo \
misc/serialize.cmi types/sequence.cmi types/patterns.cmi misc/ns.cmi \
parser/location.cmi types/ident.cmo misc/html.cmi types/externals.cmi \
......@@ -173,14 +179,14 @@ schema/schema_parser.cmx: parser/url.cmx schema/schema_xml.cmx \
schema/schema_pcre.cmx schema/schema_common.cmx schema/schema_builtin.cmx \
misc/ns.cmx misc/encodings.cmx types/atoms.cmx schema/schema_parser.cmi
schema/schema_converter.cmo: runtime/value.cmi types/types.cmi \
typing/typer.cmi types/sequence.cmi schema/schema_xml.cmi \
schema/schema_validator.cmi schema/schema_types.cmi \
typing/typer.cmi typing/typepat.cmi types/sequence.cmi \
schema/schema_xml.cmi schema/schema_validator.cmi schema/schema_types.cmi \
schema/schema_parser.cmi schema/schema_common.cmi \
schema/schema_builtin.cmi misc/ns.cmi types/ident.cmo misc/encodings.cmi \
types/builtin_defs.cmi types/atoms.cmi
schema/schema_converter.cmx: runtime/value.cmx types/types.cmx \
typing/typer.cmx types/sequence.cmx schema/schema_xml.cmx \
schema/schema_validator.cmx schema/schema_types.cmx \
typing/typer.cmx typing/typepat.cmx types/sequence.cmx \
schema/schema_xml.cmx schema/schema_validator.cmx schema/schema_types.cmx \
schema/schema_parser.cmx schema/schema_common.cmx \
schema/schema_builtin.cmx misc/ns.cmx types/ident.cmx misc/encodings.cmx \
types/builtin_defs.cmx types/atoms.cmx
......@@ -284,14 +290,6 @@ ocamliface/mlstub.cmx: types/types.cmx typing/typer.cmx types/sequence.cmx \
driver/librarian.cmx types/ident.cmx types/externals.cmx \
driver/config.cmx compile/compile.cmx types/builtin_defs.cmx \
types/atoms.cmx ocamliface/mlstub.cmi
parser/cduce_curl.cmo: parser/url.cmi driver/config.cmi
parser/cduce_curl.cmx: parser/url.cmx driver/config.cmx
runtime/cduce_pxp.cmo: parser/url.cmi schema/schema_xml.cmi \
parser/location.cmi runtime/load_xml.cmi driver/config.cmi \
runtime/cduce_pxp.cmi
runtime/cduce_pxp.cmx: parser/url.cmx schema/schema_xml.cmx \
parser/location.cmx runtime/load_xml.cmx driver/config.cmx \
runtime/cduce_pxp.cmi
runtime/cduce_expat.cmo: parser/url.cmi schema/schema_xml.cmi \
parser/location.cmi runtime/load_xml.cmi driver/config.cmi \
runtime/cduce_expat.cmi
......@@ -380,6 +378,7 @@ runtime/value.cmi: types/types.cmi misc/ns.cmi compile/lambda.cmi \
parser/location.cmi: misc/html.cmi
parser/parser.cmi: parser/ast.cmo
types/externals.cmi: types/types.cmi
typing/typepat.cmi: types/types.cmi types/patterns.cmi types/ident.cmo
typing/typer.cmi: runtime/value.cmi types/types.cmi typing/typed.cmo \
misc/serialize.cmi types/patterns.cmi misc/ns.cmi parser/location.cmi \
types/ident.cmo parser/ast.cmo
......
This diff is collapsed.
......@@ -18,13 +18,27 @@ sig
-> cap:('b -> 'b -> 'b) -> diff:('b -> 'b -> 'b) ->
atom:(elem -> 'b) -> t -> 'b
(*
val print: string -> (Format.formatter -> elem -> unit) -> t ->
(Format.formatter -> unit) list
*)
val trivially_disjoint : t -> t -> bool
end
module MakeOld(X : Custom.T) : S with type elem = X.t
module Make(X : Custom.T) : S with type elem = X.t
module type MAKE = functor (X : Custom.T) -> S with type elem = X.t
module Make : MAKE
module type S' = sig
include S
type bdd = False | True | Br of elem * t * t
val br: t -> bdd
end
module MakeBdd(X : Custom.T) : S' with type elem = X.t
module Simplify(B : MAKE) : MAKE
......@@ -161,6 +161,36 @@ module Pair(X : T)(Y : T) = struct
let deserialize t = Serialize.Get.pair X.deserialize Y.deserialize t
end
type ('a,'b) choice = Left of 'a | Right of 'b
module Sum(X : T)(Y : T) = struct
type t = (X.t,Y.t) choice
let equal t1 t2 =
match t1,t2 with
| Left t1, Left t2 -> X.equal t1 t2
| Right t1, Right t2 -> Y.equal t1 t2
| _ -> false
let hash = function
| Left t1 -> 1 + 3 * X.hash t1
| Right t2 -> 2 + 3 * Y.hash t2
let compare t1 t2 =
match t1,t2 with
| Left t1, Left t2 -> X.compare t1 t2
| Right t1, Right t2 -> Y.compare t1 t2
| Left _, Right _ -> -1
| Right _, Left _ -> 1
let check t = ()
let dump ppf = function
| Left t -> Format.fprintf ppf "L%a" X.dump t
| Right t -> Format.fprintf ppf "R%a" Y.dump t
let serialize s = function
| Left t -> Serialize.Put.bool s true; X.serialize s t
| Right t -> Serialize.Put.bool s false; Y.serialize s t
let deserialize s =
if Serialize.Get.bool s
then Left (X.deserialize s) else Right (Y.deserialize s)
end
module type Proxy = sig
include T
......
......@@ -484,10 +484,10 @@ end
(* It is also possible to use Boolean instead of Bool here;
need to analyze when each one is more efficient *)
and BoolPair : Bool.S with type elem = Node.t * Node.t =
Bool.Make(Custom.Pair(NodeT)(NodeT))
Bool.Simplify(Bool.Make)(Custom.Pair(NodeT)(NodeT))
and BoolRec : Bool.S with type elem = bool * Node.t label_map =
Bool.Make(Custom.Pair(Custom.Bool)(LabelSet.MakeMap(NodeT)))
(*Bool.Simplify*)(Bool.Make)(Custom.Pair(Custom.Bool)(LabelSet.MakeMap(NodeT)))
module DescrHash = Hashtbl.Make(Descr)
module DescrMap = Map.Make(Descr)
......@@ -503,22 +503,32 @@ let clear_deserialize_table = Node.clear_deserialize_table
let forward_print = ref (fun _ _ -> assert false)
let hash_cons = DescrHash.create 17000
let make () =
incr count;
Node.mk !count empty
(*
let hash_cons = DescrHash.create 17000
let define n d =
DescrHash.add hash_cons d n;
n.Node.descr <- d
let cons d =
try DescrHash.find hash_cons d
with Not_found ->
incr count;
let n = Node.mk !count d in
DescrHash.add hash_cons d n; n
*)
let define n d =
n.Node.descr <- d
let cons d =
incr count;
Node.mk !count d
let any = {
hash = 0;
......@@ -764,7 +774,7 @@ let guard a f n =
module ClearlyEmpty =
struct
let memo = DescrHash.create 33000
let memo = DescrHash.create 8191
let marks = ref []
let rec slot d =
......@@ -859,7 +869,7 @@ let clearly_disjoint t1 t2 =
(* TODO: need to invesigate when ClearEmpty is a good thing... *)
let memo = DescrHash.create 33000
let memo = DescrHash.create 8191
let marks = ref []
let count_subtype = Stats.Counter.create "Subtyping internal loop"
......
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