Commit 0bd522f4 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-11-20 11:42:32 by szach] invoke schema validation stubs

Original author: szach
Date: 2003-11-20 11:42:32+00:00
parent 5b582d33
......@@ -48,7 +48,8 @@ let rec eval env e0 = match e0.Typed.exp_descr with
| Typed.RemoveField (e, l) -> eval_remove_field l (eval env e)
| Typed.UnaryOp (op,e) -> !eval_unary_op op (eval env e)
| Typed.BinaryOp (op,e1,e2) -> !eval_binary_op op (eval env e1) (eval env e2)
| Typed.Validate (e, schema, name) -> eval_validate env e schema name
| Typed.Validate (e, kind, schema, name) ->
eval_validate env e kind schema name
| Typed.Ref (e,t) -> eval_ref env e t
......@@ -61,8 +62,18 @@ and eval_ref env e t=
([Types.descr t, Sequence.nil_type], fun x -> r := x; nil) in
Record (Builtin_defs.mk_ref ~get ~set)
and eval_validate env e schema name =
raise (CDuceExn (string_latin1 "validate: not implemented"))
and eval_validate env e kind schema_name name =
let schema = Typer.get_schema schema_name in
let validate =
match Schema_common.get_component kind name schema with
| Schema_types.Type x -> Schema_validator.validate_type x
| Schema_types.Element x -> Schema_validator.validate_element x
| Schema_types.Attribute x -> Schema_validator.validate_attribute x
| Schema_types.Attribute_group x ->
Schema_validator.validate_attribute_group x
| Schema_types.Model_group x -> Schema_validator.validate_model_group x
in
validate (eval env e)
and eval_try env arg brs =
try eval env arg
......@@ -363,7 +374,7 @@ let rec eval env = function
let v1 = eval env e1 in
let v2 = eval env e2 in
!eval_binary_op op v1 v2
| Validate (e, schema, name) -> eval_validate env e schema name
| Validate (e, kind, schema, name) -> eval_validate env e kind schema name
| Ref (e,t) -> eval_ref env e t
and eval_abstraction env slots iface body =
......@@ -426,13 +437,9 @@ and eval_ref env e t=
([Types.descr t, Sequence.nil_type], fun x -> r := x; nil) in
Value.Record (Builtin_defs.mk_ref ~get ~set)
and eval_validate env e schema name =
raise (CDuceExn (string_latin1 "validate: not implemented"))
(*
let validator = Typer.get_schema_validator (schema, name) in
Schema_validator.validate ~validator
(Schema_xml.pxp_stream_of_value (eval env e))
*)
and eval_validate env e kind schema_name name =
raise (CDuceExn (string_latin1
"validate: not implemented for compiled expressions"))
and eval_try env arg brs =
let saved_frame = !frame and saved_sp = !sp in
......
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