Commit 10ff213e authored by Pietro Abate's avatar Pietro Abate

[r2005-02-01 13:10:25 by afrisch] Cleanup

Original author: afrisch
Date: 2005-02-01 13:10:26+00:00
parent 554d7f97
......@@ -210,7 +210,7 @@ OBJECTS += $(CQL_OBJECTS)
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
CDUCE = $(OBJECTS) driver/run.cmo $(CQL_OBJECTS_RUN)
CDUCE = $(OBJECTS) $(CQL_OBJECTS_RUN) driver/run.cmo
DTD2CDUCE = tools/dtd2cduce.cmo
ALL_OBJECTS = $(OBJECTS) $(NEW_SCHEMA_OBJS) \
......
......@@ -54,7 +54,7 @@ else
CAML=$(CAMLC)
endif
cduce_types: $(OBJECTS)
cduce_types.cmo: $(OBJECTS)
$(CAML) -pack -o cduce_types.$(EXT) $(INCLUDES) $^
$(CAML) -a -o cduce_types.$(EXTA) $(INCLUDES) cduce_types.$(EXT)
......@@ -62,10 +62,10 @@ HIDE=@
INCLUDES = $(DIRS:%=-I %)
types/intervals.$(EXT): types/intervals.ml cat1
types/intervals.$(EXT): types/intervals.ml cat1 types/intervals_int.ml
$(CAML) -c $(INCLUDES) -pp './cat1 types/intervals_int.ml' $<
types/intervals.cmi: types/intervals.mli cat1
types/intervals.cmi: types/intervals.mli cat1 types/intervals_int.mli
$(CAML) -c $(INCLUDES) -pp './cat1 types/intervals_int.mli' $<
misc/stats.$(EXT): misc/stats.ml
......
This diff is collapsed.
......@@ -5,6 +5,8 @@ exception Escape of exn
exception InvalidInputFilename of string
exception InvalidObjectFilename of string
let extra_specs = ref []
(* if set to false toplevel exception aren't cought.
* Useful for debugging with OCAMLRUNPARAM="b" *)
let catch_exceptions = true
......
......@@ -3,6 +3,8 @@ exception Escape of exn
val toplevel: bool ref
val verbose: bool ref
val extra_specs: (string * Arg.spec * string) list ref
val script : Format.formatter -> Format.formatter -> char Stream.t -> bool
val topinput : Format.formatter -> Format.formatter -> char Stream.t -> bool
......
......@@ -29,7 +29,7 @@ been modified from the original Q Public.\n\n
";
exit 0
let specs = ref
let specs =
[ "--compile", Arg.Set compile,
"compile the given CDuce file";
"--run", Arg.Set run,
......@@ -78,7 +78,7 @@ let err s =
exit 1
let mode () =
Arg.parse !specs (fun s -> src := s :: !src)
Arg.parse (specs @ !Cduce.extra_specs) (fun s -> src := s :: !src)
"Usage:\ncduce [OPTIONS ...] [FILE ...] [--arg argument ...]\n\nOptions:";
match (!compile,!out_dir,!run,!src,!args) with
| false, _::_, _, _, _ ->
......@@ -203,9 +203,5 @@ let main () =
Cduce.run f
let () =
(* Hum... *)
let b = ref true in
at_exit (fun () -> if !b then (b := false; main ()));
at_exit (fun () -> Stats.dump Format.std_formatter)
at_exit (fun () -> Stats.dump Format.std_formatter);
main ()
......@@ -21,7 +21,7 @@ module Timer = struct
}
let print ppf c =
Format.fprintf ppf "Timer %s. Total time: %f. Count: %i@\n"
Format.fprintf ppf "Timer %s. Total time: %f. Count: %i@."
c.name c.total c.count
let create s =
......@@ -49,7 +49,7 @@ module Counter = struct
}
let print ppf c =
Format.fprintf ppf "Counter %s: %i@\n"
Format.fprintf ppf "Counter %s: %i@."
c.name c.count
let create s =
......
let () = Run.specs := !Run.specs @
[ "--noquery-optim", Arg.Set Query.nooptim,
" do not optimize queries " ]
let () = Cduce.extra_specs :=
( "--noquery-optim", Arg.Set Query.nooptim,
" do not optimize queries " ) ::
!Cduce.extra_specs
......@@ -97,7 +97,23 @@ let print =
| false,true -> Format.fprintf ppf "%i--*" a
)
let add l1 l2 = any
let may_add x y =
(x = 0) || (y = 0) || (
if (x > 0) && (y > 0) then x + y > y
else if (x < 0) && (y < 0) then x + y < y
else true
)
let add l1 l2 =
List.fold_left
(fun accu (a,b) ->
List.fold_left
(fun accu (c,d) ->
if (may_add a c) && (may_add b d) then iadd accu (a+c,b+d)
else any)
accu l2)
[] l1
let negat l = any
let sub l1 l2 = any
let mul l1 l2 = any
......
......@@ -1115,6 +1115,9 @@ struct
let dispatchers = ref DispMap.empty
let generated = ref 0
let to_generate = ref []
let timer_disp = Stats.Timer.create "Patterns.dispatcher loop"
let rec print_iface ppf = function
......@@ -1253,15 +1256,16 @@ struct
!accu
let first_lab pl =
let first_lab t pl =
let aux l (req,_) = min l (Normal.Nnf.first_label req) in
let lab = Array.fold_left (List.fold_left aux) LabelPool.dummy_max pl in
let lab = min lab (Types.Record.first_label t) in
if lab == LabelPool.dummy_max then None else Some lab
let get_tests facto pl f t d post =
let pl = Array.map (List.map f) pl in
let lab = first_lab pl in
let lab = first_lab t pl in
let pl = Array.map (List.map (fun (x,info) -> Normal.nnf facto lab t x,info)) pl
in
(* Collect all subrequests *)
......@@ -1364,6 +1368,22 @@ struct
| _ -> assert false) disp.pl in
Some (RecLabel (lab,dispatch_prod0 disp t pl))
let iter_disp_disp f g = function
| Dispatch (d,a) -> f d; Array.iter g a
| TailCall d -> f d
| Ignore a -> g a
| Impossible -> ()
let iter_disp_prod f = iter_disp_disp f (iter_disp_disp f (fun _ -> ()))
let rec iter_disp_actions f = function
| AIgnore _ -> ()
| AKind k ->
iter_disp_prod f k.prod;
iter_disp_prod f k.xml;
(match k.record with Some (RecLabel (_,p)) -> iter_disp_prod f p
| _ -> ())
let actions disp =
match disp.actions with
| Some a -> a
......@@ -1375,10 +1395,14 @@ struct
(dispatch_record disp)
in
disp.actions <- Some a;
iter_disp_actions (fun d -> to_generate := d :: !to_generate) a;
incr generated;
a
let to_print = ref []
module DSET = Set.Make (struct type t = int let compare (x:t) (y:t) = x - y end)
let printed = ref DSET.empty
......@@ -1555,7 +1579,20 @@ struct
| _ -> assert false
) pl) in
show ppf t pl lab;
(* Format.fprintf ppf "# compiled dispatchers: %i@\n" !cur_id *)
Format.fprintf ppf "# compiled states: %i@\n" !generated
let () =
Stats.register Stats.Summary
(fun ppf ->
let i = !generated in
Format.fprintf ppf "Number of compiled states: %i@." i;
while !to_generate != [] do
let d = List.hd !to_generate in
to_generate := List.tl !to_generate;
ignore (actions d)
done;
let j = !generated in
Format.fprintf ppf "Total number of states: %i@." j)
end
......
......@@ -454,6 +454,8 @@ type descr = Descr.t
type node = Node.t
include Descr
let forward_print = ref (fun _ _ -> assert false)
let hash_cons = DescrHash.create 17000
let count = State.ref "Types.count" 0
......@@ -1657,6 +1659,8 @@ struct
DescrHash.clear memo
let print_node ppf n = print ppf (descr n)
let () = forward_print := print
end
module Positive =
......
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