Commit 525092fe authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-11-20 11:37:57 by szach] added support for #print_{type,schema} directives

Original author: szach
Date: 2003-11-20 11:37:57+00:00
parent 3447d2e5
......@@ -3,9 +3,6 @@
open Location
open Ident
type schema_item_kind =
[ `Type | `Element | `Attribute | `Attribute_group | `Model_group ] option
type pprog = pmodule_item list
and pmodule_item = pmodule_item' located
......@@ -33,6 +30,9 @@ and toplevel_directive =
| `Reinit_ns
| `Help
| `Dump of pexpr
| `Print_schema of string
| `Print_schema_type of Schema_types.component_kind * string * string
| `Print_type of string
]
......@@ -59,7 +59,8 @@ and pexpr =
| Map of pexpr * branches
| Transform of pexpr * branches
| Xtrans of pexpr * branches
| Validate of pexpr * string * string (* exp, schema name, element name *)
| Validate of pexpr * Schema_types.component_kind * string * string
(* exp, schema component kind, schema name, element name *)
| Dot of pexpr * label
| RemoveField of pexpr * label
......@@ -90,7 +91,7 @@ and ppat = ppat' located
and ppat' =
| PatVar of U.t
| SchemaVar of (* type/pattern schema variable *)
schema_item_kind * string * string
Schema_types.component_kind * string * string (* kind, schema, name *)
| Cst of pexpr
| NsT of U.t
| Recurs of ppat * (id * ppat) list
......
......@@ -118,6 +118,18 @@ EXTEND
| DIRECTIVE "#ascii" -> Ulexer.enc := Ulexing.Ascii; [ ]
| DIRECTIVE "#quit" -> [ mk loc (Directive `Quit) ]
| DIRECTIVE "#env" -> [ mk loc (Directive `Env) ]
| DIRECTIVE "#print_schema"; name = IDENT ->
[ mk loc (Directive (`Print_schema name)) ]
| DIRECTIVE "#print_type"; name = IDENT;
schema_part = OPT [
"#"; typ = [ IDENT | keyword ];
kind = OPT [ "as"; k = schema_kind -> k] ->
(kind, typ)
] ->
(match schema_part with
| None -> [ mk loc (Directive (`Print_type name)) ]
| Some (kind, typ) ->
[ mk loc (Directive (`Print_schema_type (kind, name, typ))) ])
| DIRECTIVE "#dump_value"; e = expr -> [ mk loc (Directive (`Dump e)) ]
| DIRECTIVE "#reinit_ns" -> [ mk loc (Directive `Reinit_ns) ]
| DIRECTIVE "#help" -> [ mk loc (Directive `Help) ]
......@@ -193,9 +205,8 @@ EXTEND
exp loc (Match (e, [p1,e1; p2,e2]))
| "transform"; e = SELF; "with"; b = branches ->
exp loc (Transform (e,b))
| "validate"; e = SELF; "with"; schema = IDENT; "#";
typ = [ IDENT | keyword ] ->
exp loc (Validate (e, schema, typ))
| "validate"; e = SELF; "with"; (kind, schema, typ) = schema_ref ->
exp loc (Validate (e, kind, schema, typ))
| "fun"; (f,a,b) = fun_decl ->
exp loc (Abstraction { fun_name = f; fun_iface = a; fun_body = b })
| (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
......@@ -461,6 +472,13 @@ EXTEND
]
];
schema_ref: [
[ schema = IDENT; "#"; typ = [ IDENT | keyword ];
kind = OPT [ "as"; k = schema_kind -> k] ->
(kind, schema, typ)
]
];
pat: [
[ x = pat; IDENT "where";
b = LIST1 [ a = IDENT; "="; y = pat -> (ident a,y) ] SEP "and"
......@@ -482,7 +500,7 @@ EXTEND
mk loc (Constant (ident a,c))
| schema = IDENT; "#"; typ = [ IDENT | keyword ];
kind = OPT [ "as"; k = schema_kind -> k] ->
mk loc (SchemaVar (kind, schema, typ))
mk loc (SchemaVar (kind, schema, typ))
| a = IDENT ->
mk loc (PatVar (U.mk a))
| i = INT ; "--"; j = INT ->
......
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