Commit 60f9f5e4 authored by Pietro Abate's avatar Pietro Abate

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

Original author: afrisch
Date: 2006-05-29 13:35:26+00:00
parent 18653abc
......@@ -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
......
......@@ -30,7 +30,7 @@ and 'a dispatch =
and state = {
uid : int;
arity : int array;
arity : int array;
mutable actions: actions;
mutable fail_code: int;
mutable expected_type: string;
......
......@@ -152,10 +152,10 @@ let compile_let_decl env decl =
let e,lsize = compile_expr env decl.Typed.let_body in
let env = enter_globals env (Patterns.fv pat) in
let te = decl.Typed.let_body.Typed.exp_typ in
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)
......
......@@ -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) =
......@@ -1204,7 +1207,7 @@ module Compile = struct
"make_branches t=%a #branches=%i@." Types.Print.print t (List.length brs); *)
let pl = Array.map aux (Array.of_list brs) in
let disp,rhs = get_tests true pl (fun x -> x) t res (fun x -> x) in
let state = add_factorized disp rhs in
let state = add_factorized disp rhs in
state,
(Array.map
(function Match (n,(_,_,_,e)) -> Match (n,e) | Fail -> Fail) rhs)
......@@ -1228,14 +1231,14 @@ module Compile = struct
let dispatch_prod disp pl =
let t = Types.Product.get disp.t in
if t == [] then Impossible else
if t == [] then Impossible else
dispatch_prod0 disp t
(Array.map (fun p -> Normal.NLineProd.elements p.Normal.nprod) pl)
(* dispatch_prod0 disp t (Array.map Normal.prod_tests disp.pl) *)
let dispatch_xml disp pl =
let t = Types.Product.get ~kind:`XML disp.t in
if t == [] then Impossible else
if t == [] then Impossible else
dispatch_prod0 disp t
(Array.map (fun p -> Normal.NLineProd.elements p.Normal.nxml) pl)
......
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