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