Commits

Anonymous committed c84aacb

Updated for OCaml 3.09 and Cf-0.8.

  • Participants
  • Parent commits d673174

Comments (0)

Files changed (9)

-  Copyright (c) 2002-2005, James H. Woodyatt
+  Copyright (c) 2002-2006, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without

File xml/Makefile

 # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
 # OF THE POSSIBILITY OF SUCH DAMAGE. 
 
-DEBUG_OPT = -g -passopt -principal -warn-error A
 REQUIRE = cf
 PREDICATES =
 
 OCAMLDEP     = ocamldep
 OCAMLLEX     = ocamllex
 OCAMLYACC    = ocamlyacc
+OCAMLDOC     = ocamlfind ocamldoc $(OCAMLFINDOPT)
 
-CC_OPT       = -ccopt -fPIC -ccopt -O2 -ccopt -Wall -ccopt -Wno-unused-variable
-CMI_OPT      = $(DEBUG_OPT)
-CMO_OPT      = $(DEBUG_OPT)
-CMX_OPT      = -unsafe -noassert -inline 9
+DEBUG_OPT    = -g
+WARN_ERROR   = -passopt -w -passopt Ae # -warn-error A
+PRINCIPLE    = -principal
+UNSAFE       = -unsafe -noassert
 
-CMA_OPT      =
-CMXA_OPT     =
+ALL_OCAML_OPT = $(WARN_ERROR) $(PRINCIPLE)
+
+CC_OPT  = -ccopt -fPIC -ccopt -O2 -ccopt -Wall -ccopt -Wno-unused-variable
+CMI_OPT = $(ALL_OCAML_OPT) $(DEBUG_OPT)
+CMO_OPT = $(ALL_OCAML_OPT) $(DEBUG_OPT)
+CMX_OPT = $(ALL_OCAML_OPT) $(UNSAFE) -inline 9
 
 .SUFFIXES: .ml .mli .mll .mly .cmo .cmi .cma .cmx .cmxa
 
 XML_YACC_MODULES = $(XML_LEXYACC_MODULES:%=xml_yacc_%)
 XML_LEX_MODULES = $(XML_LEXYACC_MODULES:%=xml_lex_%)
 
-clean::
-	rm -rf $(XML_LEX_ML_FILES)
-	rm -rf $(XML_YACC_ML_FILES)
-	rm -rf $(XML_YACC_MLI_FILES)
+#clean::
+#	rm -rf $(XML_LEX_ML_FILES)
+#	rm -rf $(XML_YACC_ML_FILES)
+#	rm -rf $(XML_YACC_MLI_FILES)
 
 xml_lex_%.cmo : xml_yacc_%.cmi xml_lex_%.cmi
 xml_lex_%.cmx : xml_yacc_%.cmi xml_lex_%.cmi
   $(XML_O_FILES)
 	$(OCAMLMKLIB) -o xml $(XML_CMX_FILES) -lxml -lexpat
 
-install:: libxml.a dllxml.so xml.cma xml.cmxa xml.a
+install:: libxml.a dllxml.so xml.cma
 	{ test ! -f xml.cmxa || extra="xml.cmxa xml.a"; }; \
 	ocamlfind install xml \
 	  $(XML_P_H_FILES) $(XML_MLI_FILES) $(XML_CMI_FILES) \
 
 opt:: $(TEST_OPT_PROGRAMS)
 
-t.% : t/t_%.ml xml.cma
-	$(OCAMLC) $(DEBUG_OPT) $(TEST_LINKOPT) -o $@ $(TEST_LIBS:%=%.cma) $<
+t.% : t/t_%.ml $(TEST_LIBS:%=%.cma)
+	$(OCAMLC) -o $@ $(CMO_OPT) $(DEBUG_OPT) $(TEST_LINKOPT) \
+        $(TEST_LIBS:%=%.cma) $<
 
-t-opt.% : t/t_%.ml xml.cmxa
-	$(OCAMLOPT) $(TEST_LINKOPT) -o $@ $(TEST_LIBS:%=%.cmxa) $<
+t-opt.% : t/t_%.ml $(TEST_LIBS:%=%.cmxa)
+	$(OCAMLOPT) -o $@ $(CMX_OPT) $(TEST_LINKOPT) $(TEST_LIBS:%=%.cmxa) $<
 
 test:: $(TEST_PROGRAMS)
 	@for i in $(TEST_PROGRAMS); do echo; echo $$i; ./$$i; done
 
 default:: ocamltop
 
-ocamltop: xml.cma
-	$(OCAMLMKTOP) $(TEST_LINKOPT) -o $@ xml.cma
+ocamltop: $(TEST_LIBS:%=%.cma)
+	$(OCAMLMKTOP) -o $@ $(CMO_OPT) $(TEST_LINKOPT) $(TEST_LIBS:%=%.cma)
 
 clean::
 	rm -f ocamltop

