Commit 28947e67 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-10-27 07:00:51 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-27 07:00:51+00:00
parent edab9038
......@@ -116,7 +116,11 @@ let dummy_r = [||]
let rec run_dispatcher d v =
let actions = Patterns.Compile.actions d in
match v with
match actions with
| `Ignore r -> make_result_basic v r
| `Kind k -> run_disp_kind k v
and run_disp_kind actions v = match v with
| Pair (v1,v2) -> run_disp_prod v v1 v2 actions.Patterns.Compile.prod
| Record r -> run_disp_record v [] r actions.Patterns.Compile.record
| Atom a ->
......
......@@ -324,7 +324,10 @@ end
module Compile =
struct
type actions = {
type actions =
[ `Ignore of result
| `Kind of actions_kind ]
and actions_kind = {
basic: (Types.descr * result) list;
prod: result dispatch dispatch;
record: record option;
......@@ -378,6 +381,27 @@ struct
in
aux f a 0
let combine_kind basic prod record =
try (
let rs = [] in
let rs = match basic with
| [_,r] -> r :: rs
| [] -> rs
| _ -> raise Exit in
let rs = match prod with
| `None -> rs
| `Ignore (`Ignore r) -> r :: rs
| _ -> raise Exit in
let rs = match record with
| None -> rs
| Some (`Result r) -> r :: rs
| _ -> raise Exit in
match rs with
| r :: rs when List.for_all ( (=) r ) rs -> `Ignore r
| _ -> raise Exit
)
with Exit -> `Kind { basic = basic; prod = prod; record = record }
let combine (disp,act) =
if Array.length act = 0 then `None
else
......@@ -705,11 +729,11 @@ struct
match disp.actions with
| Some a -> a
| None ->
let a = {
basic = dispatch_basic disp;
prod = dispatch_prod disp;
record = dispatch_record disp;
} in
let a = combine_kind
(dispatch_basic disp)
(dispatch_prod disp)
(dispatch_record disp)
in
disp.actions <- Some a;
a
......@@ -722,26 +746,27 @@ struct
to_print := d :: !to_print
)
let print_actions ppf actions =
let print_source ppf = function
| `Catch -> Format.fprintf ppf "v"
| `Const c -> Types.Print.print_const ppf c
| `Left i -> Format.fprintf ppf "l%i" i
| `Right j -> Format.fprintf ppf "r%i" j
| `Recompose (i,j) -> Format.fprintf ppf "(l%i,r%i)" i j
| `Field (l,i) -> Format.fprintf ppf "%s%i" (Types.label_name l) i
in
let print_result ppf =
Array.iteri
(fun i s ->
if i > 0 then Format.fprintf ppf ",";
print_source ppf s;
)
in
let print_ret ppf (code,ret) =
Format.fprintf ppf "$%i" code;
if Array.length ret <> 0 then
Format.fprintf ppf "(%a)" print_result ret in
let print_source ppf = function
| `Catch -> Format.fprintf ppf "v"
| `Const c -> Types.Print.print_const ppf c
| `Left i -> Format.fprintf ppf "l%i" i
| `Right j -> Format.fprintf ppf "r%i" j
| `Recompose (i,j) -> Format.fprintf ppf "(l%i,r%i)" i j
| `Field (l,i) -> Format.fprintf ppf "%s%i" (Types.label_name l) i
let print_result ppf =
Array.iteri
(fun i s ->
if i > 0 then Format.fprintf ppf ",";
print_source ppf s;
)
let print_ret ppf (code,ret) =
Format.fprintf ppf "$%i" code;
if Array.length ret <> 0 then
Format.fprintf ppf "(%a)" print_result ret
let print_kind ppf actions =
let print_lhs ppf (code,prefix,d) =
let arity = match d.codes.(code) with (_,a,_) -> a in
Format.fprintf ppf "$%i(" code;
......@@ -835,6 +860,10 @@ struct
print_prod actions.prod;
print_record_opt ppf actions.record
let print_actions ppf = function
| `Kind k -> print_kind ppf k
| `Ignore r -> Format.fprintf ppf "v -> %a@\n" print_ret r
let rec print_dispatchers ppf =
match !to_print with
| [] -> ()
......
......@@ -41,7 +41,10 @@ module Compile: sig
type dispatcher
val dispatcher: Types.descr -> normal array -> dispatcher
type actions = {
type actions =
[ `Ignore of result
| `Kind of actions_kind ]
and actions_kind = {
basic: (Types.descr * result) list;
prod: result dispatch dispatch;
record: record option;
......
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