Functor in Ocaml - ocaml

I have a problem with functor in Ocaml. I have this situation:
module type EveryType =
sig
type t
val str : t -> string
end;;
module type StackInterface =
functor (El : EveryType) ->
sig
type el = El.t
type stack
exception EmptyStackException
val empty : stack
val pop : stack -> stack
val top : stack -> el
val push : stack -> el -> stack
val str : stack -> string
end;;
module StackImpl (El : EveryType) =
struct
type el = El.t
type stack = Empty | Node of el * stack
exception EmptyStackException
let empty = Empty
let pop s =
match s with
| Empty -> raise EmptyStackException
| Node(_, t) -> t
let top s =
match s with
| Empty -> raise EmptyStackException
| Node(h, _) -> h
let push s el = Node(el, s)
let str s =
let rec str s =
match s with
| Node(h, Empty) -> El.str h ^ ")"
| Node(h, t) -> El.str h ^ ", " ^ str t
| _ -> ""
in
if s == Empty then
"Stack()"
else
"Stack(" ^ str s
end;;
module Stack = (StackImpl : StackInterface);;
module TypeChar =
struct
type t = char
let str c = Printf.sprintf "%c" c
end;;
module StackChar = Stack(TypeChar);;
module CheckExp(St : module type of StackChar) =
struct
let checkExp str =
let rec checkExp str stk =
try
match str with
| [] -> true
| '(' :: t -> checkExp t (St.push stk '(')
| ')' :: t -> checkExp t (St.pop stk)
| _ :: t -> checkExp t stk
with St.EmptyStackException -> false
in checkExp (explode str) St.empty
end;;
I create a Stack with functor to have a stack of every type. Now I want to use this stack (with type char) in a function that check parantesis into an expression. But compiler gives me this error: Unbound module type StackChar refered to line module CheckExp(St : StackChar) =
What have I wrong???

StackChar is a module, but what you need for a functor is a module type. It wouldn't be much of a functor if you always pass it the same module. The simplest fix for this is to replace it with module type of StackChar:
module CheckExp(St : module type of StackChar) =
struct
...
end
But are you sure you actually need a functor here?

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.

Signature mismatch when trying to use a module in another module

I'm having a problem where I have one module trying to use another one, but I'm getting an error claiming there's a signature mismatch and I'm not certain why. I was pretty sure I was doing this right though. Here's some code:
module type ITEM =
sig
type item
val leq : item * item -> bool
val initial : item
end
module type HEAP =
sig
type item
type tree
exception InitHeap
val depth : tree -> int
val initHeap : int -> tree
val insert : item * tree -> tree
val isHeap : tree -> bool
val maxHeap : tree -> item
val replace : item * tree -> item * tree
val size : tree -> int
val top : tree -> item
end
module Heap (Item: ITEM) : HEAP =
struct
type item = Item.item
let leq(p, q) : bool = Item.leq(p,q)
let max(p,q) = if leq(p,q) then q else p
and min(p,q) = if leq(p,q) then p else q
let intmax((p : int),q) = if p <= q then q else p
type tree =
| L of item
| N of item * tree * tree
exception InitHeap
let rec initHeap n =
if (n < 1) then raise InitHeap
else if n = 1 then L Item.initial
else let t = initHeap(n - 1)
in N (Item.initial, t, t)
let rec top t =
match t with
| (L i) -> i
| N (i,_,_) -> i
let rec isHeap t =
match t with
| (L _) -> true
| (N(i,l,r)) ->
leq(i,top l) && leq(i,top r) && isHeap l && isHeap r
let rec depth t =
match t with
| (L _) -> 1
| N(i,l,r) -> 1 + intmax(depth l,depth r)
let rec replace (i,h) = (top h, insert(i,h))
and insert (i, h) =
match h with
| L _ -> L i
| N (_,l,r) ->
if leq(i,min(top l,top r))
then N(i,l,r)
else if leq((top l),(top r))
then N(top l,insert(i,l),r)
else N(top r,l,insert(i,r))
let rec size h =
match h with
| L _ -> 1
| N (_,l,r) -> 1 + size l + size r
let rec maxHeap h =
match h with
| (L i) -> i
| N (_,l,r) -> max(maxHeap l, maxHeap r)
end
So Heap includes a bunch of functions that just do simple operations on a Heap but for some reason ocaml thinks that the signature for HEAP is supposed to include functions for ITEM, but I just want to pull ITEM functions into HEAP
The error I get:
Error: Signature mismatch:
Modules do not match:
sig val leq : int * int -> bool end
is not included in
ITEM
The value `initial' is required but not provided
File "lab13.ml", line 28, characters 8-26: Expected declaration
The type `item' is required but not provided
File "lab13.ml", line 26, characters 8-17: Expected declaration
Thanks for any help in advance!
You most probably wrote
module type HEAD = functor (Head:ITEM) -> sig … end
(and not module type HEAD = functor (Head:HEAD) -> sig … end which is recursely using the HEAD module type which is a type error )
when you meant
module type HEAD = sig … end
Adding the functor(HEAD:ITEM) -> … part makes HEAD the signature or a functor. Therefore
module Heap (Item: ITEM) : HEAP
is the same thing as
module Heap (Item: ITEM) : functor(Heap:HEAP) -> sig … end
in other words, the signature that you added make Heap a higher-order functor; which is obviously not the case of the implementation.
Unfortunately, error messages in presence of functors are lacking right now, and the type-checker does not detail error in this specific case for now.
Rewriting the HEAD module type as
module type HEAD = sig … end
should fix this problem.

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" *)

