Skip to content
GitLab
Menu
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
fef69e42
Commit
fef69e42
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2005-02-17 09:28:18 by afrisch] Clean a little bit schema
Original author: afrisch Date: 2005-02-17 09:28:19+00:00
parent
c679f622
Changes
5
Hide whitespace changes
Inline
Side-by-side
Makefile.distrib
View file @
fef69e42
...
...
@@ -158,9 +158,10 @@ OBJECTS = \
compile/lambda.cmo
\
runtime/value.cmo
\
\
parser/location.cmo
\
$(SCHEMA_OBJS)
\
\
parser/location.cmo
parser/url.cmo parser/ulexer.cmo parser/ast.cmo parser/parser.cmo
\
parser/url.cmo parser/ulexer.cmo parser/ast.cmo parser/parser.cmo
\
\
types/externals.cmo
\
typing/typed.cmo typing/typer.cmo
\
...
...
schema/schema_parser.ml
View file @
fef69e42
...
...
@@ -9,7 +9,7 @@ open Schema_validator
open
Schema_xml
open
Schema_xml
.
Pxp_helpers
let
debug
=
tru
e
let
debug
=
fals
e
let
debug_print
?
(
n
:
pxp_node
option
)
s
=
if
debug
then
(
match
n
with
...
...
@@ -842,18 +842,17 @@ let schema_of_node root =
model_groups
=
resolver
#
model_groups
}
let
wrap_err
f
x
=
try
f
x
with
exn
->
raise
(
Location
.
Generic
(
Pxp_types
.
string_of_exn
exn
))
let
parse_schema
source
=
(* let config =
{ new_xsd_config () with Pxp_types.enable_namespace_info = true }
in
*)
let
config
=
new_xsd_config
()
in
let
schema
=
schema_of_node
(
pxp_node_of
~
config
source
)
in
let
schema
=
schema_of_node
(
pxp_node_of
source
)
in
debug_print
"parse_schema completed successfully"
;
schema
let
schema_of_file
fname
=
parse_schema
(
Pxp_types
.
from_file
fname
)
let
schema_of_string
s
=
parse_schema
(
Pxp_types
.
from_string
s
)
let
schema_of_file
=
wrap_err
(
fun
fname
->
parse_schema
(
Pxp_types
.
from_file
fname
))
let
schema_of_string
=
wrap_err
(
fun
s
->
parse_schema
(
Pxp_types
.
from_string
s
))
schema/schema_parser.mli
View file @
fef69e42
(** XML Schema Documents parsing *)
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
(** shortand for "parse_schema (Pxp_types.from_string <fname>)" *)
val
schema_of_string
:
string
->
schema
schema/schema_xml.ml
View file @
fef69e42
open
Pxp_document
open
Pxp_ev_parser
open
Pxp_tree_parser
...
...
@@ -37,75 +36,9 @@ let new_xsd_config () =
Pxp_types
.
enable_namespace_processing
=
Some
ns_manager
}
let
pxp_node_of
?
(
config
=
new_xsd_config
()
)
src
=
parse_wfcontent_entity
config
src
spec
let
pxp_document_of
?
(
config
=
new_xsd_config
()
)
src
=
parse_wfdocument_entity
config
src
spec
let
pxp_node_of
src
=
parse_wfcontent_entity
(
new_xsd_config
()
)
src
spec
let
pxp_stream_of_file
?
(
config
=
new_xsd_config
()
)
fname
=
let
config
=
{
config
with
drop_ignorable_whitespace
=
true
}
in
let
entity_manager
=
create_entity_manager
~
is_document
:
true
config
(
from_file
fname
)
in
let
pull_parser
=
create_pull_parser
config
(
`Entry_document
[
`Extend_dtd_fully
;
`Parse_xml_decl
])
entity_manager
in
Stream
.
from
(
fun
_
->
pull_parser
()
)
(*
class foo_entity_id = object end
let eid = new foo_entity_id
type to_be_visited =
| Fully of Value.t (* xml values still to be visited *)
| Half of Value.t (* xml values half visited (i.e. E_start_tag generated) *)
| Other of Value.t (* other values *)
let pxp_stream_of_value v =
let stack = ref [Fully v] in
let f _ = (* lazy visit of a tree of CDuce XML values, stack keeps track of
what is still to be visited *)
(match !stack with
| (Fully ((Value.Xml (Value.Atom a, attrs, _)) as v)) :: tl ->
let (ns,a) = Atoms.V.value a in
assert( ns == Ns.empty );
let tag_ascii = Encodings.Utf8.to_string a in
let attrs_ascii =
List.map (fun (k, v) -> (k, Value.get_string_latin1 v))
(Value.get_fields attrs)
in
let event = Some (E_start_tag (tag_ascii, attrs_ascii, eid)) in
stack := (Half v) :: tl;
let children = ref [] in (* TODO inefficient *)
let push v = children := v :: !children in
Value.iter_xml
(fun pcdata -> push (Other (Value.string_utf8 pcdata)))
(fun v ->
match v with
| (Value.Xml (_, _, _)) as v -> push (Fully v)
| v -> raise (Invalid_argument "Schema_xml.pxp_stream_of_value"))
v;
stack := (List.rev !children) @ !stack;
event
| (Half (Value.Xml (Value.Atom a, _, _))) :: tl ->
let (ns,a) = Atoms.V.value a in
assert( ns == Ns.empty );
let tag_ascii = Encodings.Utf8.to_string a in
let event = Some (E_end_tag (tag_ascii, eid)) in
stack := tl;
event
| (Fully (Value.Xml (_, _, _)))::_ | (Half (Value.Xml (_, _, _)))::_ ->
failwith "Schema_xml.pxp_stream_of_value: non-atom-tag xml value"
| (Other v) :: tl ->
let event = Some (E_char_data (Value.get_string_latin1 v)) in
stack := tl;
event
| [] -> None
| _ -> assert false)
in
Stream.from f
*)
open
Printf
...
...
schema/schema_xml.mli
View file @
fef69e42
open
Encodings
type
pxp_node
=
...
...
@@ -6,19 +5,7 @@ type pxp_node =
type
pxp_document
=
(
'
a
Pxp_document
.
node
Pxp_document
.
extension
as
'
a
)
Pxp_document
.
document
(** create a new Pxp configuration. This configuration will be namespace
* enabled with a brand new namespace manager containing "xsi" and "xsd"
* schema prefixes declaration *)
val
new_xsd_config
:
unit
->
Pxp_types
.
config
val
pxp_document_of
:
?
config
:
Pxp_types
.
config
->
Pxp_types
.
source
->
pxp_document
val
pxp_node_of
:
?
config
:
Pxp_types
.
config
->
Pxp_types
.
source
->
pxp_node
val
pxp_stream_of_file
:
?
config
:
Pxp_types
.
config
->
string
->
Pxp_types
.
event
Stream
.
t
(* val pxp_stream_of_value : Value.t -> Pxp_yacc.event Stream.t *)
val
pxp_node_of
:
Pxp_types
.
source
->
pxp_node
module
Pxp_helpers
:
sig
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment