Commit 9ef60e2b authored by Pietro Abate's avatar Pietro Abate

[r2003-11-21 09:27:59 by afrisch] Opt

Original author: afrisch
Date: 2003-11-21 09:27:59+00:00
parent 5a075557
......@@ -127,7 +127,7 @@ OBJECTS = \
\
types/builtin.cmo driver/librarian.cmo driver/cduce.cmo \
\
query/query_parse.cmo
# query/query_parse.cmo
VALIDATE_OBJECTS := $(shell for o in $(OBJECTS); do echo $$o; if [ "$$o" = "schema/schema_parser.cmo" ]; then exit 0; fi; done) # all objects until schema_parser.cmo
......@@ -158,7 +158,7 @@ webiface: $(WEBIFACE:.cmo=.$(EXTENSION))
dtd2cduce: $(DTD2CDUCE:.cmo=.$(EXTENSION))
$(LINK) $(INCLUDES) -o $@ $^
validate: $(VALIDATE_OBJECTS) tools/validate.cmo
validate: $(VALIDATE_OBJECTS:.cmo=.$(EXTENSION)) tools/validate.$(EXTENSION)
$(LINK) $(INCLUDES) -o $@ $^
.PHONY: compute_depend
......
......@@ -95,9 +95,6 @@ let rec print_exn ppf = function
| Value.CDuceExn v ->
Format.fprintf ppf "Uncaught CDuce exception: @[%a@]@."
print_value v
| Eval.MultipleDeclaration v ->
Format.fprintf ppf "Multiple declaration for global value %a@."
U.print (Id.value v)
| Typer.WrongLabel (t,l) ->
Format.fprintf ppf "Wrong record selection; field %a "
Label.print (LabelPool.value l);
......
......@@ -2,7 +2,6 @@ open Value
open Run_dispatch
open Ident
exception MultipleDeclaration of id
type env = t Env.t
let empty = Env.empty
......@@ -289,7 +288,14 @@ let dispatcher brs =
match brs.brs_compiled with
| Some d -> d
| None ->
(* Format.fprintf Format.std_formatter "Start compilation...@.";
let time = Unix.gettimeofday() in*)
let x = Patterns.Compile.make_branches brs.brs_input brs.brs in
(* let time = Unix.gettimeofday() -. time in
if time > 1.0 then
Format.fprintf Format.std_formatter "%a@."
Patterns.Compile.print_dispatcher (fst x);
Format.fprintf Format.std_formatter "(%f ms).@." time; *)
brs.brs_compiled <- Some x;
x
......
open Value
open Ident
exception MultipleDeclaration of id
type env
val empty: env
......
......@@ -872,30 +872,53 @@ struct
(* Try with a hash-table ! *)
let dispatchers = ref DispMap.empty
let timer_disp = Stats.Timer.create "Patterns.dispatcher loop"
let dispatcher t pl lab : dispatcher =
try DispMap.find (t,pl) !dispatchers
with Not_found ->
let nb = ref 0 in
let codes = ref [] in
let rec aux t arity i accu =
if Types.is_empty t then `None
if i == Array.length pl
then (incr nb; codes := (t,arity,accu)::!codes; `Result (!nb - 1))
else
if i == Array.length pl
then (incr nb; codes := (t,arity,accu)::!codes; `Result (!nb - 1))
let p = pl.(i) in
let tp = p.Normal.na in
(* let tp = Types.normalize tp in *)
let a1 = Types.cap t tp in
if Types.is_empty a1 then
`Switch (`None,aux t arity (i+1) accu)
else
let p = pl.(i) in
let tp = p.Normal.na in
let v = p.Normal.nfv in
(* let tp = Types.normalize tp in *)
let a2 = Types.diff t tp in
let accu' = (i,IdMap.num arity v) :: accu in
if Types.is_empty a2 then
`Switch (aux t (arity + (IdSet.length v)) (i+1) accu',`None)
else
`Switch (aux a1 (arity + (IdSet.length v)) (i+1) accu',
aux a2 arity (i+1) accu)
(* Unopt version:
`Switch
(
aux (Types.cap t tp) (arity + (IdSet.length v)) (i+1) accu',
aux (Types.diff t tp) arity (i+1) accu
)
*)
in
let iface = aux t 0 0 [] in
(* Array.iteri (fun i p ->
Format.fprintf Format.std_formatter
"Pattern %i/%i accepts %a@." i (Array.length pl)
Types.Print.print p.Normal.na) pl; *)
Stats.Timer.start timer_disp;
let iface =
if Types.is_empty t then `None else aux t 0 0 [] in
Stats.Timer.stop timer_disp ();
let res = { id = !cur_id;
t = t;
label = lab;
......@@ -1029,6 +1052,10 @@ struct
List.fold_left
(fun (t,brs) (p,e) ->
let p' = (Normal.NodeSet.singleton p,t) in
(* let td = Types.descr (accept p) in
let t' =
if Types.is_empty (Types.cap t td) then t else
Types.diff t td in*)
let t' = Types.diff t (Types.descr (accept p)) in
(t', (p',(fv_list p, e)) :: brs)
) (t,[]) brs in
......
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