Permalink
Browse files

[enhance] compiler: Added to PassHandler the switch handler

  • Loading branch information...
BourgerieQuentin committed Jan 24, 2012
1 parent d466bb2 commit adc190b8fe30f26573fe2eddf09fd06f322eec79
Showing with 24 additions and 1 deletion.
  1. +8 −0 passlib/passHandler.ml
  2. +16 −1 passlib/passHandler.mli
View
@@ -754,6 +754,14 @@ let alt_handler if_ (name1, pass1) (name2, pass2) env =
let (<?>) env (if_, (name1, pass1), (name2, pass2)) =
alt_handler if_ (name1, pass1) (name2, pass2) env
+let switch_handler switch pass env =
+ let switcher = switch ~options:env.options env.env in
+ let name, pass = pass switcher in
+ handler name pass env
+
+let (|?|) env (switch, pass) =
+ switch_handler switch pass env
+
let return env = env.env
let (|>) = InfixOperator.(|>)
View
@@ -311,6 +311,14 @@ val alt_handler :
(string * (('opt, 'opt2, 'env, 'env2) pass)) ->
('opt, 'env) one_env -> ('opt2, 'env2) one_env
+(** [switch_handler select switch_pass] [select] should produce from
+ pass environment a value that be used by [switch_pass] to switch
+ to the wanted pass. *)
+val switch_handler :
+ (options:'opt -> 'env -> 'switch) ->
+ ('switch -> (string * (('opt, 'opt2, 'env, 'env2) pass))) ->
+ ('opt, 'env) one_env -> ('opt2, 'env2) one_env
+
(** Compose if functions. The resulting function return true if all
composed functions returns true.*)
val and_if :
@@ -335,14 +343,21 @@ val (|?>) :
passname * ('opt, 'opt, 'env, 'env) pass) ->
('opt, 'env) one_env
-(** A binary options for [alt_handler] *)
+(** A binary operator for [alt_handler] *)
val (<?>) :
('opt, 'env) one_env ->
((options:'opt -> 'env -> bool)
* (passname * (('opt, 'opt2, 'env, 'env2) pass))
* (passname * (('opt, 'opt2, 'env, 'env2) pass))) ->
('opt2, 'env2) one_env
+(** A binary operator for [switch_handler] *)
+val (|?|) :
+ ('opt, 'env) one_env ->
+ (options:'opt -> 'env -> 'switch) *
+ ('switch -> (string * (('opt, 'opt2, 'env, 'env2) pass))) ->
+ ('opt2, 'env2) one_env
+
(** A binary operator for make a pipe [a |> f] equals to [f a] *)
val (|>) : 'a -> ('a -> 'b) -> 'b

0 comments on commit adc190b

Please sign in to comment.