| 376 |
in |
in |
| 377 |
aux f a 0 |
aux f a 0 |
| 378 |
|
|
| 379 |
let combine disp act = |
let combine (disp,act) = |
| 380 |
if Array.length act = 0 then `None |
if Array.length act = 0 then `None |
| 381 |
else |
else |
| 382 |
if (array_for_all (fun (_,ar,_) -> ar = 0) disp.codes) |
if (array_for_all (fun (_,ar,_) -> ar = 0) disp.codes) |
| 575 |
d t selected unselect |
d t selected unselect |
| 576 |
in |
in |
| 577 |
let res = Array.map result disp.codes in |
let res = Array.map result disp.codes in |
| 578 |
post (combine disp res) |
post (disp,res) |
| 579 |
|
|
| 580 |
|
let make_branches t brs = |
| 581 |
|
let (_,brs) = |
| 582 |
|
List.fold_left |
| 583 |
|
(fun (t,brs) (p,e) -> |
| 584 |
|
let p = Normal.restrict t (Normal.nf p) in |
| 585 |
|
let t = Types.diff t (p.Normal.a) in |
| 586 |
|
(t, (p,e) :: brs) |
| 587 |
|
) (t,[]) brs in |
| 588 |
|
|
| 589 |
|
let pl = Array.map (fun x -> [x]) (Array.of_list brs) in |
| 590 |
|
get_tests |
| 591 |
|
pl |
| 592 |
|
(fun x -> [x],[]) |
| 593 |
|
t |
| 594 |
|
(fun _ pl _ -> |
| 595 |
|
let r = ref None in |
| 596 |
|
let aux = function |
| 597 |
|
| [x] -> assert (!r = None); r := Some x |
| 598 |
|
| [] -> () | _ -> assert false in |
| 599 |
|
Array.iter aux pl; |
| 600 |
|
let r = match !r with None -> assert false | Some x -> x in |
| 601 |
|
r |
| 602 |
|
) |
| 603 |
|
(fun x -> x) |
| 604 |
|
|
| 605 |
|
|
| 606 |
let rec dispatch_prod disp = |
let rec dispatch_prod disp = |
| 610 |
(fun (res,(p,q)) -> [p, (res,q)], []) |
(fun (res,(p,q)) -> [p, (res,q)], []) |
| 611 |
(Types.Product.pi1 t) |
(Types.Product.pi1 t) |
| 612 |
(dispatch_prod1 disp t) |
(dispatch_prod1 disp t) |
| 613 |
detect_left_tail_call |
(fun x -> detect_left_tail_call (combine x)) |
| 614 |
and dispatch_prod1 disp t t1 pl _ = |
and dispatch_prod1 disp t t1 pl _ = |
| 615 |
let t = Types.Product.restrict_1 t t1 in |
let t = Types.Product.restrict_1 t t1 in |
| 616 |
get_tests pl |
get_tests pl |
| 617 |
(fun (ret1, (res,q)) -> [q, (ret1,res)], [] ) |
(fun (ret1, (res,q)) -> [q, (ret1,res)], [] ) |
| 618 |
(Types.Product.pi2 t) |
(Types.Product.pi2 t) |
| 619 |
(dispatch_prod2 disp t) |
(dispatch_prod2 disp t) |
| 620 |
detect_right_tail_call |
(fun x -> detect_right_tail_call (combine x)) |
| 621 |
and dispatch_prod2 disp t t2 pl _ = |
and dispatch_prod2 disp t t2 pl _ = |
| 622 |
let aux_final (ret2, (ret1, res)) = |
let aux_final (ret2, (ret1, res)) = |
| 623 |
List.map (conv_source_prod ret1 ret2) res in |
List.map (conv_source_prod ret1 ret2) res in |
| 680 |
| x -> [],[x]) |
| x -> [],[x]) |
| 681 |
(Types.Record.project_field t l) |
(Types.Record.project_field t l) |
| 682 |
(dispatch_record_field l disp t) |
(dispatch_record_field l disp t) |
| 683 |
(fun x -> x) |
(fun x -> combine x) |
| 684 |
in |
in |
| 685 |
let absent = |
let absent = |
| 686 |
let pl = label_not_found l pl in |
let pl = label_not_found l pl in |
Parent Directory
| 
Revision Log
| 
Patch