Commit a3b8ff22 authored by Pietro Abate's avatar Pietro Abate

[r2005-06-15 15:28:42 by afrisch] Empty log message

Original author: afrisch
Date: 2005-06-15 15:28:42+00:00
parent 49cb737a
......@@ -605,6 +605,8 @@ module Normal = struct
(fun l p -> min l (first_label (descr p)))
(Types.Record.first_label t)
pl
end
module NBasic = struct
......@@ -816,8 +818,28 @@ module Normal = struct
(fun a p -> ncap a (nnormal l (descr p) xs)) (nconstr l t) pl
let nnf lab t0 (pl,t,xs) =
assert (not (Types.disjoint t t0));
let t = if Types.subtype t t0 then t else Types.cap t t0 in
normal lab t (NodeSet.get pl) xs
let basic_tests t0 (pl,t,xs) =
let t0 = Types.cap t0 any_basic in
let rec aux accu t res = function
| [] -> (res,t) :: accu
| (tp,xp,d) :: rest ->
if (IdSet.disjoint xp xs)
then aux accu (Types.cap t tp) res rest
else match d with
| Constr s -> aux accu (Types.cap t s) res rest
| Cup (p1,p2) -> aux (aux accu t res (p2::rest)) t res (p1::rest)
| Cap (p1,p2) -> aux accu t res (p1 :: p2 :: rest)
| Capture x -> aux accu t (IdMap.add x SCatch res) rest
| Constant (x,c) -> aux accu t (IdMap.add x (SConst c) res) rest
| _ -> accu
in
aux [] (Types.cap t any_basic) IdMap.empty (List.map descr pl)
end
......@@ -1000,9 +1022,16 @@ struct
Format.fprintf ppf " pat %a@." Normal.Nnf.print p;
) disp.pl
let dispatcher t pl lab : dispatcher =
let first_lab t reqs =
let aux l req = min l (Normal.Nnf.first_label req) in
let lab =
Array.fold_left aux (Types.Record.first_label t) reqs in
if lab == LabelPool.dummy_max then None else Some lab
let dispatcher t pl : dispatcher =
try DispMap.find (t,pl) !dispatchers
with Not_found ->
let lab = first_lab t pl in
let nb = ref 0 in
let codes = ref [] in
let rec aux t arity i accu =
......@@ -1135,17 +1164,8 @@ struct
aux [] t tests;
!accu
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 t pl in
(* Collect all subrequests *)
let aux reqs (req,_) = NfSet.add req reqs in
......@@ -1163,7 +1183,7 @@ struct
else Array.map (fun r -> [],[],r) reqs in
let reqs = Array.map (fun (_,_,req) -> req) reqs_facto in
let disp = dispatcher t reqs lab in
let disp = dispatcher t reqs in
(* Build continuation *)
let result (t,ar,m) =
......@@ -1177,7 +1197,6 @@ struct
let res = Array.map result disp.codes in
post (disp,res)
type 'a rhs = Match of (id * int) list * 'a | Fail
let make_branches t brs =
let t0 = ref t in
......@@ -1447,22 +1466,17 @@ struct
print_dispatchers ppf
let show ppf t pl lab =
let disp = dispatcher t pl lab in
let show ppf t pl =
let disp = dispatcher t pl in
queue disp;
print_dispatchers ppf
let debug_compile ppf t pl =
let t = Types.descr t in
let lab =
List.fold_left
(fun l p -> min l (first_label (descr p)))
(Types.Record.first_label t) pl in
let lab = if lab == LabelPool.dummy_max then None else Some lab in
let pl = Array.of_list
(List.map (fun p -> ([p],Types.cap t (Types.descr (accept p)),fv p)) pl) in
show ppf t pl lab;
show ppf t pl;
Format.fprintf ppf "# compiled states: %i@\n" !generated
let () =
......
......@@ -246,6 +246,9 @@ module Map = struct
| ([],l2) -> l2
| (l1,[]) -> l1
let add x v = union_disj [(x,v)]
let rec diff l1 l2 =
match (l1,l2) with
| (((x1,y1) as t1)::q1, x2::q2) ->
......
......@@ -32,6 +32,7 @@ sig
module Map: sig
type 'a map
external get: 'a map -> (X.t * 'a) list = "%identity"
val add: X.t -> 'a -> 'a map -> 'a map
val length: 'a map -> int
val domain: 'a map -> t
val restrict: 'a map -> t -> 'a map
......
......@@ -18,7 +18,7 @@ This page collects some examples of applications that use CDuce.
<ul>
<li>The <a href="http://www.cduce.org/">CDuce</a> site itself.</li>
<li><a href="http://www.random-art.org/">Random Art</a>.</li>
<li><a href="http://www.larouedesecours.com/">La route de
<li><a href="http://www.larouedesecours.com/">La roue de
secours</a>.</li>
<li><a href="http://www.editionsvalroc.com/">ditions Valroc</a>.</li>
</ul>
......@@ -56,7 +56,7 @@ href="http://caml.inria.fr/pub/ml-archives/caml-list/2005/06/de1ec925a81313be4cf
<ul>
<li><a href="http://www.lri.fr/~benzaken/">Vronique Benzaken</a>.</li>
<li><a href="http://www.eleves.ens.fr/home/frisch">Alain Frisch</a>.</li>
<li><a href="http://www.lri.fr/~miachon/index.html">Cedric
<li><a href="http://www.lri.fr/~miachon/index.html">Cdric
Miachon</a>.</li>
<li><a href="http://www.ipl.t.u-tokyo.ac.jp/~scm/">Shin-Cheng Mu</a>.</li>
</ul>
......
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