Commit a699b619 authored by Pietro Abate's avatar Pietro Abate

[r2006-04-21 15:53:55 by afrisch] Compute witnesses during subtyping

Original author: afrisch
Date: 2006-04-21 15:53:56+00:00
parent b7e03bbe
......@@ -191,7 +191,8 @@ let debug ppf tenv cenv = function
Format.fprintf ppf "[DEBUG:sample]@.";
(try
let t = Types.descr (Typer.typ tenv t) in
Format.fprintf ppf "%a@." print_sample (Sample.get t)
Format.fprintf ppf "%a@." print_sample (Sample.get t);
Format.fprintf ppf "witness: %a@." Types.print_witness (Types.witness t);
with Not_found ->
Format.fprintf ppf "Empty type : no sample !@.")
| `Filter (t,p) ->
......
......@@ -95,3 +95,12 @@ let mk_map l =
let mtags = Imap.create (Array.of_list !all_tags) in
let mns = Imap.create (Array.of_list !all_ns) in
(mtags,mns,!def)
type sample = (Ns.Uri.t * Ns.Label.t option) option
let contains_sample s t =
match s,(get t) with
| None, `Cofinite _ -> true
| None, `Finite _ -> false
| Some (_,Some tag),_ -> contains tag t
| Some (ns, None),_ -> is_empty (diff (any_in_ns ns) t)
......@@ -32,6 +32,10 @@ val print_tag : t -> (Format.formatter -> unit) option
val single : t -> V.t
type sample = (Ns.Uri.t * Ns.Label.t option) option
val sample : t -> sample
val contains_sample: sample -> t -> bool
type 'a map
val mk_map: (t * 'a) list -> 'a map
val get_map: V.t -> 'a map -> 'a
......
......@@ -45,7 +45,7 @@ let mapping f t queue =
let aux_concat = mapping (fun t v -> V.times (V.ty t) v)
let aux_flatten t = mapping aux_concat t (V.ty nil_type)
let aux_map f t =
let f = memoize f in
let f = memoize f in
mapping (fun t v -> V.times (V.ty (f t)) v) t (V.ty nil_type)
let solve x = Types.descr (V.solve x)
......
......@@ -410,6 +410,7 @@ module type FiniteCofinite = sig
val contains: elem -> t -> bool
val disjoint: t -> t -> bool
val is_empty: t -> bool
val sample: t -> elem option
end
module FiniteCofinite(X : Custom.T) = struct
......@@ -438,6 +439,11 @@ module FiniteCofinite(X : Custom.T) = struct
| Finite s -> Format.fprintf ppf "Finite[%a]" SList.dump s
| Cofinite s -> Format.fprintf ppf "Cofinite[%a]" SList.dump s
let sample = function
| Finite (x::_) -> Some x
| Finite [] -> raise Not_found
| Cofinite _ -> None
let empty = Finite []
let any = Cofinite []
......@@ -491,6 +497,12 @@ struct
module T = T0.Map
type t = Finite of TMap.t | Cofinite of TMap.t
let sample = function
| Cofinite _ -> None
| Finite l -> (match T.get l with
| [] -> raise Not_found
| (x,y)::_ -> Some (x, SymbolSet.sample y))
let get = function
| Finite l -> `Finite (T.get l)
| Cofinite l -> `Cofinite (T.get l)
......
......@@ -91,6 +91,8 @@ module type FiniteCofinite = sig
val contains: elem -> t -> bool
val disjoint: t -> t -> bool
val is_empty: t -> bool
val sample: t -> elem option
end
module FiniteCofinite(X : Custom.T) : FiniteCofinite with type elem = X.t
......@@ -114,4 +116,7 @@ sig
val get: t -> [ `Finite of (X.t * SymbolSet.t) list
| `Cofinite of (X.t * SymbolSet.t) list ]
val sample: t -> (X.t * SymbolSet.elem option) option
end
This diff is collapsed.
......@@ -277,3 +277,14 @@ sig
end
type witness
val witness: t -> witness
val print_witness: Format.formatter -> witness -> unit
module Cache: sig
type 'a cache
val emp: 'a cache
val find: (t -> 'a) -> t -> 'a cache -> 'a cache * 'a
val memo: (t -> 'a) -> (t -> 'a)
end
......@@ -33,10 +33,13 @@ let [<site>[ <title>site
(<footer>footer | /(footer:=[]))
extra_head::H.script*
main_page ] ] =
(* match load_include input with
[ Site ] & x -> x
| _ -> exit 2 *)
try (load_include input :? [ Site ])
with err & Latin1 ->
print ['Invalid input document:\n' !err '\n'];
exit 2
exit 2
(* Highlighting text between {{...}} *)
......
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