Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
04a72414
Commit
04a72414
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2005-03-09 15:29:36 by afrisch] Get rid of PXP dependency
Original author: afrisch Date: 2005-03-09 15:32:20+00:00
parent
3238c9c0
Changes
10
Hide whitespace changes
Inline
Side-by-side
INSTALL
View file @
04a72414
...
...
@@ -26,43 +26,41 @@ Mandatory packages:
Before compiling CDuce, you need to install recent releases of the
following packages:
ocaml
=
> 3.08.1
ocaml >
=
3.08.1
http://caml.inria.fr/ocaml/distrib.html
findlib
=
> 1.0.3
findlib >
=
1.0.3
http://www.ocaml-programming.de/packages
ulex
=
> 0.4
ulex >
=
0.4
http://www.cduce.org/download
pcre-ocaml
=
> 5.03
pcre-ocaml >
=
5.03
http://www.ai.univie.ac.at/~markus/home/ocaml_sources.html
ocamlnet
=
> 0.98
ocamlnet >
=
0.98
http://www.ocaml-programming.de/packages
pxp => 1.1.95
http://www.ocaml-programming.de/packages/documentation/pxp/index_dev.html
Additional optional packages:
-----------------------------
* If you want to load xml, html, and schema files remotely on the
web (http, https, ftp, ...: e.g. load_html "http://www.cduce.org") you will
need one of:
* You'll probably want to build CDuce with an XML parser. You will need one of:
pxp >= 1.1.95
http://www.ocaml-programming.de/packages/documentation/pxp/index_dev.html
ocaml-expat >= 0.1.0
http://home.wanadoo.nl/maas/ocaml/
* CDuce can use one the the ocurl and netclient library to fetch external
URLs. You will need one of:
ocurl
=
> 0.15
ocurl >
=
0.15
http://sourceforge.net/projects/ocurl/
netclient
=
> 0.90.1
netclient >
=
0.90.1
http://www.ocaml-programming.de/programming/netclient.html
netclient support only the http protocol.
curl supports in addition https, ftp, and other protocols.
* You can also use the expat parser instead of PXP to load XML documents
(PXP is still needed):
ocaml-expat => 0.1.0
http://home.wanadoo.nl/maas/ocaml/
Important notes:
----------------
...
...
@@ -75,11 +73,12 @@ Important notes:
>= 5.03 recommended but previous versions may work
- PXP:
CDuce requires a development version >= 1.1.94.2.
Notes: It is enough to build support UTF8 and ISO-8859-1 ocamllex-lexers:
It is enough to build support for UTF8 and ISO-8859-1 ocamllex-lexers:
./configure -without-wlex -without-wlex-compat -lexlist utf8,iso88591
You can also build pxp with wlex support (more compact code). This
can be done by installing wlex runtime support library
*before* pxp
can be done by installing wlex runtime support library *before* pxp
http://www.eleves.ens.fr/home/frisch/soft.html#wlex
and build pxp -with-wlex*. When building CDuce you still have the
choice whether to use wlex or ocamllex (to choose wlex,
...
...
@@ -92,11 +91,6 @@ Important notes:
you may also need to install libexpat (http://expat.sourceforge.net/)
Efficiency issues:
- PXP: ocamllex lexers are more efficient than wlex lexers.
------------------------------------------------------------------------------
Compilation
------------------------------------------------------------------------------
...
...
@@ -130,9 +124,6 @@ You need a GNU Make (or equivalent). The Makefile defines the following goals:
- make dtd2cduce
compiles the dtd2cduce tools (converts DTD to CDuce types)
- make cduce_validate
compiles the schema validation tool
- make doc
compiles in the subdirectory web/doc the HTML documentation for CDuce
...
...
@@ -176,21 +167,30 @@ subdirectories)
Note for GODI users:
====================
The GODI distribution *does* install the files in
$(LOCALBASE)/lib/ocaml/compiler-lib.
The GODI distribution provided the required files by default.
The configure script will detect them automatically.
Note for Debian users:
======================
The Debian package ocaml-compiler-libs provides the required files.
The configure script will detect them automatically.
------------------------------------------------------------------------------
Note on
using the expat
parser
Note on
XML
parser
s
------------------------------------------------------------------------------
CDuce can uses two XML parsers: PXP and expat. PXP is needed
to build CDuce, and expat support can be additionnaly added.
When CDuce is built with expat support, it uses by default expat to
load XML files. You can still use PXP by adding "--no expat" to
When CDuce is built with support for both expat and PXP, it uses by default
expat to parse XML files. You can still use PXP by adding "--no expat" to
the CDuce command line.
Note: the current wrapper for expat does not support inclusion
of external entities. Moreover, the error messages in case of
ill-formed XML are less informative than PXP's.
- error messages:
The error messages provided by expat when parsing ill-formed XML documents
are less informative than those given by PXP.
- efficiency:
* expat is more efficient than PXP, and produces smaller executables.
* for PXP, ocamllex lexers are more efficient than wlex lexers.
Makefile.distrib
View file @
04a72414
...
...
@@ -6,12 +6,7 @@ ifeq ($(NATIVE),true)
all
:
cduce_lib.cmxa
endif
PACKAGES
=
pxp-engine pxp-lex-iso88591 ulex camlp4 num cgi pcre netstring
ifeq
($(PXP_WLEX), true)
PACKAGES
+=
pxp-wlex-utf8
else
PACKAGES
+=
pxp-lex-utf8
endif
PACKAGES
=
ulex camlp4 num cgi pcre netstring
# Call make with VERBOSE=true to get a trace of commands
...
...
@@ -195,8 +190,15 @@ ifneq ($(NETCLIENT), false)
PACKAGES
+=
netclient
endif
OBJECTS
+=
runtime/cduce_pxp.cmo
ifeq
($(PXP),true)
OBJECTS
+=
runtime/cduce_pxp.cmo
PACKAGES
+=
pxp-engine pxp-lex-iso88591
ifeq
($(PXP_WLEX), true)
PACKAGES
+=
pxp-wlex-utf8
else
PACKAGES
+=
pxp-lex-utf8
endif
endif
ifeq
($(EXPAT), true)
OBJECTS
+=
runtime/cduce_expat.cmo
PACKAGES
+=
expat
...
...
configure.ml
View file @
04a72414
...
...
@@ -25,6 +25,7 @@ Optional features:
Available features:
ocamlopt use ocamlopt instead of ocamlc to build CDuce
pxp_wlex use wlexers for parsing utf8 with PXP [default: false]
pxp support for the PXP XML parser
expat support for the expat XML parser
curl support for the libcurl library
netclient support for the netclient library
...
...
@@ -49,6 +50,7 @@ if not_distrib then print_string "
let
features
=
[
"ocamlopt"
,
ref
`auto
;
"mliface"
,
ref
`auto
;
"pxp"
,
ref
`auto
;
"expat"
,
ref
`auto
;
"curl"
,
ref
`auto
;
"netclient"
,
ref
`auto
;
...
...
@@ -208,6 +210,7 @@ let ml_interface =
loop
dirs
let
pxp
=
check_feature
"pxp"
(
check_pkg
"pxp"
)
let
expat
=
check_feature
"expat"
(
check_pkg
"expat"
)
let
curl
=
check_feature
"curl"
(
check_pkg
"curl"
)
let
netclient
=
check_feature
"netclient"
(
check_pkg
"netclient"
)
...
...
@@ -231,6 +234,16 @@ let curl,netclient =
false
,
false
|
c
,
n
->
c
,
n
let
pxp
,
expat
=
match
pxp
,
expat
with
|
true
,
true
->
warning
"Both PXP and expat are available. Will build both and use expat by default."
;
false
,
true
|
false
,
false
->
warning
"No package for parsing XML documents."
;
false
,
false
|
c
,
n
->
c
,
n
let
required_packages
=
[
"camlp4"
;
"num"
;
"pcre"
;
"ulex"
;
"cgi"
;
"netstring"
;
...
...
@@ -250,6 +263,7 @@ let () =
|
`no
->
fprintf
out
"ML_INTERFACE=false
\n
"
|
`flat
d
->
fprintf
out
"ML_INTERFACE=flat
\n
ML_MODULES=%s
\n
"
d
|
`tree
d
->
fprintf
out
"ML_INTERFACE=tree
\n
ML_MODULES=%s
\n
"
d
);
fprintf
out
"PXP=%b
\n
"
pxp
;
fprintf
out
"EXPAT=%b
\n
"
expat
;
fprintf
out
"CURL=%b
\n
"
curl
;
fprintf
out
"NETCLIENT=%b
\n
"
netclient
;
...
...
depend
View file @
04a72414
...
...
@@ -97,17 +97,17 @@ schema/schema_types.cmo: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
schema/schema_types.cmx: types/atoms.cmx misc/encodings.cmx misc/ns.cmx \
runtime/value.cmx schema/schema_types.cmi
schema/schema_xml.cmo: misc/encodings.cmi parser/location.cmi misc/ns.cmi \
schema/schema_pcre.cmi
parser/url.cmi
schema/schema_xml.cmi
schema/schema_pcre.cmi schema/schema_xml.cmi
schema/schema_xml.cmx: misc/encodings.cmx parser/location.cmx misc/ns.cmx \
schema/schema_pcre.cmx
parser/url.cmx
schema/schema_xml.cmi
schema/schema_pcre.cmx schema/schema_xml.cmi
schema/schema_common.cmo: types/atoms.cmi misc/encodings.cmi types/ident.cmo \
types/intervals.cmi
misc/ns.cmi schema/schema_pcre.cmi \
schema/schema_types.cmi
schema/schema_xml.cmi types/types.cmi \
runtime/value.cmi
schema/schema_common.cmi
misc/ns.cmi schema/schema_pcre.cmi
schema/schema_types.cmi
\
schema/schema_xml.cmi types/types.cmi
runtime/value.cmi
\
schema/schema_common.cmi
schema/schema_common.cmx: types/atoms.cmx misc/encodings.cmx types/ident.cmx \
types/intervals.cmx
misc/ns.cmx schema/schema_pcre.cmx \
schema/schema_types.cmx
schema/schema_xml.cmx types/types.cmx \
runtime/value.cmx
schema/schema_common.cmi
misc/ns.cmx schema/schema_pcre.cmx
schema/schema_types.cmx
\
schema/schema_xml.cmx types/types.cmx
runtime/value.cmx
\
schema/schema_common.cmi
schema/schema_builtin.cmo: types/atoms.cmi types/builtin_defs.cmi \
misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
schema/schema_common.cmi schema/schema_pcre.cmi schema/schema_types.cmi \
...
...
@@ -270,46 +270,28 @@ ocamliface/mlstub.cmx: types/atoms.cmx types/builtin_defs.cmx \
driver/librarian.cmx parser/location.cmx ocamliface/mltypes.cmx \
misc/ns.cmx types/sequence.cmx typing/typer.cmx types/types.cmx \
ocamliface/mlstub.cmi
parser/cduce_netclient.cmo: driver/config.cmi parser/location.cmi \
parser/url.cmi
parser/cduce_netclient.cmx: driver/config.cmx parser/location.cmx \
parser/url.cmx
parser/cduce_curl.cmo: driver/config.cmi parser/url.cmi
parser/cduce_curl.cmx: driver/config.cmx parser/url.cmx
runtime/cduce_pxp.cmo: driver/config.cmi runtime/load_xml.cmi \
parser/location.cmi parser/url.cmi runtime/cduce_pxp.cmi
parser/location.cmi schema/schema_xml.cmi parser/url.cmi \
runtime/cduce_pxp.cmi
runtime/cduce_pxp.cmx: driver/config.cmx runtime/load_xml.cmx \
parser/location.cmx parser/url.cmx runtime/cduce_pxp.cmi
parser/location.cmx schema/schema_xml.cmx parser/url.cmx \
runtime/cduce_pxp.cmi
runtime/cduce_expat.cmo: driver/config.cmi runtime/load_xml.cmi \
parser/location.cmi parser/url.cmi runtime/cduce_expat.cmi
runtime/cduce_expat.cmx: driver/config.cmx runtime/load_xml.cmx \
parser/location.cmx parser/url.cmx runtime/cduce_expat.cmi
query/query_aggregates.cmo: types/builtin_defs.cmi types/intervals.cmi \
compile/operators.cmi types/sequence.cmi runtime/value.cmi
query/query_aggregates.cmx: types/builtin_defs.cmx types/intervals.cmx \
compile/operators.cmx types/sequence.cmx runtime/value.cmx
query/query.cmo: parser/ast.cmo types/atoms.cmi types/builtin_defs.cmi \
types/chars.cmi types/ident.cmo types/intervals.cmi parser/location.cmi \
misc/ns.cmi parser/parser.cmi types/types.cmi query/query.cmi
query/query.cmx: parser/ast.cmx types/atoms.cmx types/builtin_defs.cmx \
types/chars.cmx types/ident.cmx types/intervals.cmx parser/location.cmx \
misc/ns.cmx parser/parser.cmx types/types.cmx query/query.cmi
query/query_parse.cmo: parser/ast.cmo types/atoms.cmi types/ident.cmo \
parser/location.cmi parser/parser.cmi query/query.cmi types/sequence.cmi \
types/types.cmi
query/query_parse.cmx: parser/ast.cmx types/atoms.cmx types/ident.cmx \
parser/location.cmx parser/parser.cmx query/query.cmx types/sequence.cmx \
types/types.cmx
query/query_run.cmo: driver/cduce.cmi query/query.cmi
query/query_run.cmx: driver/cduce.cmx query/query.cmx
driver/run.cmo: types/builtin.cmi driver/cduce.cmi driver/config.cmi \
misc/html.cmi types/ident.cmo driver/librarian.cmi parser/location.cmi \
misc/state.cmi misc/stats.cmi parser/ulexer.cmi runtime/value.cmi
driver/run.cmx: types/builtin.cmx driver/cduce.cmx driver/config.cmx \
misc/html.cmx types/ident.cmx driver/librarian.cmx parser/location.cmx \
misc/state.cmx misc/stats.cmx parser/ulexer.cmx runtime/value.cmx
schema/schema_components.cmo: misc/encodings.cmi misc/ns.cmi \
runtime/value.cmi
schema/schema_components.cmx: misc/encodings.cmx misc/ns.cmx \
runtime/value.cmx
schema/schema_import.cmo: misc/encodings.cmi misc/ns.cmi \
schema/schema_components.cmo
schema/schema_import.cmx: misc/encodings.cmx misc/ns.cmx \
schema/schema_components.cmx
driver/start.cmo: driver/run.cmo
driver/start.cmx: driver/run.cmx
driver/webiface.cmo: driver/cduce.cmi driver/examples.cmo misc/html.cmi \
...
...
@@ -379,8 +361,7 @@ schema/schema_types.cmi: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
runtime/value.cmi
schema/schema_xml.cmi: misc/encodings.cmi misc/ns.cmi
schema/schema_common.cmi: types/atoms.cmi misc/encodings.cmi types/ident.cmo \
types/intervals.cmi misc/ns.cmi schema/schema_types.cmi types/types.cmi \
runtime/value.cmi
misc/ns.cmi schema/schema_types.cmi types/types.cmi runtime/value.cmi
schema/schema_builtin.cmi: misc/encodings.cmi misc/ns.cmi \
schema/schema_types.cmi types/types.cmi runtime/value.cmi
schema/schema_validator.cmi: misc/encodings.cmi schema/schema_types.cmi \
...
...
@@ -391,7 +372,7 @@ types/externals.cmi: types/types.cmi
typing/typer.cmi: parser/ast.cmo misc/custom.cmo types/ident.cmo \
parser/location.cmi misc/ns.cmi types/patterns.cmi typing/typed.cmo \
types/types.cmi runtime/value.cmi
runtime/load_xml.cmi:
parser/url.cmi
runtime/value.cmi
runtime/load_xml.cmi: runtime/value.cmi
runtime/run_dispatch.cmi: types/patterns.cmi runtime/value.cmi
runtime/explain.cmi: types/types.cmi runtime/value.cmi
runtime/print_xml.cmi: misc/ns.cmi runtime/value.cmi
...
...
@@ -406,7 +387,6 @@ driver/librarian.cmi: compile/compile.cmi types/ident.cmo typing/typer.cmi \
types/types.cmi runtime/value.cmi
driver/cduce.cmi: misc/ns.cmi runtime/value.cmi
ocamliface/mltypes.cmi: ocamliface/asttypes.cmo types/types.cmi
query/query.cmi: parser/ast.cmo
ocamliface/mltypes.cmi: ocamliface/asttypes.cmo types/types.cmi
schema/schema_types.cmi: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
runtime/value.cmi
runtime/cduce_pxp.ml
View file @
04a72414
...
...
@@ -52,15 +52,15 @@ let alt = new resolve_to_any_obj_channel ~channel_of_id ()
let
src_of_uri
uri
=
XExtID
(
System
uri
,
None
,
alt
)
let
load_pxp
uri
=
let
load_pxp
handlers
uri
=
try
let
mgr
=
create_entity_manager
pxp_config
(
src_of_uri
uri
)
in
process_entity
pxp_config
(
`Entry_document
[
`Extend_dtd_fully
])
mgr
pxp_
handle
_event
;
(
`Entry_document
[
`Extend_dtd_fully
])
mgr
handle
rs
;
with
exn
->
raise
(
Location
.
Generic
(
Pxp_types
.
string_of_exn
exn
))
let
use
()
=
Load_xml
.
xml_parser
:=
load_pxp
let
use
()
=
Load_xml
.
xml_parser
:=
load_pxp
pxp_handle_event
let
()
=
Config
.
register
...
...
@@ -68,4 +68,12 @@ let () =
"PXP XML parser"
use
let
()
=
Schema_xml
.
src_of_uri
:=
src_of_uri
let
()
=
Schema_xml
.
xml_parser
:=
(
fun
uri
f
g
->
load_pxp
(
function
|
E_start_tag
(
name
,
att
,_,_
)
->
f
name
att
|
E_end_tag
(
_
,_
)
->
g
()
|
_
->
()
)
uri
)
runtime/load_xml.ml
View file @
04a72414
...
...
@@ -46,10 +46,6 @@ let attrib att =
let
elem
(
tag_ns
,
tag
)
att
child
=
Xml
(
Atom
(
Atoms
.
V
.
mk
tag_ns
tag
)
,
Record
(
attrib
att
)
,
child
)
(*
class warner = object method warn w = print_endline ("PXP WARNING: " ^ w) end
*)
type
stack
=
|
Element
of
Value
.
t
*
stack
|
Start
of
Ns
.
qname
*
(
Ns
.
qname
*
Utf8
.
t
)
list
*
Ns
.
table
*
stack
...
...
runtime/print_xml.ml
View file @
04a72414
(* Print XML documents, using PXP *)
(* Print XML documents *)
(* The write_*_function are inspired from Pxp_aux.ml *)
open
Netconversion
let
write_markup_string
~
to_enc
buf
s
=
let
s'
=
if
to_enc
=
`Enc_utf8
then
s
else
convert
~
in_enc
:
`Enc_utf8
~
out_enc
:
to_enc
~
subst
:
(
fun
n
->
failwith
(
"Cannot represent code point "
^
string_of_int
n
))
s
in
Buffer
.
add_string
buf
s'
let
write_data_string
~
to_enc
buf
s
=
let
write_part
i
len
=
if
(
len
>
0
)
then
if
to_enc
=
`Enc_utf8
then
Buffer
.
add_substring
buf
s
i
len
else
let
s'
=
convert
~
in_enc
:
`Enc_utf8
~
out_enc
:
to_enc
~
subst
:
(
fun
n
->
"&#"
^
string_of_int
n
^
";"
)
~
range_pos
:
i
~
range_len
:
len
s
in
Buffer
.
add_string
buf
s'
in
let
i
=
ref
0
in
for
k
=
0
to
String
.
length
s
-
1
do
match
s
.
[
k
]
with
|
(
'
&
'
|
'
<
'
|
'
>
'
|
'
"' | '%') as c ->
write_part !i (k - !i);
begin match c with
'&' -> Buffer.add_string buf "
&
amp
;
"
| '<' -> Buffer.add_string buf "
&
lt
;
"
| '>' -> Buffer.add_string buf "
&
gt
;
"
| '"
'
->
Buffer
.
add_string
buf
"""
|
'
%
'
->
Buffer
.
add_string
buf
"%"
(* reserved in DTDs *)
|
_
->
assert
false
end
;
i
:=
k
+
1
|
_
->
()
done
;
write_part
!
i
(
String
.
length
s
-
!
i
)
(*************)
open
Pxp_aux
open
Pxp_types
open
Value
open
Ident
module
U
=
Encodings
.
Utf8
...
...
@@ -46,18 +96,8 @@ let string_of_xml ~utf8 ns_table v =
let
buffer
=
Buffer
.
create
127
in
let
printer
=
Ns
.
Printer
.
printer
ns_table
in
let
wms
=
write_markup_string
~
from_enc
:
`Enc_utf8
~
to_enc
(
`Out_buffer
buffer
)
and
wds
s
=
write_data_string
~
from_enc
:
`Enc_utf8
~
to_enc
(
`Out_buffer
buffer
)
(
U
.
get_str
s
)
let
wms
=
write_markup_string
~
to_enc
buffer
and
wds
s
=
write_data_string
~
to_enc
buffer
(
U
.
get_str
s
)
in
let
write_att
(
n
,
v
)
=
wms
(
" "
^
(
Ns
.
Printer
.
attr
printer
n
)
^
"=
\"
"
);
wds
v
;
wms
"
\"
"
in
...
...
@@ -143,10 +183,6 @@ let string_of_xml ~utf8 ns_table v =
Buffer
.
contents
buffer
let
print_xml
~
utf8
ns_table
s
=
try
let
s
=
string_of_xml
~
utf8
ns_table
s
in
if
utf8
then
string_utf8
(
U
.
mk
s
)
else
string_latin1
s
with
CDuceExn
_
as
exn
->
raise
exn
|
exn
->
raise
(
Location
.
Generic
(
Pxp_types
.
string_of_exn
exn
))
let
s
=
string_of_xml
~
utf8
ns_table
s
in
if
utf8
then
string_utf8
(
U
.
mk
s
)
else
string_latin1
s
schema/schema_parser.ml
View file @
04a72414
...
...
@@ -259,8 +259,7 @@ let schema_of_uri uri =
|
None
->
match
_may_elem
"xsd:union"
n
with
|
Some
union
->
simple_union
name
(
find_member_types
union
)
|
None
->
error
(
"Unknown variety for simpleType at line "
^
(
string_of_int
(
_line
n
))
^
" uri = "
^
uri
)
|
None
->
error
"Unknown variety for simpleType"
(* look for a simple type def: try attribute "base", try "simpleType" child,
* fail *)
...
...
schema/schema_xml.ml
View file @
04a72414
...
...
@@ -4,138 +4,95 @@ open Schema_pcre
exception
Error
of
string
let
error
s
=
raise
(
Error
s
)
let
src_of_uri
=
ref
(
fun
_
->
failwith
"PXP support required to load XML Schema"
)
type
node
=
(
'
a
Pxp_document
.
node
Pxp_document
.
extension
as
'
a
)
Pxp_document
.
node
module
Node
=
struct
type
t
=
node
let
compare
=
Pxp_document
.
compare
end
let
start_with
s
pr
=
let
s
=
Utf8
.
get_str
s
in
(
String
.
length
s
>=
String
.
length
pr
)
&&
(
String
.
sub
s
0
(
String
.
length
pr
)
=
pr
)
let
has_xsd_prefix
s
=
start_with
s
"xsd:"
let
xsd_namespace
=
Utf8
.
mk
"http://www.w3.org/2001/XMLSchema"
let
xsi_namespace
=
Utf8
.
mk
"http://www.w3.org/2001/XMLSchema-instance"
let
xsd_prefix
=
Utf8
.
mk
"xsd"
let
xsi_prefix
=
Utf8
.
mk
"xsi"
let
xsd
=
Ns
.
mk
xsd_namespace
let
xsi
=
Ns
.
mk
xsi_namespace
let
schema_ns_prefixes
=
[
xsd_prefix
,
xsd_namespace
;
xsi_prefix
,
xsi_namespace
]
let
spec
=
Pxp_tree_parser
.
default_namespace_spec
let
new_xsd_config
()
=
let
ns_manager
=
new
Pxp_dtd
.
namespace_manager
in
List
.
iter
(
fun
(
p
,
ns
)
->
ns_manager
#
add_namespace
(
Utf8
.
get_str
p
)
(
Utf8
.
get_str
ns
))
schema_ns_prefixes
;
{
Pxp_types
.
default_namespace_config
with
Pxp_types
.
encoding
=
`Enc_utf8
;
Pxp_types
.
enable_namespace_processing
=
Some
ns_manager
}
let
node_of
src
=
(
Pxp_tree_parser
.
parse_wfdocument_entity
(
new_xsd_config
()
)
src
spec
)
#
root
let
node_of_uri
uri
=
try
node_of
(
!
src_of_uri
uri
)
with
exn
->
raise
(
Location
.
Generic
(
Pxp_types
.
string_of_exn
exn
))
let
xml_parser
=
ref
(
fun
uri
_
_
->
failwith
"No active XML parser"
)
(* A simple tree model sufficient to parse schemas *)
type
node
=
{
tag
:
string
;
attrs
:
(
Ns
.
qname
*
Utf8
.
t
)
list
;
mutable
children
:
node
list
;
ns
:
Ns
.
table
;
father
:
node
}
let
rec
root
=
{
tag
=
"***"
;
attrs
=
[]
;
children
=
[]
;
ns
=
Ns
.
empty_table
;
father
=
root
}
let
current
=
ref
root
let
start_element_handler
name
att
=
let
(
table
,
(
ns
,
local
)
,
attrs
)
=
Ns
.
process_start_tag
!
current
.
ns
name
att
in
let
tag
=
if
Ns
.
equal
ns
xsd
then
"xsd:"
^
(
Utf8
.
get_str
local
)
else
"***"
in
current
:=
{
tag
=
tag
;
attrs
=
attrs
;
children
=
[]
;
ns
=
table
;
father
=
!
current
}
let
end_element_handler
()
=
(
!
current
)
.
children
<-
List
.
rev
(
!
current
)
.
children
;
let
f
=
(
!
current
)
.
father
in
f
.
children
<-
!
current
::
f
.
children
;
current
:=
f
let
node_of_uri
uri
=
current
:=
root
;
root
.
children
<-
[]
;
!
xml_parser
uri
start_element_handler
end_element_handler
;
let
c
=
root
.
children
in
root
.
children
<-
[]
;
match
c
with
|
[
r
]
->
r
|
_
->
assert
false
let
_may_attr
name
n
=
try
match
n
#
attribute
name
with
|
Pxp_types
.
Value
v
->
Some
(
Utf8
.
mk
v
)
|
_
->
None
with
Not_found
->
None
let
name
=
(
Ns
.
empty
,
Utf8
.
mk
name
)
in
let
rec
aux
=
function
|
[]
->
None
|
(
nm
,
v
)
::_
when
Ns
.
QName
.
equal
nm
name
->
Some
v
|
_
::
r
->
aux
r
in
aux
n
.
attrs
let
_is_attr
name
n
v
=
try
match
n
#
attribute
name
with
|
Pxp_types
.
Value
v'
->
v
=
v'
|
_
->
false
with
Not_found
->
false
match
_may_attr
name
n
with
|
None
->
false
|
Some
v'
->
Utf8
.
get_str
v'
=
v
let
_attr
name
n
=
match
n
#
attribute
name
with
|
Pxp_types
.
Value
v
->
Utf8
.
mk
v
|
_
->
error
(
"Attribute "
^
name
^
" is missing"
)
match
_may_attr
name
n
with
|
Some
v
->
v
|
None
->
error
(
"Attribute "
^
name
^
" is missing"
)
let
_may_elem
e
(
n
:
node
)
=
try
Some
(
Pxp_document
.
find_element
e
n
)
with
Not_found
->
None
let
_elems
e
n
=
Pxp_document
.
find_all_elements
e
n
let
_filter_elems
p
n
=
Pxp_document
.
find_all
(
fun
n
->
match
n
#
node_type
with
|
Pxp_document
.
T_element
s
->
List
.
mem
s
p
|
_
->
false
)
n
let
_line
n
=
match
n
#
position
with
(
_
,
l
,_
)
->
l
let
_iter_nodes
n
f
=
n
#
iter_nodes
f
let
_iter_elems
n
f
=
n
#
iter_nodes
(
fun
n
->
match
n
#
node_type
with
|
Pxp_document
.
T_element
s
->
f
n
s
|
_
->
()
)
let
_tag
n
=
n
.
tag
let
_elems
name
n
=
List
.
filter
(
fun
n
->
n
.
tag
=
name
)
n
.
children
let
_fold_elems
n
x
f
=
let
x
=
ref
x
in
n
#
iter_nodes
(
fun
n
->
match
n
#
node_type
with
|
Pxp_document
.
T_element
s
->
x
:=
f
!
x
n
s
|
_
->
()
);
!
x
let
_tag
n
=
match
n
#
node_type
with
|
Pxp_document
.
T_element
s
->
s
|
_
->
assert
false
let
_has_tag
n
f
=
match
n
#
node_type
with
|
Pxp_document
.
T_element
s
->
f
s
|
_