Skip to content

GitLab

Commit 097b5407 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-02-21 07:15:03 by afrisch] Empty log message 

Original author: afrisch
Date: 2005-02-21 07:15:04+00:00
parent 4059b145
Hide whitespace changes
Inline Side-by-side
Showing with 169 additions and 75 deletions
misc/stats.ml
View file @ 097b5407
......@@ -60,3 +60,34 @@ module Counter = struct
let incr c =
c.count <- c.count + 1
end
module InOut = struct
let h = Hashtbl.create 17
let enter s =
let i = try Hashtbl.find h s with Not_found ->
let r = ref 0 in
Hashtbl.add h s r;
r in
incr i;
Printf.printf "+%s[%i] " s !i;
flush stdout
let leave s =
let i = try Hashtbl.find h s with Not_found -> assert false in
decr i;
Printf.printf "-%s[%i] " s !i;
flush stdout
let wrap s f x =
enter s;
try
let r = f x in
leave s;
r
with exn ->
leave s;
raise exn
end
misc/stats.mli
View file @ 097b5407
......@@ -20,3 +20,10 @@ module Timer: sig
val stop: t -> 'a -> 'a
val print: Format.formatter -> t -> unit
end
module InOut: sig
val enter: string -> unit
val leave: string -> unit
val wrap: string -> ('a -> 'b) -> 'a -> 'b
end
schema/schema_common.ml
View file @ 097b5407
......@@ -214,7 +214,7 @@ let print_element fmt { elt_uid = id; elt_name = name } =
let print_attributes fmt = List.iter (Format.fprintf fmt "%a" print_attribute)
let print_attribute_group fmt ag =
Format.fprintf fmt "{agroup:%a}" Ns.QName.print ag.ag_name
let print_model_group fmt mg =
let print_model_group_def fmt mg =
Format.fprintf fmt "{mgroup:%a}" Ns.QName.print mg.mg_name
let print_schema fmt schema =
let defined_types = (* filter out built-in types *)
......@@ -248,7 +248,7 @@ let print_schema fmt schema =
end;
if schema.model_groups <> [] then begin
Format.fprintf fmt "Model groups: ";
List.iter (fun c -> print_model_group fmt c; Format.fprintf fmt " ")
List.iter (fun c -> print_model_group_def fmt c; Format.fprintf fmt " ")
schema.model_groups;
Format.fprintf fmt "\n"
end
......@@ -421,3 +421,17 @@ let test v =
aux ()
*)
let rec print_model_group ppf = function
| All pl -> Format.fprintf ppf "All(%a)" print_particle_list pl
| Choice pl -> Format.fprintf ppf "Choice(%a)" print_particle_list pl
| Sequence pl -> Format.fprintf ppf "Sequence(%a)" print_particle_list pl
and print_particle_list ppf = function
| [] -> ()
| [p] -> print_particle ppf p
| hd::tl -> Format.fprintf ppf "%a;%a" print_particle hd print_particle_list tl
and print_particle ppf (min,max,term,_) =
print_term ppf term
and print_term ppf = function
| Elt e -> Format.fprintf ppf "E%i" ((Lazy.force e).elt_uid)
| Model m -> print_model_group ppf m
schema/schema_common.mli
View file @ 097b5407
......@@ -17,7 +17,7 @@ val print_attribute : Format.formatter -> attribute_declaration -> unit
val print_element : Format.formatter -> element_declaration -> unit
val print_attribute_group :
Format.formatter -> attribute_group_definition -> unit
val print_model_group : Format.formatter -> model_group_definition -> unit
val print_model_group_def : Format.formatter -> model_group_definition -> unit
val print_simple_type : Format.formatter -> simple_type_definition -> unit
val print_complex_type : Format.formatter -> complex_type_definition -> unit
......@@ -93,3 +93,7 @@ val normalize_white_space: white_space_handling -> Utf8.t -> Utf8.t
val stream_of_value: Value.t -> event Stream.t
val string_of_event: event -> string
val print_model_group: Format.formatter -> model_group -> unit
val print_particle: Format.formatter -> particle -> unit
typing/typer.ml
View file @ 097b5407
......@@ -8,6 +8,12 @@ open Location
open Ast
open Ident
let (=) (x:int) y = x = y
let (<=) (x:int) y = x <= y
let (<) (x:int) y = x < y
let (>=) (x:int) y = x >= y
let (>) (x:int) y = x > y
let debug_schema = false
let warning loc msg =
......@@ -274,7 +280,7 @@ type derecurs_slot = {
} and derecurs =
| PDummy
| PAlias of derecurs_slot
| PType of Types.descr
| PType of Types.descr * int
| POr of derecurs * derecurs
| PAnd of derecurs * derecurs
| PDiff of derecurs * derecurs
......@@ -295,9 +301,34 @@ and derecurs_regexp =
| PStar of derecurs_regexp
| PWeakStar of derecurs_regexp
let rec print_derecurs ppf = function
| PDummy -> Format.fprintf ppf "Dummy"
| PAlias a -> Format.fprintf ppf "Alias %i" a.pid
| PType _ -> Format.fprintf ppf "Type"
| POr (r1,r2) -> Format.fprintf ppf "Or(%a,%a)"
print_derecurs r1 print_derecurs r2
| PAnd (r1,r2) -> Format.fprintf ppf "And(%a,%a)"
print_derecurs r1 print_derecurs r2
| PDiff (r1,r2) -> Format.fprintf ppf "Diff(%a,%a)"
print_derecurs r1 print_derecurs r2
| PTimes (r1,r2) -> Format.fprintf ppf "Times(%a,%a)"
print_derecurs r1 print_derecurs r2
| PXml (r1,r2) -> Format.fprintf ppf "Xml(%a,%a)"
print_derecurs r1 print_derecurs r2
| PRegexp r -> Format.fprintf ppf "Regexp(%a)" print_regexp r
| _ -> Format.fprintf ppf "Other"
and print_regexp ppf = function
| PEpsilon -> Format.fprintf ppf "e"
| PElem r -> Format.fprintf ppf "(%a)" print_derecurs r
| PGuard r -> Format.fprintf ppf "/(%a)" print_derecurs r
| PSeq (r1,r2) -> Format.fprintf ppf "%a,%a" print_regexp r1 print_regexp r2
| PAlt (r1,r2) -> Format.fprintf ppf "%a|%a" print_regexp r1 print_regexp r2
| PStar r | PWeakStar r -> Format.fprintf ppf "%a*" print_regexp r
type descr =
| IDummy
| IType of Types.descr
| IType of Types.descr * int
| IOr of descr * descr
| IAnd of descr * descr
| IDiff of descr * descr
......@@ -338,8 +369,8 @@ let rec hash_derecurs = function
| PDummy -> assert false
| PAlias s ->
s.pid
| PType t ->
1 + 17 * (Types.hash t)
| PType (t,hash) ->
1 + 17 * hash
| POr (p1,p2) ->
2 + 17 * (hash_derecurs p1) + 257 * (hash_derecurs p2)
| PAnd (p1,p2) ->
......@@ -384,8 +415,8 @@ and hash_derecurs_regexp = function
let rec equal_derecurs p1 p2 = (p1 == p2) || match p1,p2 with
| PAlias s1, PAlias s2 ->
s1 == s2
| PType t1, PType t2 ->
Types.equal t1 t2
| PType (t1,h1), PType (t2,h2) ->
(h1 == h2) && (Types.equal t1 t2)
| POr (p1,q1), POr (p2,q2)
| PAnd (p1,q1), PAnd (p2,q2)
| PDiff (p1,q1), PDiff (p2,q2)
......@@ -436,7 +467,7 @@ let rank = ref 0
let rec hash_descr = function
| IDummy -> assert false
| IType x -> Types.hash x
| IType (t,h) -> h
| IOr (d1,d2) -> 1 + 17 * (hash_descr d1) + 257 * (hash_descr d2)
| IAnd (d1,d2) -> 2 + 17 * (hash_descr d1) + 257 * (hash_descr d2)
| IDiff (d1,d2) -> 3 + 17 * (hash_descr d1) + 257 * (hash_descr d2)
......@@ -460,7 +491,7 @@ and hash_slot s =
let rec equal_descr d1 d2 =
match (d1,d2) with
| IType x1, IType x2 -> Types.equal x1 x2
| IType (x1,h1), IType (x2,h2) -> (h1 == h2) && (Types.equal x1 x2)
| IOr (x1,y1), IOr (x2,y2)
| IAnd (x1,y1), IAnd (x2,y2)
| IDiff (x1,y1), IDiff (x2,y2) -> (equal_descr x1 x2) && (equal_descr y1 y2)
......@@ -469,7 +500,7 @@ let rec equal_descr d1 d2 =
| IXml (x1,y1), IXml (x2,y2)
| IArrow (x1,y1), IArrow (x2,y2) -> (equal_slot x1 x2) && (equal_slot y1 y2)
| IRecord (o1,r1), IRecord (o2,r2) ->
(o1 = o2) && (LabelMap.equal equal_descr_field r1 r2)
(o1 == o2) && (LabelMap.equal equal_descr_field r1 r2)
| ICapture x1, ICapture x2 -> Id.equal x1 x2
| IConstant (x1,y1), IConstant (x2,y2) ->
(Id.equal x1 x2) && (Types.Const.equal y1 y2)
......@@ -509,8 +540,9 @@ module SlotTable = Hashtbl.Make(
e)
end)
let ptype t = PType (t, Types.hash t)
let pempty = PType Types.empty
let pempty = ptype Types.empty
let por p1 p2 =
if p1 == pempty then p2 else
......@@ -578,10 +610,10 @@ let rec derecurs env p = match p.descr with
| PatVar v -> derecurs_var env p.loc v
| SchemaVar (kind, schema_name, component_name) ->
let name = qname env.penv_tenv p.loc component_name in
PType (find_schema_descr env.penv_tenv kind schema_name name)
ptype (find_schema_descr env.penv_tenv kind schema_name name)
| Recurs (p,b) -> derecurs (derecurs_def env b) p
| Internal t -> PType t
| NsT ns -> PType (Types.atom (Atoms.any_in_ns (parse_ns env.penv_tenv p.loc ns)))
| Internal t -> ptype t
| NsT ns -> ptype (Types.atom (Atoms.any_in_ns (parse_ns env.penv_tenv p.loc ns)))
| Or (p1,p2) -> POr (derecurs env p1, derecurs env p2)
| And (p1,p2) -> PAnd (derecurs env p1, derecurs env p2)
| Diff (p1,p2) -> PDiff (derecurs env p1, derecurs env p2)
......@@ -595,7 +627,7 @@ let rec derecurs env p = match p.descr with
| (p,None) -> derecurs env p, None in
PRecord (o, parse_record env.penv_tenv p.loc aux r)
| Constant (x,c) -> PConstant (x,const env.penv_tenv p.loc c)
| Cst c -> PType (Types.constant (const env.penv_tenv p.loc c))
| Cst c -> ptype (Types.constant (const env.penv_tenv p.loc c))
| Regexp r ->
let r,_ = derecurs_regexp IdSet.empty false IdSet.empty true env r in
PRegexp r
......@@ -650,12 +682,12 @@ and derecurs_var env loc v =
let v = ident v in
(try PAlias (Env.find v env.penv_derec)
with Not_found ->
try PType (find_type v env.penv_tenv)
try ptype (find_type v env.penv_tenv)
with Not_found -> PCapture v)
| cu, v ->
try
let cu = U.mk cu in
PType (find_type_global loc cu (ident v) env.penv_tenv)
ptype (find_type_global loc cu (ident v) env.penv_tenv)
with Not_found ->
raise_loc_generic loc
("Unbound external type " ^ cu ^ ":" ^ (U.to_string v))
......@@ -707,18 +739,24 @@ let check_no_capture loc s =
raise_loc_generic loc ("Capture variable not allowed: " ^ (Ident.to_string x))
| None -> ()
let compile_slot_hash = DerecursTable.create 67
let compile_hash = DerecursTable.create 67
let compile_slot_hash = DerecursTable.create 15067
let compile_hash = DerecursTable.create 15067
let todo_defs = ref []
let todo_fv = ref []
let rec compile p =
try DerecursTable.find compile_hash p
real_compile p
(*
print_char '*'; flush stdout;
try Stats.InOut.wrap "lookup" (DerecursTable.find compile_hash) p;
with Not_found ->
Stats.InOut.enter "compile";
let c = real_compile p in
DerecursTable.replace compile_hash p c;
Stats.InOut.leave "compile";
c
*)
and real_compile = function
| PDummy -> assert false
| PAlias v ->
......@@ -728,7 +766,7 @@ and real_compile = function
let r = compile v.pdescr in
v.ploop <- false;
r
| PType t -> IType t
| PType (t,h) -> IType (t,h)
| POr (t1,t2) -> IOr (compile t1, compile t2)
| PAnd (t1,t2) -> IAnd (compile t1, compile t2)
| PDiff (t1,t2) -> IDiff (compile t1, compile t2)
......@@ -739,7 +777,7 @@ and real_compile = function
| PRecord (o,r) -> IRecord (o, LabelMap.map compile_field r)
| PConstant (x,v) -> IConstant (x,v)
| PCapture x -> ICapture x
| PRegexp r -> compile (remove_regexp r (PType Sequence.nil_type))
| PRegexp r -> compile (remove_regexp r (ptype Sequence.nil_type))
and compile_field = function
| (p, Some e) -> (compile_slot p, Some (compile e))
......@@ -763,7 +801,9 @@ let rec flush_defs () =
List.iter compute_fv !todo_fv;
todo_fv := [];
Stats.Timer.stop timer_fv ()
| (s,p)::t ->
| (s,p)::t ->
(* Format.fprintf Format.std_formatter "flush slot:%a@."
print_derecurs p; *)
todo_defs := t;
s.d <- compile p;
flush_defs ()
......@@ -772,7 +812,7 @@ let typ_nodes = SlotTable.create 67
let pat_nodes = SlotTable.create 67
let rec typ = function
| IType t -> t
| IType (t,_) -> t
| IOr (s1,s2) -> Types.cup (typ s1) (typ s2)
| IAnd (s1,s2) -> Types.cap (typ s1) (typ s2)
| IDiff (s1,s2) -> Types.diff (typ s1) (typ s2)
......@@ -903,6 +943,10 @@ let dump_ns ppf env =
let do_typ loc r =
(*
DerecursTable.clear compile_slot_hash;
DerecursTable.clear compile_hash;
*)
let s = compile_slot r in
flush_defs ();
check_no_capture loc (fv_slot s);
......@@ -916,7 +960,8 @@ let pat env p =
flush_defs ();
try pat_node s
with Patterns.Error e -> raise_loc_generic p.loc e
| Location (loc,_,exn) when loc = noloc -> raise (Location (p.loc, `Full, exn))
| Location (loc,_,exn) when loc == noloc ->
raise (Location (p.loc, `Full, exn))
(* II. Build skeleton *)
......@@ -1033,7 +1078,8 @@ and extern loc env s args =
and var env loc s =
match is_op env s with
| Some (s,arity) ->
let need_ns = s = "print_xml" || s = "print_xml_utf8" in
let need_ns = match s with "print_xml" | "print_xml_utf8" -> true
| _ -> false in
let e = Typed.Op (s, arity, []) in
let e = if need_ns then Typed.NsTable (env.ns,e) else e in
exp loc Fv.empty e
......@@ -1111,7 +1157,7 @@ and branches env b =
let br =
{
Typed.br_loc = br_loc;
Typed.br_used = br_loc = noloc;
Typed.br_used = br_loc == noloc;
Typed.br_vars_empty = Patterns.fv p';
Typed.br_pat = p';
Typed.br_body = e } in
......@@ -1468,7 +1514,7 @@ let rec unused_branches b =
List.map
(fun x ->
let x = Ident.to_string x in
if x = "$$$" then raise Exit else x)
if (String.compare x "$$$" = 0) then raise Exit else x)
(IdSet.get br.br_vars_empty) in
let l = String.concat "," l in
"The following variables always match the empty sequence: " ^
......@@ -1538,19 +1584,23 @@ module Schema_converter =
open Schema_types
open Encodings
let seq r1 r2 = match r1,r2 with
| PEpsilon, r | r, PEpsilon -> r
| r1,r2 -> PSeq (r1,r2)
let xsd = Schema_xml.xsd
let is_xsd (ns,l) local =
(Ns.equal ns xsd) && (Utf8.get_str l = local)
(Ns.equal ns xsd) && (String.compare (Utf8.get_str l) local = 0)
(* auxiliary functions *)
let nil_type = PType Sequence.nil_type
let nil_type = ptype Sequence.nil_type
let mk_len_regexp ?min ?max base =
let rec repeat_regexp re = function
| z when Intervals.V.is_zero z -> PEpsilon
| n when Intervals.V.gt n Intervals.V.zero ->
PSeq (re, repeat_regexp re (Intervals.V.pred n))
seq re (repeat_regexp re (Intervals.V.pred n))
| _ -> assert false
in
let min = match min with Some min -> min | _ -> Intervals.V.one in
......@@ -1561,10 +1611,10 @@ module Schema_converter =
let rec aux acc = function
| z when Intervals.V.is_zero z -> acc
| n ->
aux (PAlt (PEpsilon, (PSeq (base, acc)))) (Intervals.V.pred n)
aux (PAlt (PEpsilon, (seq base acc))) (Intervals.V.pred n)
in
PSeq (min_regexp, aux PEpsilon (Intervals.V.sub max min))
| None -> PSeq (min_regexp, PStar base)
seq min_regexp (aux PEpsilon (Intervals.V.sub max min))
| None -> seq min_regexp (PStar base)
(* given a base derecurs create a derecurs value representing a sequence
* type according to length constraints members of facets *)
......@@ -1580,22 +1630,22 @@ module Schema_converter =
(* This is not correct ! *)
let mix_regexp =
let pcdata = PStar (PElem (PType Builtin_defs.string)) in
let pcdata = PStar (PElem (ptype Builtin_defs.string)) in
let rec aux = function
| PEpsilon -> PEpsilon
| PElem re -> PElem re
| PGuard re -> PGuard re
| PSeq (re1, re2) -> PSeq (aux re1, PSeq (pcdata, aux re2))
| PSeq (re1, re2) -> seq (aux re1) (seq pcdata (aux re2))
| PAlt (re1, re2) -> PAlt (aux re1, aux re2)
| PStar re -> PStar (aux re)
| PWeakStar re -> PWeakStar (aux re)
in
let rec simplify = function
| PSeq (x1, PSeq (x2, y)) when x1 = pcdata && x2 = pcdata ->
simplify (PSeq (x2, y))
| PSeq (x1, PSeq (x2, y)) when x1 == pcdata && x2 == pcdata ->
simplify (seq x2 y)
| re -> re
in
fun regexp -> (*simplify*) (PSeq (pcdata, aux regexp))
fun regexp -> simplify (seq pcdata (aux regexp))
(* conversion functions *)
......@@ -1603,29 +1653,29 @@ module Schema_converter =
let rec cd_type_of_simple_type ~schema = function
| Primitive name | Derived (Some name, _, _, _)
when Schema_builtin.is_builtin name ->
PType (Schema_builtin.cd_type_of_builtin name)
ptype (Schema_builtin.cd_type_of_builtin name)
| Primitive _ -> assert false (* all primitives are built-in *)
| Derived (_, _, { enumeration = Some values }, _) -> (* enumeration *)
PType (Types.choice_of_list
ptype (Types.choice_of_list
(List.map (fun c -> Types.constant (Value.inv_const (Lazy.force c)))
values))
| Derived (_, _, ({ maxInclusive = Some _ } as facets), _)(* boundaries *)
| Derived (_, _, ({ maxExclusive = Some _ } as facets), _)
| Derived (_, _, ({ minInclusive = Some _ } as facets), _)
| Derived (_, _, ({ minExclusive = Some _ } as facets), _) ->
PType (Types.interval (Schema_common.get_interval facets))
ptype (Types.interval (Schema_common.get_interval facets))
| Derived (_, Atomic c, facets, _) ->
(match Lazy.force c with
| Simple (Primitive name) ->
if is_xsd name "string" || is_xsd name "anyURI" then
(* length *)
mk_seq_derecurs ~base:(PElem (PType Builtin_defs.char)) facets
mk_seq_derecurs ~base:(PElem (ptype Builtin_defs.char)) facets
else if is_xsd name "hexBinary" || is_xsd name "base64Binary"
then (* length *)
mk_seq_derecurs ~base:(PElem (PType Builtin_defs.char_latin1))
mk_seq_derecurs ~base:(PElem (ptype Builtin_defs.char_latin1))
facets
else (* no other interesting facet *)
PType (Schema_builtin.cd_type_of_builtin name)
ptype (Schema_builtin.cd_type_of_builtin name)
| _ -> assert false)
| Derived (_, List item, facets, _) ->
mk_seq_derecurs
......@@ -1664,22 +1714,9 @@ module Schema_converter =
| All (hd :: tl) | Sequence (hd :: tl) ->
List.fold_left
(fun acc particle ->
PSeq (acc, regexp_of_particle ~schema particle))
seq acc (regexp_of_particle ~schema particle))
(regexp_of_particle ~schema hd) tl
(*
and regexp_of_content_type ~schema = function
| CT_empty -> PEpsilon
| CT_simple st -> PElem (cd_type_of_simple_type ~schema st)
| CT_model (particle, mixed) ->
let regexp = regexp_of_particle ~schema particle in
if mixed then begin (* TODO mixed *)
Value.failwith' "Mixed content models aren't supported";
mix_regexp regexp
end else
regexp
*)
and regexp_of_particle ~schema (min, max, term, _) =
mk_len_regexp ?min:(Some min) ?max (regexp_of_term ~schema term)
......@@ -1691,19 +1728,18 @@ module Schema_converter =
with Not_found ->
let slot = mk_derecurs_slot noloc in
Hashtbl.add complex_memo ct.ct_uid slot;
(* let content_re = regexp_of_content_type ~schema ct.ct_content in*)
let content_ast_node =
match ct.ct_content with
| CT_empty -> PType Sequence.nil_type
| CT_empty -> ptype Sequence.nil_type
| CT_simple st -> cd_type_of_simple_type_ref ~schema st
| CT_model (particle, mixed) ->
(* if mixed then
Value.failwith' "Mixed content models aren't supported"; *)
(* Format.fprintf Format.std_formatter "CT_model particle=%a@."
Schema_common.print_particle particle; *)
let regexp = regexp_of_particle ~schema particle in
let regexp = if mixed then mix_regexp regexp else regexp in
PRegexp regexp
in
slot.pdescr <-
slot.pdescr <-
PTimes (cd_type_of_attr_uses ~schema ct.ct_attrs, content_ast_node);
PAlias slot
......@@ -1716,7 +1752,7 @@ module Schema_converter =
match at.attr_use_cstr with
| Some (`Fixed v) ->
let v = Lazy.force v in
PType (Types.constant (Value.inv_const v))
ptype (Types.constant (Value.inv_const v))
| _ -> cd_type_of_simple_type_ref ~schema at.attr_decl.attr_typdef
in
let r = if at.attr_required then r else POptional r in
......@@ -1732,27 +1768,27 @@ module Schema_converter =
and cd_type_of_elt_decl ~schema elt =
let atom_type =
PType (Types.atom (Atoms.atom (Atoms.V.of_qname elt.elt_name)))
ptype (Types.atom (Atoms.atom (Atoms.V.of_qname elt.elt_name)))
in
let content =
match elt.elt_cstr with
| Some (`Fixed v) ->
let v = Lazy.force v in
PType (Types.constant (Value.inv_const v))
ptype (Types.constant (Value.inv_const v))
| _ ->
(match Lazy.force elt.elt_typdef with
| AnyType ->
PType (Schema_builtin.cd_type_of_builtin (xsd, U.mk "anyType"))
ptype (Schema_builtin.cd_type_of_builtin (xsd, U.mk "anyType"))
| Simple st ->
PTimes
(PType Types.empty_closed_record,
(ptype Types.empty_closed_record,
cd_type_of_simple_type ~schema st)
| Complex ct -> cd_type_of_complex_type' ~schema ct)
in
PXml (atom_type, content)
let cd_type_of_complex_type ~schema ct =
PXml (PType Types.any, cd_type_of_complex_type' ~schema ct)
PXml (ptype Types.any, cd_type_of_complex_type' ~schema ct)
let cd_type_of_model_group ~schema g =
PRegexp (regexp_of_model_group ~schema g)
......@@ -1787,8 +1823,8 @@ let get_schema uri =
Format.fprintf Format.std_formatter
"Registering schema %s: %s # %s"
kind uri (Ns.QName.to_string name);
if debug_schema then
Types.Print.print Format.std_formatter cd_type;
(* if debug_schema then
Types.Print.print Format.std_formatter cd_type; *)
Format.fprintf Format.std_formatter "@."
end
in
......@@ -1796,8 +1832,10 @@ let get_schema uri =
List.iter (* Schema types -> CDuce types *)
(fun type_def ->
let name = Schema_common.name_of_type_definition type_def in
log_schema_component "type" uri name ();
let cd_type = Schema_converter.cd_type_of_type_def ~schema type_def in
log_schema_component "type" uri name cd_type;
Format.fprintf Format.std_formatter
"Done@.";
Hashtbl.add !schema_types (uri, name) cd_type)
schema.Schema_types.types;
List.iter (* Schema attributes -> CDuce types *)
......
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