How do I get a discriminated union case from a string? - reflection

I have a discriminated union and I want to select a case based on a string (which is read from a JSON file). This is easy to do:
type MyDU = A | B
let str = "B"
let myDU : MyDU =
match str with
| "A" -> MyDU.A
| "B" -> MyDU.B
| _ -> failwith "whatever"
// val myDU : MyDU = B
However, sometimes there are many cases, which would require a lot of typing.
The Microsoft.FSharp.Reflection library allows me to get a UnionCaseInfo
object:
open Microsoft.FSharp.Reflection
let myDUInfo : UnionCaseInfo =
FSharpType.GetUnionCases(typeof<MyDU>)
|> Array.find (fun x -> x.Name = str)
// val myDUInfo : UnionCaseInfo = MyDU.B
I would like to convert myDUInfo into a union case so as to get the same result as the code above relying on match, but without having to type the strings corresponding to all the cases.
Is this possible?

To instantiate a union case, use the FSharpValue.MakeUnion method. Here is a function that will instantiate a union case given its name:
let instantiate<'t> name =
Reflection.FSharpType.GetUnionCases( typeof<'t> )
|> Seq.tryFind (fun uc -> uc.Name = name)
|> Option.map (fun uc -> Reflection.FSharpValue.MakeUnion( uc, [||] ) :?> 't)
Usage:
> type T = A | B | C
> instantiate<T> "A"
val it : T option = Some A
NOTE: this function assumes, but does not make sure, that the union case has no arguments. If you give it a case with arguments, it will crash:
> type T = A of int | B | C
> instantiate<T> "A"
System.Reflection.TargetParameterCountException: Parameter count mismatch.
at System.Reflection.RuntimeMethodInfo.InvokeArgumentsCheck(Object obj, BindingFlags invokeAttr, Binder binder, Object[] parameters, CultureInfo culture)
at System.Reflection.RuntimeMethodInfo.Invoke(Object obj, BindingFlags invokeAttr, Binder binder, Object[] parameters, CultureInfo culture)
at FSI_0002.instantiate#5.Invoke(UnionCaseInfo uc) in c:\o\a.fsx:line 5
at Microsoft.FSharp.Core.OptionModule.Map[T,TResult](FSharpFunc`2 mapping, FSharpOption`1 option)
at <StartupCode$FSI_0006>.$FSI_0006.main#()
Stopped due to error
I leave resolution of this problem as an exercise for the reader (hint: use the UnionCase.GetFields method).

Related

F# Reflection : Passing an Array as Argument to MethodInfo.Invoke

In a previous post I was shown how to use F# Reflection to get keys from a single boxed Map object, Map<'k,'v>, at runtime. I tried to extend the idea and pass an array of boxed Map objects, Map<'k,'v>[], but I cannot find a way to extend the original single-object approach to take an array of objects as argument. I came up with a solution which works but doesn't look right. I am looking for a better, more idiomatic way.
In the code below, keysFromMap gets an array of keys from a single boxed Map<'k,'v> argument; keysFromMapArray is my first attempt to do the same from a boxed Map<'k,'v>[] argument - but it does not work - and keysFromMapArrayWithCast does work, but having to do the downcast at the FromMapArrayWithCast getter level does not seem right.
The error message I get from running keysFromMapArray (test2 commented out) :
{System.ArgumentException: Object of type 'System.Object[]' cannot be converted to type 'Microsoft.FSharp.Collections.FSharpMap`2[System.String,System.Int32][]'.
My question : why extending the keysFromMap approach to take an array of Maps argument does not work, and how to fix it so that it does?
Example code:
module Example =
open System
let foo1 = [| ("foo11", 11); ("foo12", 12) |] |> Map.ofArray
let foo2 = [| ("foo21", 21); ("foo22", 22) |] |> Map.ofArray
type KeyGetter =
static member FromMap<'K, 'V when 'K : comparison>(map:Map<'K, 'V>) =
[| for kvp in map -> kvp.Key |]
static member FromMapArray<'K, 'V when 'K : comparison>(maps:Map<'K, 'V>[]) =
maps |> Array.map (fun mp -> [| for kvp in mp -> kvp.Key |]) |> Array.concat
static member FromMapArrayWithCast<'K, 'V when 'K : comparison>(omaps:obj[]) =
let typedmaps = [| for omp in omaps -> omp :?> Map<'K, 'V> |] // -- DOWNCASTING HERE --
typedmaps |> Array.map (fun mp -> [| for kvp in mp -> kvp.Key |]) |> Array.concat
let keysFromMap (oMap : obj) : obj[] =
let otype = oMap.GetType()
match otype.Name with
| "FSharpMap`2" ->
typeof<KeyGetter>.GetMethod("FromMap")
.MakeGenericMethod(otype.GetGenericArguments())
.Invoke(null, [| box oMap |]) :?> obj[]
| _ ->
Array.empty
let keysFromMapArray (oMaps : obj[]) : obj[] =
// skipped : tests to check that oMaps is not empty, and that all elements have the same type...
let otype = oMaps.[0].GetType()
match otype.Name with
| "FSharpMap`2" ->
typeof<KeyGetter>.GetMethod("FromMapArray")
.MakeGenericMethod(otype.GetGenericArguments())
.Invoke(null, [| box oMaps |]) :?> obj[] // -- FAILS HERE --
| _ ->
Array.empty
let keysFromMapArrayWithCast (oMaps : obj[]) : obj[] =
// skipped : tests to check that oMaps is not empty, and that all elements have the same type...
let otype = oMaps.[0].GetType()
match otype.Name with
| "FSharpMap`2" ->
typeof<KeyGetter>.GetMethod("FromMapArrayWithCast")
.MakeGenericMethod(otype.GetGenericArguments())
.Invoke(null, [| box oMaps |]) :?> obj[]
| _ ->
Array.empty
[<EntryPoint>]
let main argv =
printfn "#test1: keys from Map<'k,'v> - works"
let test = keysFromMap foo1
// printfn "#test2: keysFromArray from Map<'k,'v>[] - FAILS"
// let test = keysFromMapArray [| foo1; foo2 |]
printfn "#test3: keysFromArrayWithCast from obj[] - works"
let test = keysFromMapArrayWithCast [| foo1; foo2 |]
Console.ReadKey() |> ignore
0 // return exit code 0
This is the same case as the following:
> type K = static member F(x:int[]) = 3
let f x = typeof<K>.GetMethod("F").Invoke(null, [|(x:obj[])|])
f [|2; 3|];;
System.ArgumentException: Object of type 'System.Object[]' cannot be converted to type 'System.Int32[]'.
at System.RuntimeType.TryChangeType(Object value, Binder binder, CultureInfo culture, Boolean needsSpecialCast)
at System.Reflection.MethodBase.CheckArguments(Object[] parameters, Binder binder, BindingFlags invokeAttr, CultureInfo culture, Signature sig)
at System.Reflection.RuntimeMethodInfo.InvokeArgumentsCheck(Object obj, BindingFlags invokeAttr, Binder binder, Object[] parameters, CultureInfo culture)
at System.Reflection.RuntimeMethodInfo.Invoke(Object obj, BindingFlags invokeAttr, Binder binder, Object[] parameters, CultureInfo culture)
at <StartupCode$FSI_0002>.$FSI_0002.main#()
Stopped due to error
Making the intermediate function generic solves the problem.
> type K = static member F(x:int[]) = 3
let f x = typeof<K>.GetMethod("F").Invoke(null, [|(x:'a[])|]) // unconstrained!
f [|2; 3|];;
type K =
class
static member F : x:int [] -> int
end
val f : x:'a [] -> obj
val it : obj = 3
This can be applied to keysFromMapArray.
let keysFromMapArray (oMaps : 'a[]) : obj[] =

F#: How to call Expression.Call for a method with discriminated union in a generic type using a case type?

Let's say, I have a discriminated union type AccountEvent and a class Aggregate that carries two methods:
Apply1(event : AccountEvent)
Apply2(event : Event<AccountEvent>)
Event<'TEvent> being just a dummy class for sake of having a generic type.
I am trying to create an Expression that represents the call to Apply1 and Apply2 supporting for the parameter type the Discriminated union case type.
That is allowing:
AccountEvent.AccountCreated type for Apply1
Event<AccountEvent.AccountCreated> type for Apply2
I want to achieve that without changing the signature of Apply1, Apply2 and the definition the discriminated union.
The code
type AccountCreation = {
Owner: string
AccountId: Guid
CreatedAt: DateTimeOffset
StartingBalance: decimal
}
type Transaction = {
To: Guid
From: Guid
Description: string
Time: DateTimeOffset
Amount: decimal
}
type AccountEvent =
| AccountCreated of AccountCreation
| AccountCredited of Transaction
| AccountDebited of Transaction
type Event<'TEvent>(event : 'TEvent)=
member val Event = event with get
type Aggregate()=
member this.Apply1(event : AccountEvent)=
()
member this.Apply2(event : Event<AccountEvent>)=
()
let createExpression (aggregateType: Type)(eventType: Type)(method: MethodInfo) =
let instance = Expression.Parameter(aggregateType, "a")
let eventParameter = Expression.Parameter(eventType, "e")
let body = Expression.Call(instance, method, eventParameter)
()
[<EntryPoint>]
let main argv =
let accountCreated = AccountEvent.AccountCreated({
Owner = "Khalid Abuhakmeh"
AccountId = Guid.NewGuid()
StartingBalance = 1000m
CreatedAt = DateTimeOffset.UtcNow
})
let accountCreatedType = accountCreated.GetType()
let method1 = typeof<Aggregate>.GetMethods().Single(fun x -> x.Name = "Apply1")
createExpression typeof<Aggregate> typeof<AccountEvent> method1
createExpression typeof<Aggregate> accountCreatedType method1
let method2 = typeof<Aggregate>.GetMethods().Single(fun x -> x.Name = "Apply2")
let eventAccountCreatedType = typedefof<Event<_>>.MakeGenericType(accountCreatedType)
createExpression typeof<Aggregate> typeof<Event<AccountEvent>> method2
createExpression typeof<Aggregate> eventAccountCreatedType method2
0
With my current solution it does not work to generate an expression for Apply2:
System.ArgumentException: Expression of type 'Program+Event`1[Program+AccountEvent+AccountCreated]' cannot be used for parameter of type 'Program+Event`1[Program+AccountEvent]' of method 'Void Apply2(Event`1)'
Parameter name: arg0
at at System.Dynamic.Utils.ExpressionUtils.ValidateOneArgument(MethodBase method, ExpressionType nodeKind, Expression arguments, ParameterInfo pi, String methodParamName, String argumentParamName, Int32 index)
at at System.Linq.Expressions.Expression.Call(Expression instance, MethodInfo method, Expression arg0)
at at System.Linq.Expressions.Expression.Call(Expression instance, MethodInfo method, IEnumerable`1 arguments)
at at System.Linq.Expressions.Expression.Call(Expression instance, MethodInfo method, Expression[] arguments)
at Program.doingStuff(Type aggregateType, Type eventType, MethodInfo method) in C:\Users\eperret\Desktop\ConsoleApp1\ConsoleApp1\Program.fs:40
at Program.main(String[] argv) in C:\Users\eperret\Desktop\ConsoleApp1\ConsoleApp1\Program.fs:61
I am wondering how I can adjust the creation of my expression to accept the Event<AccountEvent.AccountCreated>?
I am thinking that maybe there is a need to have an intermediate layer to have a conversion layer from AccountEvent.AccountCreated to its base classAccountEvent (this is how discriminated unions are compiled), or more precisely considering the generic, from Event<AccountEvent.AccountCreated to Event<AccountEvent>.
hard to say if this answers your question.
open System
open System
type AccountCreation = {
Owner: string
AccountId: Guid
CreatedAt: DateTimeOffset
StartingBalance: decimal
}
type Transaction = {
To: Guid
From: Guid
Description: string
Time: DateTimeOffset
Amount: decimal
}
type AccountEvent =
| AccountCreated of AccountCreation
| AccountCredited of Transaction
| AccountDebited of Transaction
type CheckinEvent =
| CheckedIn
| CheckedOut
type Event<'T> = AccountEvent of AccountEvent | OtherEvent of 'T
let ev : Event<CheckinEvent> = AccountEvent (AccountCreated {
Owner= "string"
AccountId= Guid.NewGuid()
CreatedAt= DateTimeOffset()
StartingBalance=0m
})
let ev2 : Event<CheckinEvent> = OtherEvent CheckedOut
let f ev =
match ev with
| AccountEvent e -> Some e
| OtherEvent (CheckedOut) -> None
| OtherEvent (CheckedIn) -> None
let x = f ev
let y = f ev2
afterwards, a match statement like this might simplify all that. Honestly it's a little complicated for me to follow what precisely what you're doing there, but using a function instead of a method and using a match statement appears to accomplish the same goal. Ideally you should probably fully spell out the types in a DU instead of using a generic so that you'll get compile time checks instead of run time errors and can know for certain that your code is fully covered by the compiler.

How to create and use my own structure/signature in SML/NJ?

I'm new to functional programming and I want to create my own structure/signature called Dictionary. So far I have this in file called dictionary-en.sml:
(* The signature DICTIONARY defines a type and a programming interface for
the dictionary data structure. The data structure allows us to store
data in the form of (key, value) pairs and to query the data using a key. *)
signature DICTIONARY =
sig
(* The structure has to implement a dictionary type. It defines key type,
which has to support equality checking, and a value type for the data
stored in the dictionary. *)
type (''key, 'value) dict
(* Creates an empty dictionary. *)
val empty: (''key, 'value) dict
(* Returns true if a key exists in the dictionary. *)
val exists: (''key, 'value) dict -> ''key -> bool
end
And I have this in file solution.sml:
structure Dictionary :> DICTIONARY =
struct
type (''key, 'value) dict = (''key * 'value) list
val empty = []
fun exists dict key =
case dict of
[] => false
| (k, _ )::rep => if k = key
then true
else exists rep key
end
But I don't how to use this.
When I wrote in REPL:
- Dictionary.exists [(3,"c"), (5, "e"), (7, "g")] 3;
I got this error:
stdIn:1.2-3.7 Error: operator and operand do not agree [tycon mismatch]
operator domain: (''Z,'Y) Dictionary.dict
operand: ([int ty] * string) list
in expression:
Dictionary.exists ((3,"c") :: (5,"e") :: (<exp>,<exp>) :: nil)
Can someone please help me? I don't know what I did wrong.
In the function
fun exists dict key =
case dict of
[] => []
| (k, _ )::rep => if k = key
then true
else exists rep key
I spot two issues:
You can't return [] in one place and true in another.
Instead of if P then true else Q, write P orelse Q.
You're using :> which means that the module is opaque, so you can only access the things specified in the signature. The internal list representation is not mentioned in the signature, so you can't refer to a dict as a list, even though you may know that that's how it's implemented. This is a feature.
I would probably call exists for member, since List.exists is a higher-order predicate, e.g. List.exists (fn x => x > 5) [3, 6, 9]. You could also deviate from any standard library naming and say containsKey and containsValue, or something like that.
Besides the insert function that molbdnilo suggested, you may like to have a fromList function.
Here's a refactored version (comments omitted for brevity, but I think your comments are good!):
signature DICTIONARY =
sig
type (''key, 'value) dict
val empty: (''key, 'value) dict
val member: ''key -> (''key, 'value) dict -> bool
val insert: (''key * 'value) -> (''key, 'value) dict -> (''key, 'value) dict
val fromList: (''key * 'value) list -> (''key, 'value) dict
end
structure Dictionary :> DICTIONARY =
struct
type (''key, 'value) dict = (''key * 'value) list
val empty = []
fun member key [] = false
| member key ((key2, _)::dict) =
key = key2 orelse member key dict
fun insert (key, value) [] = [(key, value)]
| insert (key, value) ((key2, value2)::dict) =
if key = key2
then (key, value) :: dict
else (key2, value2) :: insert (key, value) dict
fun fromList pairs = foldl (fn (pair, dict) => insert pair dict) empty pairs
end
But since you're building a dictionary module, there are two things you want to consider:
Make it possible to use some kind of binary tree as internal representation, requiring that the keys can be ordered rather than compared for equality.
Since Standard ML doesn't have special syntax like ''key to express that something can be ordered (Haskell generalises this as type classes, but Standard ML has only the special syntax ''key), this is a good case for using functors, which is the name given to higher-order modules, aka parameterised modules.
Here's an example signature, functor and structure that you can fill out:
signature ORD = sig
type t
val compare : t * t -> order
end
signature DICT = sig
type key
type 'value dict
val empty: 'value dict
val member: key -> 'value dict -> bool
val insert: key * 'value -> 'value dict -> 'value dict
val fromList: (key * 'value) list -> 'value dict
end
functor Dict (Ord : ORD) :> DICT = struct
type key = Ord.t
type 'value dict = (key * 'value) list
val empty = ...
fun member _ _ = raise Fail "not implemented"
fun insert _ _ = raise Fail "not implemented"
fun fromList _ = raise Fail "not implemented"
end
At this point you can change type 'value dict into using a binary tree, and when you need to decide whether to go left or right in this binary tree, you can write:
case Ord.compare (key1, key2) of
LESS => ...
| EQUAL => ...
| GREATER => ...
And when you need a dictionary where the key is some particular orderable type, you can create a module using this functor:
structure IntDict = Dict(struct
type t = int
val compare = Int.compare
end)
structure StringDict = Dict(struct
type t = string
val compare = String.compare
end)
See also Standard ML functor examples for more examples.
You can't access the internal representation; the entire interface is given by the signature.
You need to add to the signature some way to create a dictionary without depending on the representation used in a particular structure.
For instance,
val insert : (''key * 'value) -> (''key, 'value) dict -> (''key, 'value) dict
would let you write
Dictionary.exists (Dictionary.insert (3,"c") Dictionary.empty) 3;
Implementation left as an exercise.

How to create a cached recursive type?

open System
open System.Collections.Generic
type Node<'a>(expr:'a, symbol:int) =
member x.Expression = expr
member x.Symbol = symbol
override x.GetHashCode() = symbol
override x.Equals(y) =
match y with
| :? Node<'a> as y -> symbol = y.Symbol
| _ -> failwith "Invalid equality for Node."
interface IComparable with
member x.CompareTo(y) =
match y with
| :? Node<'a> as y -> compare symbol y.Symbol
| _ -> failwith "Invalid comparison for Node."
type Ty =
| Int
| String
| Tuple of Ty list
| Rec of Node<Ty>
| Union of Ty list
type NodeDict<'a> = Dictionary<'a,Node<'a>>
let get_nodify_tag =
let mutable i = 0
fun () -> i <- i+1; i
let nodify (dict: NodeDict<_>) x =
match dict.TryGetValue x with
| true, x -> x
| false, _ ->
let x' = Node(x,get_nodify_tag())
dict.[x] <- x'
x'
let d = Dictionary(HashIdentity.Structural)
let nodify_ty x = nodify d x
let rec int_string_stream =
Union
[
Tuple [Int; Rec (nodify_ty (int_string_stream))]
Tuple [String; Rec (nodify_ty (int_string_stream))]
]
In the above example, the int_string_stream gives a type error, but it neatly illustrates what I want to do. Of course, I want both sides to get tagged with the same symbol in nodify_ty. When I tried changing the Rec type to Node<Lazy<Ty>> I've found that it does not compare them correctly and each sides gets a new symbol which is useless to me.
I am working on a language, and the way I've dealt with storing recursive types up to now is by mapping Rec to an int and then substituting that with the related Ty in a dictionary whenever I need it. Currently, I am in the process of cleaning up the language, and would like to have the Rec case be Node<Ty> rather than an int.
At this point though, I am not sure what else could I try here. Could this be done somehow?
I think you will need to add some form of explicit "delay" to the discriminated union that represents your types. Without an explicit delay, you'll always end up fully evaluating the types and so there is no potential for closing the loop.
Something like this seems to work:
type Ty =
| Int
| String
| Tuple of Ty list
| Rec of Node<Ty>
| Union of Ty list
| Delayed of Lazy<Ty>
// (rest is as before)
let rec int_string_stream = Delayed(Lazy.Create(fun () ->
Union
[
Tuple [Int; Rec (nodify_ty (int_string_stream))]
Tuple [String; Rec (nodify_ty (int_string_stream))]
]))
This will mean that when you pattern match on Ty, you'll always need to check for Delayed, evaluate the lazy value and then pattern match again, but that's probably doable!

Suppress exhaustive matching warning in OCaml

I'm having a problem in fixing a warning that OCaml compiler gives to me.
Basically I'm parsing an expression that can be composed by Bool, Int and Float.
I have a symbol table that tracks all the symbols declared with their type:
type ast_type = Bool | Int | Float
and variables = (string, int*ast_type) Hashtbl.t;
where int is the index used later in the array of all variables.
I have then a concrete type representing the value in a variable:
type value =
| BOOL of bool
| INT of int
| FLOAT of float
| UNSET
and var_values = value array
I'm trying to define the behaviour of a variable reference inside a boolean expression so what I do is
check that the variable is declared
check that the variable has type bool
to do this I have this code (s is the name of the variable):
| GVar s ->
begin
try
let (i,t) = Hashtbl.find variables s in
if (t != Bool) then
raise (SemanticException (BoolExpected,s))
else
(fun s -> let BOOL v = Array.get var_values i in v)
with
Not_found -> raise (SemanticException (VarUndefined,s))
end
The problem is that my checks assure that the element taken from var_values will be of type BOOL of bool but of course this constraint isn't seen by the compiler that warns me:
Warning P: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(FLOAT _ |INT _ |UNSET)
How am I supposed to solve this kind of issues? Thanks in advance
This is a problem that you can solve using OCaml's polymorphic variants.
Here is some compilable OCaml code that I infer exhibits your problem:
type ast_type = Bool | Int | Float
and variables = (string, int*ast_type) Hashtbl.t
type value =
| BOOL of bool
| INT of int
| FLOAT of float
| UNSET
and var_values = value array
type expr = GVar of string
type exceptioninfo = BoolExpected | VarUndefined
exception SemanticException of exceptioninfo * string
let variables = Hashtbl.create 13
let var_values = Array.create 13 (BOOL false)
let f e =
match e with
| GVar s ->
begin
try
let (i,t) = Hashtbl.find variables s in
if (t != Bool) then
raise (SemanticException (BoolExpected,s))
else
(fun s -> let BOOL v = Array.get var_values i in v)
with
Not_found -> raise (SemanticException (VarUndefined,s))
end
It generates the warning:
File "t.ml", line 30, characters 42-48:
Warning P: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(FLOAT _|INT _|UNSET)
Here is the same code transformed to use polymorphic variants. That code compiles without warnings. Note that polymorphic variants have more expressive power than standard types (here allowing to express that var_values is an array of BOOL only), but they can lead to puzzling warnings.
type ast_type = Bool | Int | Float
and variables = (string, int*ast_type) Hashtbl.t
type value =
[ `BOOL of bool
| `INT of int
| `FLOAT of float
| `UNSET ]
and var_values = value array
type expr = GVar of string
type exceptioninfo = BoolExpected | VarUndefined
exception SemanticException of exceptioninfo * string
let variables = Hashtbl.create 13
let var_values = Array.create 13 (`BOOL false)
let f e =
match e with
| GVar s ->
begin
try
let (i,t) = Hashtbl.find variables s in
if (t != Bool) then
raise (SemanticException (BoolExpected,s))
else
(fun s -> let `BOOL v = Array.get var_values i in v)
with
Not_found -> raise (SemanticException (VarUndefined,s))
end
Here are the types inferred by OCaml on the above code:
type ast_type = Bool | Int | Float
and variables = (string, int * ast_type) Hashtbl.t
type value = [ `BOOL of bool | `FLOAT of float | `INT of int | `UNSET ]
and var_values = value array
type expr = GVar of string
type exceptioninfo = BoolExpected | VarUndefined
exception SemanticException of exceptioninfo * string
val variables : (string, int * ast_type) Hashtbl.t
val var_values : [ `BOOL of bool ] array
val f : expr -> 'a -> bool
Take a look at this and search for "disable warnings". You should come to a flag -w.
If you want to fix it the "ocamlish" way, then I think you must make the pattern match exhaustive, i.e. cover all cases that might occur.
But if you don't want to match against all possible values, you might consider using wildcard (see here), that covers all cases you do not want to handle explicitly.
In this particular case, polymorphic variants, as explained by Pascal, are a good answer.
Sometimes, however, you're stuck with an impossible case. Then I find it natural to write
(fun s -> match Array.get var_values i with
| BOOL v -> v
| _ -> assert false)
This is much better than using the -w p flag which could hide other, undesired non-exhaustive pattern matches.
Whoops! Misread your question. Leaving my answer below for posterity.
Updated answer: is there a reason why you are doing the check in the hashtbl, or why you can't have the concrete data types (type value) in the hashtbl? That would simplify things. As it is, you can move the check for bool to the Array.get and use a closure:
| GVar s ->
begin
try
let (i,_) = Hashtbl.find variables s in
match (Array.get var_values i) with BOOL(v) -> (fun s -> v)
| _ -> raise (SemanticException (BoolExpected,s))
with
Not_found -> raise (SemanticException (VarUndefined,s))
end
Alternatively I think it would make more sense to simplify your code. Move the values into the Hashtbl instead of having a type, an index and an array of values. Or just store the index in the Hashtbl and check the type in the array.
INCORRECT ANSWER BELOW:
You can replace the if else with a match. Or you can replace the let with a match:
replace if/else:
| GVar s ->
begin
try
let (i,t) = Hashtbl.find variables s in
match t with Bool -> (fun s -> let BOOL v = Array.get var_values i in v)
| _ -> raise (SemanticException (BoolExpected,s))
with
Not_found -> raise (SemanticException (VarUndefined,s))
end
replace let:
| GVar s ->
begin
try
match (Hashtbl.find variables s) with (i, Bool) -> (fun s -> let BOOL v = Array.get var_values i in v)
| _ -> raise (SemanticException (BoolExpected,s))
with
Not_found -> raise (SemanticException (VarUndefined,s))
end

Resources