[r2002-11-01 21:16:09 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-01 21:16:09+00:00

Makefile

 # Source directories 
 
 DIRS = parser typing types runtime driver
+CLEAN_DIRS = $(DIRS) tools tests
 
 # Objects to build
 
@@ -61,6 +62,9 @@ toplevel: $(OBJECTS) $(TOPLEVEL)
 dtd2cduce: tools/dtd2cduce.cmo
 	$(OCAMLC) $(DEBUG) -linkpkg -o $@ $<
 
+pull: tools/pull.cmo
+	$(OCAMLC) $(DEBUG) -linkpkg -o $@ $<
+
 cduce.opt: all.cmxa $(XDRIVER)
 	$(OCAMLOPT) -linkpkg -o $@ gramlib.cmxa $(XOBJECTS) $(XDRIVER)
 
@@ -72,11 +76,12 @@ run_top: all.cma
 	ledit ocaml $(INCLUDES) `ocamlfind use pxp` all.cma
 
 clean:
-	for i in $(DIRS); do \
+	for i in $(CLEAN_DIRS); do \
 	(cd $$i; rm -f *.cmi *.cmo *.cma *.cmx *.o *~); \
 	done
 	rm -f *.cmi *.cmo *.cma *.cmx *.a *.cmxa *.o *~
-	rm -f cduce cduce.opt
+	rm -f cduce cduce.opt ocamlprof.dump
+	rm -f dtd2cduce pool
 	rm -Rf prepro
 
 

parser/parser.ml

@@ -71,7 +71,7 @@ EXTEND
 	  (mk noloc (Capture "x"),
 	   mk noloc (Op ("raise",[mk noloc (Var "x")]))) in
 	mk loc (Try (e,b@[default]))
-    | "map"; e = SELF; "with"; b = branches -> mk loc (Map (e,b))
+    | LIDENT "map"; e = SELF; "with"; b = branches -> mk loc (Map (e,b))
     | "transform"; e = SELF; "with"; b = branches -> 
 	mk noloc (Op ("flatten", [mk loc (Map (e,b))]))
     | "fun"; (f,a,b) = fun_decl ->

runtime/load_xml.ml

@@ -65,5 +65,8 @@ let run s =
       | E_start_tag (name,att,_) ->  get (); parse_elt name att
       | _ -> get (); parse_doc ()
   in
+  prerr_endline "load_xml: start";
   get ();
-  parse_doc ()
+  let r = parse_doc () in
+  prerr_endline "load_xml: done";
+  r

tools/dtd2cduce.ml

+(* TODO: 
+    - attributes ! 
+    - clever factorizations of content model and attribute specifs
+         (e.g.  type XHTML_inlien = [ ( Char | ... ) ])
+    - better pretty-printing
+*)
+
 open Pxp_yacc
 open Pxp_lexer_types
 open Pxp_types
 
 let import_dtd ppf name filename =
-  let config = default_config in
-  let mgr = create_entity_manager config (from_file filename) in
-  let next_event = 
-    create_pull_parser config (`Entry_document [`Extend_dtd_fully]) mgr in
-  let event = ref (Some E_end_of_stream) in
-
   let rec regexp ppf = function
     | Optional re -> Format.fprintf ppf "%a?" regexp re
     | Repeated re -> Format.fprintf ppf "%a*" regexp re
@@ -32,11 +33,11 @@ let import_dtd ppf name filename =
 		  (function 
 		     | MPCDATA -> "Char"
 		     | MChild s -> name s) l in
-	Format.fprintf ppf "(%s)*" (String.concat " | " l)
+	Format.fprintf ppf "( %s )*" (String.concat " | " l)
     | Regexp r -> regexp ppf r
   in    
   let elt ppf e = 
-    Format.fprintf ppf "type %s = <%s>[@[%a@]];;@\n" 
+    Format.fprintf ppf "type @[<2>%s =@ @[<3><%s>[@ @[%a@]@ ]@]@];;@\n" 
       (name (e # name))
       (e # name)
       content (e # content_model)
@@ -47,6 +48,18 @@ let import_dtd ppf name filename =
 	exit 1
     | _ -> ()
   in
+
+
+  let config = default_config in
+  let mgr = create_entity_manager config (from_file filename) in
+  let next_event = 
+    create_pull_parser config (`Entry_document [`Extend_dtd_fully]) mgr in
+  let event = ref (Some E_end_of_stream) in
+
+  Format.fprintf ppf 
+    "(* This type has been automatically generated from %s by dtd2cduce *)@\n"
+    filename;
+
   let rec loop () =
     match next_event () with
       | None -> ()

types/IDEAS

@@ -24,3 +24,7 @@
 
 - Convert:  (e1,e2) @ e3   =====>   (e1,e2 @ e3)
   _before_ typing (to better propagate type information downto e1)
+
+
+- Problem with parser:  keyword and tags may collide ...
+  ex: <map>  in XHTML

typing/typer.ml

@@ -73,7 +73,6 @@ let cons loc d =
 *)
     
 module Regexp = struct
-  let memo = Hashtbl.create 51
   let defs = ref []
   let name =
     let c = ref 0 in