How to check if head is list in F# - list

Is there a function to check if an object is a list?
I did it like this:
try
let x = unbox<list<obj>>(l)
....
with
| _ -> ...
But i would like to check it with an if or match instead if it is possible.

I'd use:
let isList o =
let ty = o.GetType()
if (ty = typeof<obj>) then false
else
let baseT = ty.BaseType
baseT.IsGenericType && baseT.GetGenericTypeDefinition() = typedefof<_ list>
if (isList o) then
...
This will identify lists containing any type of item (int lists, string lists, etc.).

In case you know type of list elements you can use such code:
let is_list (x: obj) =
match x with
| :? list<int> -> printfn "int list"
| :? list<string> -> printfn "string list"
| _ -> printfn "unknown object"

Related

OCaml serializing a (no args) variant as a "string enum" (via Yojson)

Say I am building a record type:
type thing {
fruit: string;
}
But I want the possible values of fruit to be constrained to a fixed set of strings.
It seems natural to model this in OCaml as a variant, e.g.:
type fruit = APPLE | BANANA | CHERRY
type thing {
fruit: fruit;
}
Okay so far.
But if I use [##deriving yojson] on these types then the serialized output will be like:
{ "fruit": ["APPLE"] }
By default Yojson wants to serialize a variant as a tuple of [<name>, <args>...] which... I can see the logic of it, but it is not helpful here.
I want it to serialize as:
{ "fruit": "APPLE" }
Making use of a couple of ppx deriving plugins I managed to build this module to de/serialize as I want:
module Fruit = struct
type t = APPLE | BANANA | CHERRY [##deriving enum, variants]
let names =
let pairs i (name, _) = (name, (Option.get (of_enum i))) in
let valist = List.mapi pairs Variants.descriptions in
List.to_seq valist |> Hashtbl.of_seq
let to_yojson v = `String (Variants.to_name v)
let of_yojson = function
| `String s -> Hashtbl.find_opt names s
|> Option.to_result ~none:(Printf.sprintf "Invalid value: %s" s)
| yj -> Error (Printf.sprintf "Invalid value: %s" (Yojson.Safe.to_string yj))
end
Which works fine... but I have some other "string enum" variants I want to treat the same way. I don't want to copy and paste this code every time.
I got as far as this:
module StrEnum (
V : sig
type t
val of_enum : int -> t option
module Variants : sig
val descriptions : (string * int) list
val to_name : t -> string
end
end
) = struct
type t = V.t
let names =
let pairs i (name, _) = (name, (Option.get (V.of_enum i))) in
let valist = List.mapi pairs V.Variants.descriptions in
List.to_seq valist |> Hashtbl.of_seq
let to_yojson v = `String (V.Variants.to_name v)
let of_yojson = function
| `String s -> Hashtbl.find_opt names s
|> Option.to_result ~none:(Printf.sprintf "Invalid StrEnum value: %s" s)
| yj -> Error (Printf.sprintf "Invalid StrEnum value: %s" (Yojson.Safe.to_string yj))
end
module Fruit = struct
type t = APPLE | BANANA | CHERRY [##deriving enum, variants]
end
module FruitEnum = StrEnum (Fruit)
That much seems to type-check, and I can:
utop # Yojson.Safe.to_string (FruitEnum.to_yojson Fruit.APPLE);;
- : string = "\"APPLE\""
utop # FruitEnum.of_yojson (Yojson.Safe.from_string "\"BANANA\"");;
- : (FruitEnum.t, string) result = Ok Fruit.BANANA
...but when I try to:
type thing {
fruit: FruitEnum.t;
}
[##deriving yojson]
I get Error: Unbound value FruitEnum.t
It seems to be because I am re-exporting type t = V.t from the variant's module, I don't really understand though. (Or is it because the yojson ppx can't "see" the result of the functor properly?)
How can I fix this?
I would also like to be able to skip defining the variant module separately and just do:
module Fruit = StrEnum (struct
type t = APPLE | BANANA | CHERRY [##deriving enum, variants]
end)
...but this gives the error:
Error: This functor has type
functor
(V : sig
type t
val of_enum : int -> t option
module Variants :
sig
val descriptions : (string * int) list
val to_name : t -> string
end
end)
->
sig
type t = V.t
val names : (string, t) Hashtbl.t
val to_yojson : t -> [> `String of string ]
val of_yojson : Yojson.Safe.t -> (t, string) result
end
The parameter cannot be eliminated in the result type.
Please bind the argument to a module identifier.
and I don't understand what is wrong.
Regarding the last error, it's because OCaml requires a 'stable path' to types inside modules so it can refer to them. A stable path is a named path to a type, e.g. Fruit.t.
By contrast, StrEnum(struct type t = ... end).t is not a stable path because the type t is referencing a type t in the module literal which does not have a name.
Long story short, you basically can't skip defining the variant module separately. But it's simple to do it in two steps:
module Fruit = struct
type t = ...
end
module Fruit = StrEnum(Fruit)
The second definition refers to the first and shadows it. Shadowing is a well-known and often-used technique in OCaml.
Overall, I'm not sure all this PPX machinery is actually justified. You can pretty easily hand-write converter functions, e.g.
let to_yojson = function
| APPLE -> `String "APPLE"
| BANANA -> `String "BANANA"
| CHERRY -> `String "CHERRY"
Well, I was curious to have a go at writing a PPX deriver to perform this transformation.
Here's what I ended up with:
open Ppxlib
module List = ListLabels
let make_methods ~(loc : location) ~(is_poly : bool) (constructors : constructor_declaration list) =
let (module Ast) = Ast_builder.make loc in
let v_patt = match is_poly with
| true -> fun name -> Ast.ppat_variant name None
| false -> fun name -> Ast.ppat_construct { txt = (Lident name); loc } None
and v_expr = match is_poly with
| true -> fun name -> Ast.pexp_variant name None
| false -> fun name -> Ast.pexp_construct { txt = (Lident name); loc } None
in
let (to_cases, of_cases) =
List.map constructors ~f:(
fun cd ->
let name = cd.pcd_name.txt in
let to_case = {
pc_lhs = v_patt name;
pc_guard = None;
pc_rhs = [%expr `String [%e Ast.estring name] ];
} in
let of_case = {
pc_lhs = Ast.ppat_variant "String" (Some (Ast.pstring name));
pc_guard = None;
pc_rhs = [%expr Ok ([%e v_expr name]) ];
} in
(to_case, of_case)
)
|> List.split
in
let of_default_case = {
pc_lhs = [%pat? yj ];
pc_guard = None;
pc_rhs = [%expr Error (Printf.sprintf "Invalid value: %s" (Yojson.Safe.to_string yj)) ];
} in
let of_cases = of_cases # [of_default_case] in
let to_yojson = [%stri let to_yojson = [%e Ast.pexp_function to_cases]] in
let of_yojson = [%stri let of_yojson = [%e Ast.pexp_function of_cases] ] in
[to_yojson; of_yojson]
let type_impl ~(loc : location) (td : type_declaration) =
match td with
| {ptype_kind = (Ptype_abstract | Ptype_record _ | Ptype_open); _} ->
Location.raise_errorf ~loc "Cannot derive yojson_str_enum for non variant types"
| {ptype_kind = Ptype_variant constructors; _} -> begin
let invalid_constructors =
List.filter_map constructors ~f:(
fun cd -> match cd.pcd_args with
| (Pcstr_tuple [] | Pcstr_record []) -> None
| _ -> Some (cd)
)
in
if (List.length invalid_constructors) > 0 then
Location.raise_errorf ~loc "Cannot derive yojson_str_enum for variant types with constructor args";
match is_polymorphic_variant td ~sig_:false with
| `Definitely | `Maybe -> make_methods ~loc ~is_poly:true constructors
| `Surely_not -> make_methods ~loc ~is_poly:false constructors
end
let generate_impl ~ctxt (_rec_flag, type_declarations) =
(* [loc] is "location", not "lines of code" *)
let loc = Expansion_context.Deriver.derived_item_loc ctxt in
List.map type_declarations ~f:(type_impl ~loc)
|> List.concat
let yojson_str_enum =
Deriving.add
"yojson_str_enum"
~str_type_decl:(Deriving.Generator.V2.make_noarg generate_impl)
to make usable it needs a dune file something like:
(library
(kind ppx_rewriter)
(name <lib name>)
(preprocess (pps ppxlib.metaquot))
(libraries yojson ppxlib))
After adding <lib name> to the pps in your dune file, usage is like:
module Fruit = struct
type t = APPLE | BANANA | CHERRY [##deriving yojson_str_enum]
end
It seems to work fine for my use case. It might be extended per the comment by #Yawar to take args allowing to specify to/from string transform functions for the variant labels. But I was happy just with Fruit.APPLE -> "APPLE" for now. I should also implement the sig_type_decl version.
One part I am a bit uncertain about is this:
match is_polymorphic_variant td ~sig_:false with
| `Definitely | `Maybe -> make_methods ~loc ~is_poly:true constructors
| `Surely_not -> make_methods ~loc ~is_poly:false constructors
I am not very clear when the `Maybe case occurs or how it should most correctly be handled, or if there is a better way of detecting "backtick variants" than using the is_polymorphic_variant method from ppxlib.

Java GuardTypes analogy for OCaml

How do you do, Stackoverflow!
In Java practice there are some issues concerning partially defined functions. Sometimes it's convinient to separate an error handling from the calculation itself. We may utilize an approach called "Guard types" or "Guard decorators".
Consider the simple synthetic example: to guard the null reference. This can be done with the aid of the next class
public class NonNull<T> {
public take() {
return null != this.ref ? this.ref : throw new ExcptionOfMine("message");
}
public NotNull(T ref_) {
this.ref = ref_;
}
private T ref;
}
The question is:
Is there a way to implement the same "Guard type" in OCaml without touching its object model? I believe for the OCaml as the functional programming language to possess enough abstraction methods without objec-oriented technics.
You can use an abstract type to get the same effect. OCaml has no problem with null pointers. So say instead you want to represent a nonempty list in the same way as above. I.e., you want to be able to create values that are empty, but only complain when the person tries to access the value.
module G :
sig type 'a t
val make : 'a list -> 'a t
val take : 'a t -> 'a list
end =
struct
type 'a t = 'a list
let make x = x
let take x = if x = [] then raise (Invalid_argument "take") else x
end
Here's how it looks when you use the module:
$ ocaml
OCaml version 4.02.1
# #use "m.ml";;
module G :
sig type 'a t val make : 'a list -> 'a t val take : 'a t -> 'a list end
# let x = G.make [4];;
val x : int G.t = <abstr>
# G.take x;;
- : int list = [4]
# let y = G.make [];;
val y : '_a G.t = <abstr>
# G.take y;;
Exception: Invalid_argument "take".
There's a concept of Optional types, on which you can effectively pattern match. Example:
let optional = Some 20
let value =
match optional with
| Some v -> v
| None -> 0
You can use simple closures
let guard_list v =
fun () ->
if v = [] then failwith "Empty list"
else v
let () =
let a = guard_list [1;2;3] in
let b = guard_list [] in
print_int (List.length (a ())); (* prints 3 *)
print_int (List.length (b ())) (* throws Failure "Empty list" *)
or lazy values
let guard_string v = lazy begin
if v = "" then failwith "Empty string"
else v
end
let () =
let a = guard_string "Foo" in
let b = guard_string "" in
print_endline (Lazy.force a); (* prints "Foo" *)
print_endline (Lazy.force b) (* throws Failure "Empty string" *)

Information hiding with OCaml records

Given
type 'a set = { insert : 'a -> 'a set; contains : 'a -> bool }
How can I implement
val empty : 'a set
?
I've tried closing over something, say a list, but the return type is wrong.. since it is. (ignoring the fact that the performance characteristics here are terrible :-) )
let empty =
let rec insert_f set a =
match set with
| [] -> a :: []
| k :: rest ->
if k = a then
k :: rest
else
k :: insert_f rest a
in
let rec contains_f set a =
match set with
| [] -> false
| k :: rest ->
if k = key then
true
else contains_f rest a
in
{ insert = insert_f []; contains = contains_f []}
directly writing the empty is not the easiest in such data structure, as you will need to write the insert, which will contains again an insert and so one... So let's write first the insert:
let rec insert : 'a set -> 'a -> 'a set = fun s x -> {
insert = (fun y -> failwith "TODO");
contains = (fun y -> if x = y then true else s.contains y) }
in insert, you want to recursively call insert, but the first parameter will be the record you are writing. So here is the complete solution:
let rec insert : 'a set -> 'a -> 'a set = fun s x ->
let rec ss = {
insert = ( fun y -> insert ss y);
contains = (fun y -> if x = y then true else s.contains y)}
in ss
let rec empty = {
insert = (fun x -> insert empty x);
contains = (fun x -> false)}
First of all, it's bool, not boolean. :)
Second, this definition is quite cumbersome. But you can do something like:
let empty = {
insert=(fun x -> {
insert=(fun x -> assert false);
contains=(fun x-> assert false)});
contains=(fun x -> false)}
with your implementations of insert and contains for non-empty sets in place of "assert false" of course.
A hint for implementing insert and contains: don't use any lists, use compositions of a functions from existing and new sets.
You can find nice examples in e.g. "On Understanding Data Abstraction, Revisited" by W. Cook, that paper is available online.

FSharp pattern that matches List type

I want to match the object obj1 of type "obj" according to its actual type.
The problem is that the type check pattern for list type (the second one in the example below) does not match F# lists.
let obj1 = [1;2;3] :> obj
match obj1 with
| :? System.Array as a -> printfn "it's an array: %A" a
| :? List<_> as l -> printfn "It's a list: %A" l
| _ -> printfn "other type"
Outputs "other type", while I expect it to be "It's a list: [1;2;3]"
How to check for list type properly?
Daniel Fabian has already explained the problem in his answer.
One way to implement his solution is with an Active Pattern:
let (|IsList|_|) (candidate : obj) =
let t = candidate.GetType()
if t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<list<_>>
then Some (candidate :?> System.Collections.IEnumerable)
else None
You can now change the match to use this active pattern:
let obj1 = [1;2;3] :> obj
match obj1 with
| :? System.Array as a -> printfn "it's an array: %A" a
| IsList l -> printfn "It's a list: %A" l
| _ -> printfn "other type"
This prints:
> It's a list: [1; 2; 3]
obj : [any type]
What you need to do, is distinguish if your obj is a generic type. Get the type of it by means of .GetType() there you'll find the appropriate property.
obj : [some type of the form T<'T1, 'T2, ..., 'Tn> for concrete types T1, T2, ..., Tn]
If it is, then you get the generic type definition by using the appropritate method on the type you got by means of .GetType()
obj : [some type of the form T<'T1, 'T2, ..., 'Tn> with T1, T2, ..., Tn not bound yet]
and this type you now can compare to typedefof<_ list> (_ list is inferred to be obj list, but typedefof as opposed to typeof does the getting of generic type definition for you already).
The final code looks something like this (pseudo-code)
let ty = obj.GetType()
match obj with
| unknownType when not ty.IsGenericType -> "some non-generic type, probably a concrete collection"
| list when ty.GetGenericTypeDefinition() = typedefof<_ list> -> "list"
| array when ty.GetGenericTypeDefinition() = typedefof<_ array> -> "array"
| _ -> "something else, i.e. a generic type that we don't know"
I would not call List<_> as F# list - it is .NET framework type. You can match it with (int list) type - it is F# list:
match obj1 with | :? (int list) as l -> 1 | _ -> 0

Filtering OCaml list to one variant

So I have a list of stmt (algebraic type) that contain a number of VarDecl within the list.
I'd like to reduce the list from stmt list to VarDecl list.
When I use List.filter I can eliminate all other types but I'm still left with a stmt list.
I found that I was able to do the filtering as well as the type change by folding, but I can't figure out how to generalize it (I need this pattern many places in the project).
let decls = List.fold_left
(fun lst st -> match st with
| VarDecl(vd) -> vd :: lst
| _ -> lst
) [] stmts in
Is there a better way to perform a filter and cast to a variant of the list type?
Assuming you have a type like
type stmt = VarDecl of int | Foo of int | Bar | Fie of string
and a stmt list, Batteries lets you do
let vardecl_ints l =
List.filter_map (function Vardecl i -> Some i | _ -> None) l
let foo_ints l =
List.filter_map (function Foo i -> Some i | _ -> None) l
which I think is about as concise as you're going to get. I don't
think you can make general "list-getters" for ADT's, because e.g.
let bars l =
List.filter_map (function Bar -> Some Bar | _ -> None) l
https://github.com/ocaml-batteries-team/batteries-included/blob/d471e24/src/batList.mlv#L544
has the Batteries implementation of filter_map, if you don't want the
dependency. A functional version with [] instead of dst would be quite similar, only doing
(x::dst) and a |>List.rev at the end.
You could use GADTs or polymorphic variants, but both tend to drive up complexity.
Here's a rough sketch of how you might approach this problem with polymorphic variants:
type constant = [ `Int of int | `String of string ]
type var = [ `Var of string ]
type term = [ constant | var | `Add of term * term ]
let rec select_vars (list : term list) : var list =
match list with
| [] -> []
| (#var as v)::list -> v::select_vars list
| _::list -> select_vars list
let rec select_constants (list : term list) : constant list =
match list with
| [] -> []
| (#constant as k)::list -> k::select_constants list
| _::list -> select_constants list
Another possibility is to pull the bits of a var out into an explicit type of which you can have a list:
type var = {
...
}
type term =
| Int of int
| Var of var
This has some overhead over having the bits just be constructor args, and a var is not a term, so you will likely need to do some wrapping and unwrapping.
It's hard to answer without seeing your type definition (or a simplified version of it).
Note, though, that if you have this definition:
type xyz = X | Y | Z
The values X, Y, and Z aren't types. They're values. Possibly Vardecl is a value also. So you can't have a list of that type (in OCaml).
Update
One thing I have done for cases like this is to use the type projected from the one variant you want:
type xyz = X | Y of int * int | Z
let extract_proj v l =
match v with
| X | Z -> l
| Y (a, b) -> (a, b) :: l
let filter_to_y l =
List.fold_right extract_proj l []
Here's a toplevel session:
type xyz = X | Y of int * int | Z
val extract_proj : xyz -> (int * int) list -> (int * int) list = <fun>
val filter_to_y : xyz list -> (int * int) list = <fun>
# filter_to_y [X; Z; Y(3,4); Z; Y(4,5)];;
- : (int * int) list = [(3, 4); (4, 5)]