2000-10-02 07:18:05 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
2011-07-27 07:17:02 -07:00
|
|
|
(* OCaml *)
|
2000-10-02 07:18:05 -07:00
|
|
|
(* *)
|
2001-02-05 00:49:52 -08:00
|
|
|
(* Luc Maranget, projet Moscova, INRIA Rocquencourt *)
|
2000-10-02 07:18:05 -07:00
|
|
|
(* *)
|
|
|
|
(* Copyright 2000 Institut National de Recherche en Informatique et *)
|
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(*
|
|
|
|
This module transforms generic switches in combinations
|
|
|
|
of if tests and switches.
|
|
|
|
*)
|
|
|
|
|
2001-02-19 12:27:52 -08:00
|
|
|
(* For detecting action sharing, object style *)
|
|
|
|
|
2014-04-07 08:43:20 -07:00
|
|
|
(* Store for actions in object style:
|
|
|
|
act_store : store an action, returns index in table
|
|
|
|
In case an action with equal key exists, returns index
|
|
|
|
of the stored action. Otherwise add entry in table.
|
2014-04-12 03:17:02 -07:00
|
|
|
act_store_shared : This stored action will always be shared.
|
2014-04-07 08:43:20 -07:00
|
|
|
act_get : retrieve table
|
|
|
|
act_get_shared : retrieve table, with sharing explicit
|
|
|
|
*)
|
|
|
|
|
|
|
|
type 'a shared = Shared of 'a | Single of 'a
|
|
|
|
|
2001-02-19 12:27:52 -08:00
|
|
|
type 'a t_store =
|
2014-04-07 08:43:20 -07:00
|
|
|
{act_get : unit -> 'a array ;
|
|
|
|
act_get_shared : unit -> 'a shared array ;
|
|
|
|
act_store : 'a -> int ;
|
|
|
|
act_store_shared : 'a -> int ; }
|
2014-04-02 06:22:21 -07:00
|
|
|
|
2014-04-07 08:43:20 -07:00
|
|
|
exception Not_simple
|
2014-04-02 06:22:21 -07:00
|
|
|
|
2014-04-07 08:43:20 -07:00
|
|
|
module type Stored = sig
|
|
|
|
type t
|
|
|
|
type key
|
|
|
|
val make_key : t -> key option
|
|
|
|
end
|
|
|
|
|
|
|
|
module Store(A:Stored) :
|
|
|
|
sig
|
|
|
|
val mk_store : unit -> A.t t_store
|
|
|
|
end
|
2001-02-19 12:27:52 -08:00
|
|
|
|
2000-10-02 07:18:05 -07:00
|
|
|
(* Arguments to the Make functor *)
|
|
|
|
module type S =
|
|
|
|
sig
|
|
|
|
(* type of basic tests *)
|
|
|
|
type primitive
|
|
|
|
(* basic tests themselves *)
|
|
|
|
val eqint : primitive
|
|
|
|
val neint : primitive
|
|
|
|
val leint : primitive
|
|
|
|
val ltint : primitive
|
|
|
|
val geint : primitive
|
|
|
|
val gtint : primitive
|
|
|
|
(* type of actions *)
|
|
|
|
type act
|
|
|
|
|
|
|
|
(* Various constructors, for making a binder,
|
|
|
|
adding one integer, etc. *)
|
|
|
|
val bind : act -> (act -> act) -> act
|
2014-04-08 02:38:22 -07:00
|
|
|
val make_const : int -> act
|
2000-10-02 07:18:05 -07:00
|
|
|
val make_offset : act -> int -> act
|
|
|
|
val make_prim : primitive -> act list -> act
|
|
|
|
val make_isout : act -> act -> act
|
2001-04-30 09:31:09 -07:00
|
|
|
val make_isin : act -> act -> act
|
2000-10-02 07:18:05 -07:00
|
|
|
val make_if : act -> act -> act -> act
|
|
|
|
(* construct an actual switch :
|
|
|
|
make_switch arg cases acts
|
2001-04-30 09:31:09 -07:00
|
|
|
NB: cases is in the value form *)
|
2000-10-02 07:18:05 -07:00
|
|
|
val make_switch :
|
2001-04-30 09:31:09 -07:00
|
|
|
act -> int array -> act array -> act
|
2014-04-07 08:43:20 -07:00
|
|
|
(* Build last minute sharing of action stuff *)
|
|
|
|
val make_catch : act -> int * (act -> act)
|
|
|
|
val make_exit : int -> act
|
|
|
|
|
2000-10-02 07:18:05 -07:00
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
(*
|
2014-04-08 02:38:22 -07:00
|
|
|
Make.zyva arg low high cases actions where
|
2000-10-02 07:18:05 -07:00
|
|
|
- arg is the argument of the switch.
|
|
|
|
- low, high are the interval limits.
|
|
|
|
- cases is a list of sub-interval and action indices
|
2001-04-30 09:31:09 -07:00
|
|
|
- actions is an array of actions.
|
2000-10-02 07:18:05 -07:00
|
|
|
|
|
|
|
All these arguments specify a switch construct and zyva
|
|
|
|
returns an action that performs the switch,
|
|
|
|
*)
|
|
|
|
module Make :
|
|
|
|
functor (Arg : S) ->
|
|
|
|
sig
|
2014-04-07 08:43:20 -07:00
|
|
|
(* Standard entry point, sharing is tracked *)
|
2000-10-02 07:18:05 -07:00
|
|
|
val zyva :
|
2010-01-22 04:48:24 -08:00
|
|
|
(int * int) ->
|
2000-10-02 07:18:05 -07:00
|
|
|
Arg.act ->
|
2001-04-30 09:31:09 -07:00
|
|
|
(int * int * int) array ->
|
2014-04-07 08:43:20 -07:00
|
|
|
Arg.act t_store ->
|
2001-04-30 09:31:09 -07:00
|
|
|
Arg.act
|
2014-04-07 08:43:20 -07:00
|
|
|
|
|
|
|
(* Output test sequence, sharing tracked *)
|
2001-04-30 09:31:09 -07:00
|
|
|
val test_sequence :
|
|
|
|
Arg.act ->
|
2000-10-02 07:18:05 -07:00
|
|
|
(int * int * int) array ->
|
2014-04-07 08:43:20 -07:00
|
|
|
Arg.act t_store ->
|
2000-10-02 07:18:05 -07:00
|
|
|
Arg.act
|
|
|
|
end
|