[r2006-05-29 13:35:26 by afrisch] Empty log message

Original author: afrisch
Date: 2006-05-29 13:35:26+00:00

Makefile.distrib

@@ -146,6 +146,7 @@ OBJECTS = \
  schema/schema_builtin.cmo schema/schema_validator.cmo \
  \
  types/patterns.cmo \
+ compile/print_auto.cmo \
  \
  compile/lambda.cmo \
  runtime/run_dispatch.cmo runtime/explain.cmo runtime/eval.cmo \
@@ -159,7 +160,6 @@ OBJECTS = \
  schema/schema_parser.cmo schema/schema_converter.cmo \
  runtime/load_xml.cmo runtime/print_xml.cmo compile/operators.cmo types/builtin.cmo \
  driver/librarian.cmo types/sample.cmo \
- compile/print_auto.cmo \
  driver/cduce.cmo \
  \
  runtime/system.cmo query/query_aggregates.cmo

compile/compile.ml

@@ -155,7 +155,7 @@ let compile_let_decl env decl =
   let te = decl.Typed.let_body.Typed.exp_typ in 
   let comp = 
     Patterns.Compile.make_branches 
-      (te (*Types.descr (Patterns.accept pat)*)) [ pat, () ] in
+      (te (* Types.descr (Patterns.accept pat)*)) [ pat, () ] in
   let (disp, n) = 
     match comp with
       | (disp, [| Auto_pat.Match (n, ()) |]) -> (disp,n)

types/patterns.ml

@@ -647,8 +647,9 @@ module Normal = struct
 		      (if y then Some empty_res else None))
       | Some l ->
 	  RecLabel (l,aux (Types.Record.split_normal t l)) in
-    {  nprod = aux (Types.Product.normal t);
-       nxml  = aux (Types.Product.normal ~kind:`XML t);
+    {  nprod = aux (Types.Product.clean_normal (Types.Product.normal t));
+       nxml  = 
+	aux (Types.Product.clean_normal (Types.Product.normal ~kind:`XML t));
        nrecord = record
     }
 
@@ -989,7 +990,8 @@ module Compile = struct
       incr cur_id;
       Hashtbl.add dispatcher_of_state state.uid disp;
       dispatchers := DispMap.add (t,pl) disp !dispatchers;
-(*      dump_disp disp; *)
+(*      dump_disp disp;  
+      Format.fprintf Format.std_formatter "IFACE=%a@." print_iface iface; *)
       !compute_actions disp;
       disp
     
@@ -1001,7 +1003,7 @@ module Compile = struct
 	    "IFACE=%a@." print_iface d.interface; 
 	  for i = 0 to Array.length a - 1 do
 	    Format.fprintf Format.std_formatter
-	      "a.(i)=%b@." (a.(i) != None)
+	      "a.(%i)=%b@." i (a.(i) != None)
 	  done;
 	  assert false
       | `Switch (yes,_) when a.(i) != None -> aux (i + 1) yes
@@ -1106,8 +1108,9 @@ module Compile = struct
     let idx = !idx in
 
     (* Build dispatcher *)
+(*    if Array.length reqs = 0 then print_endline "NOREQ!"; *)
     let disp = dispatcher 
-      (if Array.length reqs = 0 then Types.any else t) reqs in
+      (if Array.length reqs = 0 then Types.Record.any_or_absent else t) reqs in
     
     (* Build continuation *)
     let result (t,ar,m) =