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[] =
Related
This is a follow-up of this post and that post.
I need to write a function which takes an object (obj type) and a key (also an obj type), and if the object happens to be a Map, that is any Map<'k,'v> then extracts its keys and values.
The difficulty is that I cannot parametrize the function with generic types and that we cannot pattern-match objects on generic types.
I am not familiar with F# Reflection, but I found a way to get the Map's values, once I know its keys. With this example code :
module TestItem =
open System
open Microsoft.FSharp.Reflection
// some uninteresting types for this example, could be anything arbitrary
type Foo = {argF1 : string; argF2 : double; argF3 : bool[]}
type Bar = {argB1 : string; argB2 : double; argB3 : Foo[]}
// and their instances
let foo1 = {argF1 = "foo1"; argF2 = 1.0; argF3 = [| true |]}
let foo2 = {argF1 = "foo2"; argF2 = 2.0; argF3 = [| false |]}
let bar1 = {argB1 = "bar1"; argB2 = 10.0; argB3 = [| foo1 |]}
let bar2 = {argB1 = "bar2"; argB2 = 20.0; argB3 = [| foo2 |]}
// a Map type
type Baz = Map<String,Bar>
let baz : Baz = [| ("bar1", bar1); ("bar2", bar2) |] |> Map.ofArray
let item (oMap : obj) (key : obj) : unit =
let otype = oMap.GetType()
match otype.Name with
| "FSharpMap`2" ->
printfn " -Map object identified"
let prop = otype.GetProperty("Item")
try
let value = prop.GetValue(oMap, [| key |])
printfn " -Value associated to key:\n %s" (value.ToString())
with
| _ ->
printfn " -Key missing from oMap"
| _ ->
printfn " -Not a Map object"
[<EntryPoint>]
let main argv =
printfn "#test with correct key"
let test = item baz "bar1"
printfn "\n#test with incorrect key"
let test = item baz "bar1X"
Console.ReadKey() |> ignore
0 // return exit code 0
Running the code above ouputs the following to the Console :
#test with correct key
-Map object identified
-Value associated to key:
{argB1 = "bar1";
argB2 = 10.0;
argB3 = [|{argF1 = "foo1";
argF2 = 1.0;
argF3 = [|true|];}|];}
#test with incorrect key
-Map object identified
-Key missing from oMap
Now, to solve my problem, I would just need to find a way to extract the keys from the oMap object.
My question : how to complete the code below to return the oMap keys, of type obj[], if oMap is indeed a boxed Map object?
module CompleteThis =
open System
open Microsoft.FSharp.Reflection
let keys (oMap : obj) (key : obj) : obj[] =
let otype = oMap.GetType()
match otype.Name with
| "FSharpMap`2" ->
printfn " -Map object identified"
(* COMPLETE HERE *)
Array.empty // dummy
| _ ->
printfn " -Not a Map object"
Array.empty // return empty array
If you have a typed map map, one way of doing this is to iterate over the map using a sequence expression and get the keys using the Key property of the KeyValuePair that you get:
[| for kvp in map -> box kvp.Key |]
Reconstructing the code to do this using reflection (in the same way in which you invoke Item in your other example) would be a nightmare. A nice trick that you can do is to put this into a generic method:
type KeyGetter =
static member GetKeys<'K, 'V when 'K : comparison>(map:Map<'K, 'V>) =
[| for kvp in map -> box kvp.Key |]
Now, you can access the GetKeys method via reflection, get the type arguments of your Map and use those as 'K and 'V of the method, and invoke the method with your oMap as an argument:
let keys (oMap : obj) : obj[] =
let otype = oMap.GetType()
match otype.Name with
| "FSharpMap`2" ->
typeof<KeyGetter>.GetMethod("GetKeys")
.MakeGenericMethod(otype.GetGenericArguments())
.Invoke(null, [| box oMap |]) :?> obj[]
| _ ->
Array.empty
This works. However, I should add that I the fact that you actually need to do this is a sign that your system is most likely not exactly well designed, so I would consider changing the design of your application so that you do not need to do this kind of thing. There are, of course, some good reasons for doing something like this, but it should not be too common.
This will return the keys as an array of strings.
let keys (oMap : obj) =
let otype = oMap.GetType()
match otype.Name with
| "FSharpMap`2" ->
printfn " -Map object identified"
(* COMPLETE HERE *)
let map = oMap :?> Map<string, Bar>
let keys = map |> Map.toArray |> Array.map fst
keys
| _ ->
printfn " -Not a Map object"
Array.empty // return empty array
[<EntryPoint>]
let main argv =
printfn "#test with correct key"
let test = item baz "bar1"
printfn "\n#test with incorrect key"
let test = item baz "bar1X"
let keys = keys baz
Console.ReadKey() |> ignore
0 // return exit code 0
I have a handwritten predictive parser.
Each nonterminal has a corresponding parse method.Each parser method is of type tokenlist -> tokenlist * Ast`
Inside each method, I use the convention "tokenlist_symbol" to connote the tokenlist after consuming a specific symbol. In this line: let typ tokenlist_typ = parseTyp tokenlist in match tokenlist.head with, typ is an AST and tokenlist_typ is the remainder of the tokenlist after parseTyp has consumed the typ prefix.
However, I am getting This expression has type 'a -> token_list * Ast.typ
but an expression was expected of type Ast.typ error for line, (Ast.Declaration(typ, identifier, decls_prime), tokenlist_decls_prime)
type token_list =
{head : Lexer.token; (** head token. *)
lexbuf : Lexer.token list} (** lexer buffer. *)
(** Represents a parser buffer used during parsing of various productions. *)
let default_tokenlist s = {head = Lexer.EOF; lexbuf = Lexer.tokenize s}
(* Create a default [parse_buffer] with the given string [s]. *)
let next tokenlist =
let {head = _; lexbuf = buf} = tokenlist in
{head = List.hd buf; lexbuf = List.tl buf}
(** Retrieves a new parser buffer with the next lookahead token. *)
let parseTyp tokenlist =
match tokenlist.head with
| Lexer.Int -> (next tokenlist, Ast.Int)
| Lexer.Bool -> (next tokenlist, Ast.Bool)
| Lexer.Void -> (next tokenlist, Ast.Void)
| Lexer.EOF -> (tokenlist, Ast.Epsilon)
| _-> let err_msg = "Syntax Error" in
raise (Syntax_error err_msg)
(*decls = typ “id” decls_prime | epsilon *)
let rec parseDecls tokenlist =
let (tokenlist_typ, typ, ) = parseTyp tokenlist in
match tokenlist.head with
| Lexer.ID identifier -> let (tokenlist_decls_prime, decls_prime) = next tokenlist |> parseDeclsPrime in
(tokenlist_decls_prime, Ast.Declaration(typ, identifier, decls_prime))
| Lexer.EOF -> (tokenlist, [])
| _-> let err_msg = Printf.sprintf "Syntax Error" in
raise (Syntax_error err_msg)
(* decls_prime = vdecl decls | fdecl decls *)
and parseDeclsPrime tokenlist =
match tokenlist.head with
| Lexer.Semicolon -> let tokenlist_vdecl) = next tokenlist in
let (tokenlist_decls, decls) = parseDecls tokenlist_vdecl in
(tokenlist_decls, Ast.DeclsPrime(Lexer.Semicolon, vdecl, decls))
| Lexer.LeftParens -> let (tokenlist_fdecl, fdecl) = next tokenlist |> parseFdecl in
let (tokenlist_decls, decls) = parseDecls tokenlist_fdecl in
(tokenlist_decls, Ast.DeclsPrime(Lexer.Semicolon, fdecl, decls))
| _-> let err_msg = Printf.sprintf "Syntax Error" in
raise (Syntax_error err_msg)
You have this:
let (decls_prime, tokenlist_decls_prime) =
next tokenlist |> parseDeclsPrime
Judging by the names, this looks like parseDeclsPrime returns the type Ast * tokenlist. But it seems to me the parse functions are supposed to return tokenlist * Ast.
Most likely the two names in the pair are reversed.
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).
(A minimal non-compiling example can be found at https://gist.github.com/4044467, see more background below.)
I am trying to implement Bootstrapped Heaps introduced in Chapter 10 of Okasaki's Purely Functional Data Structure. The following is a simplified version of my non-compiling code.
We're to implement a heap with following signature:
module type ORDERED =
sig
type t
val compare : t -> t -> int
end
module type HEAP =
sig
module Elem : ORDERED
type heap
val empty : heap
val insert : Elem.t -> heap -> heap
val find_min : heap -> Elem.t
val delete_min : heap -> heap
end
We say a data structure is bootstrapped when its implementation depends on another implementation of the same kind of data structure. So we have a heap like this (the actual implementation is not important):
module SomeHeap (Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module Elem = Element
type heap
let empty = failwith "skipped"
let insert = failwith "skipped"
let find_min = failwith "skipped"
let delete_min = failwith "skipped"
end
Then, the bootstrapped heap we're going to implement, which can depend on any heap implementation, is supposed to have the following signature:
module BootstrappedHeap
(MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
(Element : ORDERED) : (HEAP with module Elem = Element)
So we can use it like this:
module StringHeap = BootstrappedHeap(SomeHeap)(String)
The implementation of BootstrappedHeap, according to Okasaki, is like this:
module BootstrappedHeap
(MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
(Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module Elem = Element
module rec BootstrappedElem :
sig
type t =
| E
| H of Elem.t * PrimH.heap
val compare : t -> t -> int
end =
struct
type t =
| E
| H of Elem.t * PrimH.heap
let compare t1 t2 = match t1, t2 with
| H (x, _), H (y, _) -> Elem.compare x y
| _ -> failwith "unreachable"
end
and PrimH : (HEAP with module Elem = BootstrappedElem) =
MakeH(BootstrappedElem)
type heap
let empty = failwith "not implemented"
let insert = failwith "not implemented"
let find_min = failwith "not implemented"
let delete_min = failwith "not implemented"
end
But this is not compiling! The error message is:
File "ordered.ml", line 52, characters 15-55:
Error: In this `with' constraint, the new definition of Elem
does not match its original definition in the constrained signature:
Modules do not match:
sig type t = BootstrappedElem.t end
is not included in
ORDERED
The field `compare' is required but not provided
The line 52 is the line
and PrimH : (HEAP with module Elem = BootstrappedElem) =
I think BootstrappedElem did implement ORDERED as it has both t and compare, but I failed to see why the compiler fails to find the compare function.
Change the signature of BootstrappedElem to
module rec BootstrappedElem : ORDERED
will make it compiling but this will hide the type constructor E and T in BootstrappedElem to make it impossible to implement the later parts.
The whole non-compiling code can be downloaded at https://raw.github.com/gist/4044281/0ce0336c40b277e59cece43dbadb9b94ce6efdaf/ordered.ml
I believe this might be a bug in the type-checker. I have reduced your code to the following example:
module type ORDERED =
sig
type t
val compare : t -> t -> int
end
module type CARRY = sig
module M : ORDERED
end
(* works *)
module HigherOrderFunctor
(Make : functor (X : ORDERED) -> (CARRY with module M = X))
= struct
module rec Base
: (ORDERED with type t = string)
= String
and Other
: (CARRY with module M = Base)
= Make(Base)
end
(* does not work *)
module HigherOrderFunctor
(Make : functor (X : ORDERED) -> (CARRY with module M = X))
= struct
module rec Base
: sig
(* 'compare' seems dropped from this signature *)
type t = string
val compare : t -> t -> int
end
= String
and Other
: (CARRY with module M = (Base : sig type t = string val compare : t -> t -> int end))
= Make(Base)
end
I don't understand why the first code works and the second (which seems equivalent) doesn't. I suggest you wait a bit to see if an expert comes with an explanation (Andreas?), then consider sending a bug report.
In this case, a solution is to first bind the signature that seems mishandled:
(* works again *)
module HigherOrderFunctor
(Make : functor (X : ORDERED) -> (CARRY with module M = X))
= struct
(* bind the problematic signature first *)
module type S = sig
type t = string
val compare : t -> t -> int
end
module rec Base : S = String
and Other : (CARRY with module M = Base) = Make(Base)
end
However, that is not possible in your setting, because the signature of BootstrappedElem is mutually recursive with BootstrappedHeap.
A workaround is to avoid the apparently-delicate with module ... construct and replace it with a simple type equality with type Elem.t = ...:
module BootstrappedHeap
(MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
(Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module Elem = Element
module rec BootstrappedElem :
sig
type t =
| E
| H of Elem.t * PrimH.heap
val compare : t -> t -> int
end =
struct
type t =
| E
| H of Elem.t * PrimH.heap
let compare t1 t2 = match t1, t2 with
| H (x, _), H (y, _) -> Elem.compare x y
| _ -> failwith "unreachable"
end
and PrimH : (HEAP with type Elem.t = BootstrappedElem.t) =
MakeH(BootstrappedElem)
type heap
let empty = failwith "not implemented"
let insert = failwith "not implemented"
let find_min = failwith "not implemented"
let delete_min = failwith "not implemented"
end
You could also avoid the mutual recursion and define both BootstrappedElem and BootstrappedHeap in one recursive knot, by defining BootstrappedElem inside the recursive BootstrappedHeap.
module BootstrappedHeap
(MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
(Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module rec BootstrappedHeap : sig
module Elem : sig
type t = E | H of Element.t * BootstrappedHeap.heap
val compare : t -> t -> int
end
include (HEAP with module Elem := Elem)
end = struct
module Elem = struct
type t = E | H of Element.t * BootstrappedHeap.heap
let compare t1 t2 = match t1, t2 with
| H (x, _), H (y, _) -> Element.compare x y
| _ -> failwith "unreachable"
end
include (MakeH(Elem) : HEAP with module Elem := Elem)
end
module Elem = Element
type heap
let empty = failwith "not implemented"
let insert = failwith "not implemented"
let find_min = failwith "not implemented"
let delete_min = failwith "not implemented"
end
This style corresponds naturally to your decision of embedding Elem in the HEAP signature and using with module ... for refinement. Another solution would have been to define HEAP as a functor returning a signature, used as HEAP(Elem).S, and I suppose a different recursive style could have been chosed. Not to say that this would have been better: I think the "abstract module" style is more convenient.
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