OCaml: Functor application in type declaration

I am trying to parametrise a functor using a type parameter in a declaration. As an example, suppose I have the following GADT declaration:
type _ basic =
| String : string -> string basic
| Integer : int -> int basic
I want to use Map.Make to construct maps using the above type as the key type. Since I cannot leave a type variable free in type t = 'a basic, I have a functor to make 'a basic into an OrderedType:
module OrderedBasic(Type : sig type tag end) :
(Map.OrderedType with type t = Type.tag basic) =
struct
type t = Type.tag basic
let compare : type a. a basic -> a basic -> int = fun b1 b2 ->
match b1, b2 with
| String s1, String s2 -> String.compare s1 s2
| Integer i1, Integer i2 -> compare i1 i2
end
I can create the maps I wanted:
module OrderedBasicString = OrderedBasic(struct type tag = string end)
module BasicStringMap = Map.Make(OrderedBasicString)
and name the map type:
type 'v string_map = 'v BasicStringMap.t
However, what I would like to do is to parametrise the type of maps by the type parameter of basic, i.e., something like:
type ('k, 'v) basic_map = 'v Map.Make(OrderedBasic(struct type tag = 'k end)).t
But this doesn't seem to be allowed: I get a syntax error at the inline struct definition. Ultimately, I want to embed maps, which can have any of the above basic key types, in another GADT as in:
type _ data =
Map : 'a data Map.Make(OrderedBasic(struct type tag = 'b end)).t -> 'c data
Is there a way to make this work?
The problem is that Map is defined over key types of fixed arity, and that arity is zero.
It's easy if the functor you are using allows the arity you want:
type _ basic =
| String : string -> string basic
| Integer : int -> int basic
module type INDEXED = sig
type 'a t
val equal : 'a t -> 'a t -> bool
end
module MakeAlist (Elt : INDEXED) = struct
type ('i, 'v) t = Nil | Cons of 'i Elt.t * 'v * ('i, 'v) t
let rec find elt = function
| Nil -> None
| Cons (x, v, xs) ->
if Elt.equal elt x then Some v
else find elt xs
(* etc *)
end
module BasicAlist = MakeAlist (struct
type 'a t = 'a basic
let equal : type a . a basic -> a basic -> bool = fun b1 b2 ->
match b1, b2 with
| String s1, String s2 -> s1 = s2
| Integer i1, Integer i2 -> i1 = i2
end)
type _ data = Map : ('a data, 'b) BasicAlist.t -> 'c data
I won't go as far as suggesting that you reimplement Map with the arity that you want, although that would solve your problem - there might be some trick I'm not aware of that would let you reuse Map.
You have to use a map that is polymorphic in the type of the key such as the map from core.
open Core.Std
module Basic = struct
type 'a t =
| String : string -> string t
| Int : int -> int t
let sexp_of_t : type a. a t -> Sexp.t = function
| String s -> String.sexp_of_t s
| Int i -> Int.sexp_of_t i
let compare : type a. a t -> a t -> int = fun b1 b2 ->
match b1, b2 with
| String s1, String s2 -> String.compare s1 s2
| Int i1, Int i2 -> compare i1 i2
end
module Cmp = Comparator.Make1(Basic)
type _ data =
Map : ('a Basic.t, 'b, Cmp.comparator_witness) Map.t -> 'c data

How to cast the type in functors OCaml

I've get the follow code about the functors in OCaml:
type comparison = Less | Equal | Greater;;
module type ORDERED_TYPE =
sig
type t
val compare: t -> t -> comparison
end
;;
module Set =
functor (Elt: ORDERED_TYPE) ->
struct
type element = Elt.t
type set = element list
let empty = []
let rec add x s =
match s with
| [] -> [x]
| hd :: tl ->
match Elt.compare x hd with
| Equal -> s
| Less -> x :: s
| Greater -> hd :: add x tl
let rec member x s =
match s with
| [] -> false
| hd :: tl ->
match Elt.compare x hd with
| Equal -> true
| Less -> false
| Greater -> member x tl
end
;;
module OrderedString : ORDERED_TYPE =
struct
type t = string
let compare x y =
if x = y then Equal
else if x < y then Less
else Greater
end
;;
module StringSet = Set(OrderedString);;
let out = StringSet.member "foo" (StringSet.add "foo" StringSet.empty);; (*compile error, where "foo" is expected OrderedString.t but actually is string*)
The above error can be avoided by eliminating the : ORDERED_TYPE in module OrderedString : ORDERED_TYPE =
Just can't understand why.
Analogously, if there is any type in a module like
module A = struct type t = string end;;
How can I specify a string value as the type A.t but not an actual string
Thanks.
You can look at how it is done in the standard library : set.mli.
The signature of the functor is
module Make (Ord : OrderedType) : S with type elt = Ord.t
the with type elt = Ord.t part indicates that the elt type is not abstract.
As mentioned by Tomash, you're lacking a type constraint, but not in the functor signature (there isn't any in your code in fact), but in the argument you're giving to it. Basically, when you write
module OrderedString : ORDERED_TYPE = struct ... end
the definition of the type t in OrderedString will be abstracted away, since t is an abstract type in the ORDERED_TYPE signature. What you want here is to say that OrderedString is indeed an implementation of ORDERED_TYPE, but with a known type t. This is exactly what you'll get with
module OrderedString: ORDERED_TYPE with type t = string = struct ... end