File xml/t/t_xml.ml

 (*---------------------------------------------------------------------------*
   IMPLEMENTATION  t_xml.ml
 
-  Copyright (c) 2003-2005, James H. Woodyatt
+  Copyright (c) 2003-2006, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
 
 Random.self_init ();;
 
-(*
 let jout = Cf_journal.stdout
-let _ = jout#setlimit `None
-*)
+(* let _ = jout#setlimit `None *)
 
 (*
 Gc.set {
 end
 
 module type X = sig
-    val printf: ('a, out_channel, unit) format -> 'a
+    val bprintf: Buffer.t -> ('a, Buffer.t, unit, unit) format4 -> 'a
     val sprintf: ('a, unit, string) format -> 'a
 end
 
 module X_create(T: X_tag): X = struct
-    let printf fmt =
+    let bprintf b fmt =
         let tag = "[" ^^ (T.tag ()) ^^ "] " in
-        Printf.printf (tag ^^ fmt)
+        Printf.bprintf b (tag ^^ fmt)
 
     let sprintf fmt =
         let tag = "[" ^^ (T.tag ()) ^^ "] " in
             </foo>\r\n"
         in
         let factory = parser_factory () in
-        (*
         let preamble ~p =
             let x1, x2, x3 ,x4 =
                 get_current_byte_index p,
                 get_current_column_number p,
                 get_current_line_number p
             in
-            X.printf " {i=%nd,n=%nd,c=%nd,l=%nd}:\t" x1 x2 x3 x4
+            let b = Buffer.create 80 in
+            X.bprintf b " {i=%nd,n=%nd,c=%nd,l=%nd}:\t" x1 x2 x3 x4;
+            b
         in
-        *)
         let startHandler ~p tag attr =
-            (*
-            preamble ~p;
-            Printf.printf "<%s" tag;
-            List.iter (fun (n, v) -> Printf.printf " %s='%s'" n v) attr;
-            Printf.printf ">\n";
-            flush stdout;
-            *)
-            ()
+            assert begin
+                let b = preamble ~p in
+                Printf.bprintf b "<%s" tag;
+                List.iter (fun (n, v) -> Printf.bprintf b " %s='%s'" n v) attr;
+                Printf.bprintf b ">\n";
+                jout#debug "%s" (Buffer.contents b)
+            end
         and endHandler ~p tag =
-            (*
-            preamble ~p;
-            Printf.printf "</%s>\n" tag;
-            flush stdout
-            *)
-            ()
+            assert begin
+                let b = preamble ~p in
+                Printf.bprintf b "</%s>\n" tag;
+                jout#debug "%s" (Buffer.contents b)
+            end
         and characterDataHandler ~p data =
-            (*
-            preamble ~p;
-            Printf.printf "%s\n" data;
-            flush stdout
-            *)
-            ()
+            assert begin
+                let b = preamble ~p in
+                Printf.bprintf b "%s\n" data;
+                jout#debug "%s" (Buffer.contents b)
+            end
         and xmlDeclHandler ~p ?version ?encoding standalone =
-            (*
-            preamble ~p;
-            Printf.printf "<?xml";
-            begin
-                match version with
-                | Some str -> Printf.printf " version='%s'" str
-                | None -> ()
-            end;
-            begin
-                match encoding with
-                | Some str -> Printf.printf " encoding='%s'" str
-                | None -> ()
-            end;
-            begin
-                match standalone with
-                | SA_implied -> ()
-                | SA_no -> Printf.printf " standalone='no'"
-                | SA_yes -> Printf.printf " standalone='yes'"
-            end;
-            Printf.printf "?>\n";
-            flush stdout
-            *)
-            ()
+            assert begin
+                let b = preamble ~p in
+                Printf.bprintf b "<?xml";
+                begin
+                    match version with
+                    | Some str -> Printf.bprintf b " version='%s'" str
+                    | None -> ()
+                end;
+                begin
+                    match encoding with
+                    | Some str -> Printf.bprintf b " encoding='%s'" str
+                    | None -> ()
+                end;
+                begin
+                    match standalone with
+                    | SA_implied -> ()
+                    | SA_no -> Printf.bprintf b " standalone='no'"
+                    | SA_yes -> Printf.bprintf b " standalone='yes'"
+                end;
+                Printf.bprintf b "?>\n";
+                jout#debug "%s" (Buffer.contents b)
+            end
         and processingInstructionHandler ~p target data =
-            (*
-            preamble ~p;
-            Printf.printf "<?%s %s?>\n" target data;
-            flush stdout
-            *)
-            ()
+            assert begin
+                let b = preamble ~p in
+                Printf.bprintf b "<?%s %s?>\n" target data;
+                jout#debug "%s" (Buffer.contents b)
+            end
         in
         try
             let p = parser_create factory in
-            (*
-            preamble p;
-            Printf.printf "//\\//\\//\\//\\//\\//\\ begin\n";
-            flush stdout;
-            *)
+            assert begin
+                let b = preamble ~p in
+                Printf.bprintf b "//\\//\\//\\//\\//\\//\\ begin\n";
+                jout#debug "%s" (Buffer.contents b);
+            end;
             set_handler_element_start p (Some (startHandler ~p));
             set_handler_element_end p (Some (endHandler ~p));
             set_handler_character_data p (Some (characterDataHandler ~p));
                 p (Some (processingInstructionHandler ~p));
             set_handler_xml_decl p (Some (xmlDeclHandler ~p));
             parse_string p document Final;
-            (*
-            preamble p;
-            Printf.printf "//\\//\\//\\//\\//\\//\\ end\n";
-            flush stdout;
-            *)
+            assert begin
+                let b = preamble ~p in
+                Printf.bprintf b "//\\//\\//\\//\\//\\//\\ end\n";
+                jout#debug "%s" (Buffer.contents b);
+            end;
             parser_recycle factory p
         with
         | Error code ->
                const_parser (acc' + ((int_of_char hd) - (int_of_char '0'))) tl
             else
                 None
-        | Cf_seq.P (hd, tl) ->
+        | Cf_seq.P _ ->
             None
     
     let foo_element =

File xml/xml_event.ml

 (*---------------------------------------------------------------------------*
   IMPLEMENTATION  cf_event.ml
 
-  Copyright (c) 2003-2005, James H. Woodyatt
+  Copyright (c) 2003-2006, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
 
 type t = token_t * position_t
 
-(*
-let log = Cf_journal.stdout
-*)
-
 let rec queue_drain_ q =
     lazy begin
         try
-            let token, _ as event = Queue.take q in
-            (* assert (log#debug "Xml_event: %s" (token_to_string token)); *)
+            let event = Queue.take q in
             Cf_seq.P (event, queue_drain_ q)
         with
         | Queue.Empty ->

File xml/xml_event.mli

 (*---------------------------------------------------------------------------*
   INTERFACE  cf_event.mli
 
-  Copyright (c) 2003-2005, James H. Woodyatt
+  Copyright (c) 2003-2006, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without

File xml/xml_expat.ml

 (*---------------------------------------------------------------------------*
   IMPLEMENTATION  xml_expat.ml
 
-  Copyright (c) 2003-2005, James H. Woodyatt
+  Copyright (c) 2003-2006, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without

File xml/xml_expat.mli

 (*---------------------------------------------------------------------------*
   INTERFACE  xml_expat.mli
 
-  Copyright (c) 2003-2005, James H. Woodyatt
+  Copyright (c) 2003-2006, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without

File xml/xml_parser.ml

 (*---------------------------------------------------------------------------*
   IMPLEMENTATION  xml_parser.ml
 
-  Copyright (c) 2003-2005, James H. Woodyatt
+  Copyright (c) 2003-2006, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
   OF THE POSSIBILITY OF SUCH DAMAGE. 
  *---------------------------------------------------------------------------*)
 
-(*
-module X = struct
-    let tag = "[Xml_parser] "
-    
-    let printf fmt =
-        print_string tag;
-        Printf.printf fmt
-    
-    let sprintf (fmt : ('a, unit, string) format) =
-        Printf.sprintf (Obj.magic (tag ^ (Obj.magic fmt)))
-end
-*)
-
-(*
-let jout = Cf_journal.stdout
-*)
-
 type 'a t = (Xml_event.t, 'a) Cf_parser.t
 
 open Cf_parser.Op
         else
             match String.unsafe_get s i with
             | ' ' | '\t' | '\r' | '\n' -> loop s n (succ i)
-            | ch -> false
+            | _ -> false
     in
     fun seq -> get seq
 
             None
     and e_end seq =
         match Lazy.force seq with
-        | Cf_seq.P ((Xml_event.T_element_end tag', pos as event), tl) ->
+        | Cf_seq.P ((Xml_event.T_element_end tag', _ as event), tl) ->
             if tag = tag' then Some ((), tl) else raise (Invalid event)
         | _ ->
             None

File xml/xml_parser.mli

 (*---------------------------------------------------------------------------*
   INTERFACE  xml_parser.mli
 
-  Copyright (c) 2003-2005, James H. Woodyatt
+  Copyright (c) 2003-2006, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without