[r2003-10-24 09:11:34 by szach] - added support for querying schema {attribute,model} groups

- added directive #dump_value to obtain an XMLish representation of
  cduce internal representation of values

Original author: szach
Date: 2003-10-24 09:11:34+00:00

parser/ast.ml

@@ -3,7 +3,8 @@
 open Location
 open Ident
 
-type schema_item_kind = [ `Type | `Element | `Attribute | `Any ]
+type schema_item_kind =
+  [ `Type | `Element | `Attribute | `Attribute_group | `Model_group ] option
 
 type pprog = pmodule_item list
 
@@ -31,6 +32,7 @@ and toplevel_directive =
   | `Env
   | `Reinit_ns
   | `Help
+  | `Dump of pexpr
   ]
 
 

parser/parser.ml

@@ -105,9 +105,8 @@ EXTEND
 	[ mk loc (Using (U.mk name, Types.CompUnit.mk (U.mk cu))) ]
     | "schema"; name = IDENT; "="; uri = STRING2 ->
 	protect_op "schema";
-        let schema_doc = Schema_xml.pxp_tree_of uri in
-        let schema = Schema_parser.parse_schema schema_doc in
-        [ mk loc (SchemaDecl (name, schema))]
+        let schema = Schema_parser.schema_of_file uri in
+        [ mk loc (SchemaDecl (name, schema)) ]
     | (name,ns) = namespace_binding ->
 	[ mk loc (Namespace (name, ns)) ]
     | (name,ns) = namespace_binding; "in"; e2 = expr LEVEL "top" ->
@@ -119,6 +118,7 @@ EXTEND
     | DIRECTIVE "#ascii" -> Ulexer.enc := Ulexing.Ascii; [ ]
     | DIRECTIVE "#quit" -> [ mk loc (Directive `Quit) ]
     | DIRECTIVE "#env" -> [ mk loc (Directive `Env) ]
+    | DIRECTIVE "#dump_value"; e = expr -> [ mk loc (Directive (`Dump e)) ]
     | DIRECTIVE "#reinit_ns" -> [ mk loc (Directive `Reinit_ns) ]
     | DIRECTIVE "#help" -> [ mk loc (Directive `Help) ]
     | "include"; s = STRING2 ->
@@ -452,6 +452,15 @@ EXTEND
     ]
   ];
 
+  schema_kind : [
+    [ "element" -> `Element
+    | "type" -> `Type
+    | "attribute" -> `Attribute
+    | "attribute_group" -> `Attribute_group
+    | "model_group" -> `Model_group
+    ]
+  ];
+
   pat: [ 
       [ x = pat; IDENT "where"; 
         b = LIST1 [ a = IDENT; "="; y = pat -> (ident a,y) ] SEP "and"
@@ -472,15 +481,7 @@ EXTEND
       | "("; a = IDENT; ":="; c = expr; ")" -> 
 	  mk loc (Constant (ident a,c))
       | schema = IDENT; "#"; typ = [ IDENT | keyword ];
-        k = OPT [ "as"; k = [ "element" | "type" | "attribute" ] -> k ] ->
-          let kind =
-            match k with
-            | None -> `Any
-            | Some "element" -> `Element
-            | Some "type" -> `Type
-            | Some "attribute" -> `Attribute
-            | _ -> assert false
-          in
+        kind = OPT [ "as"; k = schema_kind -> k] ->
         mk loc (SchemaVar (kind, schema, typ))
       | a = IDENT -> 
 	  mk loc (PatVar (U.mk a))