How can I convert JavaScript values to a variant in reasonml? - ocaml

There are three values in JavaScript:
Result.granted
Result.denied
Result.neverAskAgain
How can they be converted to a variant?
type result =
| Granted
| Denied
| NeverAskAgain;

Edit: a better option is to use https://bucklescript.github.io/docs/en/generate-converters-accessors#usage-5
You can bind to the values, then write a function which converts the values into a variant.
Bind to the values:
type t';
[#bs.module "result"] external granted: t';
[#bs.module "result"] external denied: t';
[#bs.module "result"] external neverAskAgain: t';
Then convert them into the variant:
type t = Granted | Denied | NeverAskAgain;
let fromJS = t' =>
switch (t' === granted, t' === denied, t' === neverAskAgain) {
| (true, _, _) => Granted
| (_, true, _) => Denied
| (_, _, true) => NeverAskAgain
};

Related

How to construct a correct type transformation in OCaml?

In order to map from a constructed type tainted_value to other types, and from other basic types to the constructed type tainted_value, there are two functions constructed.
First, the type tainted_value is defined as:
type object_ = int
and location = Obj of object_ | Null
and closure = var * cmd * stack
and value = Fld of string | Int of int | Loc of location | Clo of closure
and tainted_value = Val of value | Error
If I just let my first function mapping from tainted_value to string look like:
let tva_to_string tva1 = match tva1 with
| Val (Fld e) -> e
| _ -> None
It reports error as:
This expression has type 'a option but an expression was expected of type string
However, it will not return error if I change None into failwith "Empty":
let tva_to_string tva1 = match tva1 with
| Val (Fld e) -> e
| _ -> failwith "Empty"
Why?
None is a constructor for the option type. If one clause in a match returns None then the others must return some other value of type option. They may also raise an exception, which is what the failwith function does.
The other constructor for option is Some, so you may be looking for:
let tva_to_string tva1 = match tva1 with
| Val (Fld e) -> Some e
| _ -> None
This will alleviate your type-checking issues. Of course, it still doesn't return a string so your naming of the function either needs some work, or you need to return strings.

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.

How to make a func. in Ocaml, that accepts two boolean values and a char (operation) and then returns a corresponding logical value

How can I write a function in Ocaml, that would accept two boolean values (for instance a and b, that would represent logical values 0 and 1) and a character, that would determine the operation between these two logical values? The function would then return true or false, depending on the corresponding logical value input.
There is both a semantic, as well as a syntax error in this code; well, maybe there are more, but the compiler only made a complaint about this one so far:
line 2, characters 27-30:
Error: This expression has type char but an expression was expected of type
bool
This is what the compiler has stated about the code and here's what I've wrote:
let logic (a, b) operation = match operation with
| true -> if (operation == 'A') then match (a,b) with
| (true, true) -> true
| _ -> false
else if (operation == '0') then match (a,b) with
| (false,false) -> false
| _ -> true
else if (operation == 'X') then match (a,b) with
| (true,true) -> false
| (false,false) -> false
| _ -> true
else if (operation == 'I') then match (a,b) with
| (true, false) -> false
| _ -> true
else then match (a,b) with
| _ -> false
| false -> end;;
logic (a,b) 'A';;
--------------------------------------------------------------------------
OK, I've made some progress,at least it compiles now. However I still get an error, when I try to call the "logic" function with this line:
logic (true, false) 'A';;
The error states this:
Error: This expression has type bool
This is not a function; it cannot be applied.
Here's what I wrote now:
let logic (a, b) operation = match operation with
| 'A' -> (match (a,b) with
| (true, true) -> true
| _ -> false
)
| '0' -> (match (a,b) with
| (false,false) -> false
| _ -> true
)
| 'X' -> (match (a,b) with
| (true,true) -> false
| (false,false) -> false
| _ -> true)
| 'I' -> (match (a,b) with
| (true, false) -> false
| _ -> true
)
| _ -> (match (a,b) with
| _ -> false
)
To expand on the comment of #Elan-Hamburger a little bit.
You have this:
match operation with
| true -> ...
But your operation is a character. So this won't work. You can only match operation against specific characters.
It's especially strange since you later compare operator to various characters using ==. But the match will do that for you.
In other words you can have something like this:
match operation with
| 'A' -> ...
| '0' -> ...
| 'X' -> ...
| 'I' -> ...
| _ -> ...
There are many other problems with your code. Here are some comments:
You have nested match statements, which requires parentheses to work out right. If you try to nest without parentheses there's no way to tell when the inner match is over and further alternatives (starting with |) of the outer match are given.
Nested match statements look like this:
match expr with
| X ab ->
(match ab with
| A -> 4
| B -> 2
)
| Y _ -> 0
(You can also use begin/end instead of parentheses if you prefer the way that looks.)
You're using == to compare values. The ordinary equality comparison operator is =. The special operator == should only be used when you have a specific reason for it.
You have code that reads like this:
else then match ...
This can't be syntactically correct. Possibly the then is left over from an edit.
You can simplify this expression
match (a, b) with
| _ -> false
to this simpler expression:
false
Update
I can't reproduce your new reported problem. In fact your new code works OK for me in two quick tests.
. . .
val logic : bool * bool -> char -> bool = <fun>
# logic (true, false) 'A';;
- : bool = false
# logic (true, true) 'A';;
- : bool = true
Possibly there was some extraneous input (or extraneous definitions) in your top-level session. I suggest just trying again with a fresh session.

Interpreter with Ocaml

I write an interpreter with Ocaml but when i try :
sem(Let("Somma",Fun("x",Sum(Den "x",Eint(5))),Let("pipa",Pipe(Seq(Den "Somma",Nil)),Apply(Den "pipa",Eint(42)))),(emptyenv Unbound));;
the resault is an error : "Exception: Match_failure ("",1,41)
I think that error is in applyPipe but I don't understand where and why there is
Where did i wrong?
this is my code :
type exp =
.
.
.
| Fun of ide * exp
| Apply of exp * exp
| Letrec of ide * ide * exp * exp
| Etup of tuple (*Tupla come espressione*)
| Pipe of tuple (*Concatenazione di funzioni*)
| ManyTimes of int * exp (*Esecuzione iterata di una funzione*)
and tuple =
| Nil (*Tupla vuota*)
| Seq of exp * tuple (*Tupla di espressioni*)
;;
type eval=
| Int of int
| Bool of bool
| Unbound
| RecFunVal of ide * ide * exp * eval env
| Funval of efun
| ValTup of etuple
and efun = ide * exp * eval env
and etuple =
| Nil
| Seq of eval * etuple
;;
let rec sem ((ex: exp), (r: eval env)) = match ex with
.
.
.
| Let(i, e1, e2) -> sem(e2, bind (r, i, sem(e1, r)))
| Fun(i,a) -> Funval(i,a,r)
| Letrec(f, i, fBody, letBody) ->
let benv = bind(r, f, (RecFunVal(f, i, fBody, r)))
in sem(letBody, benv)
| Etup(tup) -> (match tup with
| Seq(ex1, tupla) ->
let evex1 = sem(ex1, r) in
let ValTup(etupl) = sem(Etup(tupla), r) in
ValTup(Seq(evex1, etupl))
| Nil -> ValTup(Nil))
| Apply(Den f, arg1) ->
(let fclosure= sem(Den f, r) in
match fclosure with
| Funval(arg, fbody, fDecEnv) ->
sem(fbody, bind(fDecEnv, arg, sem(arg1, r)))
| RecFunVal(f, arg, fbody, fDecEnv) ->
let aVal= sem(arg1, r) in
let rEnv= bind(fDecEnv, f, fclosure) in
let aEnv= bind(rEnv, arg, aVal) in
sem(fbody, aEnv)
| _ -> failwith("non functional value"))
| Apply(Pipe tup, arg) -> applyPipe tup arg r
| Apply(_,_) -> failwith("not function")
| _ -> failwith("non implementato")
and applyPipe tup argo r = (match tup with
| Seq(Den f, tupla) ->
let appf = Apply(Den f,argo) in
applyPipe tupla appf r
| Nil -> sem(argo,r)
| _ -> failwith("Not a valid Pipe"))
;;
The complete code is there : http://pastebin.com/VgpanX51
Please help me thaks
When you compile (or evaluate in a toplevel) an OCaml program, a typechecker will emit warnings about all pattern matches that are irrefutable, i.e., such patterns that may raise a Match_failure exception.
What you should do, is to go through all warnings and fix them.
There are quite a few irrefutable matches in your code, e.g., the sem function final match Apply(_,_) -> failwith("not function") will only catch Apply terms, but will not catch all others, adding something like _ -> failwith "unimplemented" will fix it.
QA
the error is in the try-code or in my interpreter?
It is in the interpreter, you didn't include all possible cases in your pattern-matching code.
.I do extend the typechecker
You don't need to. The typechecker verifies whether you anticipated all possible cases, for example, let's take the simple example:
type abc = A | B | C
let string_of_abc abc = match abc with
| A -> "A"
| B -> "B"
When you will try to compile (or interpret) the above code the typechecker will tell you:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
C
type abc = A | B | C
So, it gives you a hint, that you forgot to match with the C constructor, so the expression string_of_abc C will terminate with a Match_failure exception.
You can follow the hints and add the cases one-by-one. Given your example, the pattern matching in the sema function is incomplete, and the type checker hits you with the following:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(Pipe _|ManyTimes (_, _))
And indeed, you missed the case with Pipe, so when the interpreter sees
Pipe(...)
It can't find a match, as according to your code you're expecting the Pipe constructor only as a first argument to Apply, when in your example, you're actually passing it as a second argument to Let.

Syntax errors in sml code [closed]

This question is unlikely to help any future visitors; it is only relevant to a small geographic area, a specific moment in time, or an extraordinarily narrow situation that is not generally applicable to the worldwide audience of the internet. For help making this question more broadly applicable, visit the help center.
Closed 10 years ago.
I'm learning sml and trying to make a program that simplifies logic formulas. When I try to run this code, I always get the same error, which I cannot figure out. It's always "Error: syntax error: deleting BAR ID DARROW". I've attached the code below:
- fun Simplify (Or(True, _)) = True
= | Simplify (Or(_, True)) = True
= | Simplify (Or(False, False)) = False
= | Simplify (Or(x, False)) = (Simplify x)
= | Simplify (Or(False, x)) = (Simplify x)
= | Simplify (Or (Var (x), Var (y))) = Or (Var (x), Var (y))
= | Simplify (Or (x, y)) = case Simplify x of
= True => True
= | False => Simplify y
= | x' => case Simplify
= | True => True
GC #0.0.0.0.2.85: (2 ms)
= | False => x'
stdIn:50.6-50.15 Error: syntax error: deleting BAR ID DARROW
- | y' => Or(x', y')
= (*And*)
= | Simplify (And(_, False)) = False
stdIn:2.1-2.8 Error: syntax error: deleting BAR ID DARROW
stdIn:54.1-54.11 Error: syntax error: deleting BAR ID
- | Simplify (And(False, _)) = False
stdIn:1.1-2.6 Error: syntax error: deleting BAR ID
- | Simplify (And(True, True)) = True
= | Simplify (And(True, x)) = (Simplify x)
stdIn:1.1-2.6 Error: syntax error: deleting BAR ID
- | Simplify (And(x, True)) = (Simplify x)
= | Simplify (And(Var (x), Var(y))) = And (Var (x), Var (y))
stdIn:1.1-2.6 Error: syntax error: deleting BAR ID
- | Simplify (And (x, y)) = case Simplify x of
stdIn:1.1-2.6 Error: syntax error: deleting BAR ID
stdIn:53.3-57.4 Error: syntax error: deleting CASE ID
- False => False
= | True => Simplify y
stdIn:2.6-62.6 Error: syntax error: deleting DARROW ID BAR
- | x' => case Simplify y of
= | False => False
stdIn:1.5-2.7 Error: syntax error: deleting BAR ID DARROW
- | True => x'
= | y' => And(x', y')
stdIn:1.5-2.9 Error: syntax error: deleting BAR ID DARROW
- (*Not*)
- | Simplify (Not(Not(x))) = (Simplify x)
= | Simplify (Not(True)) = False
stdIn:68.1-68.11 Error: syntax error: deleting BAR ID
- | Simplify (Not(False)) = True
= | Simplify (Not(Var (x))) = (Not (Var x))
stdIn:1.1-68.3 Error: syntax error: deleting BAR ID
GC #0.0.0.0.3.201: (1 ms)
- | Simplify (Not x) = case Simplify x of
stdIn:1.1-68.3 Error: syntax error: deleting BAR ID
stdIn:68.14-71.4 Error: syntax error: deleting CASE ID
- True => False
= | False => True
stdIn:68.3-74.6 Error: syntax error: deleting DARROW ID BAR
- | x' => Not x'
= (*general*)
= | Simplify True = True
stdIn:1.5-68.4 Error: syntax error: deleting BAR ID DARROW
- | Simplify False = False
= | Simplify (Var(x)) = Var(x);
I've added the whole code:
datatype formula =
True
| False
| Var of string
| Not of formula
| And of formula * formula
| Or of formula * formula;
fun Simplify (Or(True, _)) = True
| Simplify (Or(_, True)) = True
| Simplify (Or(False, False)) = False
| Simplify (Or(x, False)) = (Simplify x)
| Simplify (Or(False, x)) = (Simplify x)
| Simplify (Or (Var (x), Var (y))) = Or (Var (x), Var (y))
| Simplify (Or (x, y)) = case Simplify x of
True => True
| False => Simplify y
| x' => case Simplify y of
| True => True
| False => x'
| y' => Or(x', y')
(*And*)
| Simplify (And(_, False)) = False
| Simplify (And(False, _)) = False
| Simplify (And(True, True)) = True
| Simplify (And(True, x)) = (Simplify x)
| Simplify (And(x, True)) = (Simplify x)
| Simplify (And(Var (x), Var(y))) = And (Var (x), Var (y))
| Simplify (And (x, y)) = case Simplify x of
False => False
| True => Simplify y
| x' => case Simplify y of
| False => False
| True => x'
| y' => And(x', y')
(*Not*)
| Simplify (Not(Not(x))) = (Simplify x)
| Simplify (Not(True)) = False
| Simplify (Not(False)) = True
| Simplify (Not(Var (x))) = (Not (Var x))
| Simplify (Not x) = case Simplify x of
True => False
| False => True
| x' => Not x'
(*general*)
| Simplify True = True
| Simplify False = False
| Simplify (Var(x)) = Var(x);
You need to have parenthesis around nested case statements, also when using them and having multiple function clauses, as it is not possible to differentiate the pipe (|) from belonging to the fun clauses or the case clauses.
Also you are missing the "y" argument to simplify in the second case of Simplify (Or (x, y)), and some of your nested case expressions have a starting pipe, where it shouldn't:
fun Simplify (Or (True, _)) = True
| Simplify (Or (_, True)) = True
| Simplify (Or (False, False)) = False
| Simplify (Or (x, False)) = Simplify x
| Simplify (Or (False, x)) = Simplify x
| Simplify (Or (Var x, Var y)) = Or (Var x, Var y)
| Simplify (Or (x, y)) = (case Simplify x of
True => True
| False => Simplify y
| x' => (case Simplify y of
True => True
| False => x'
| y' => Or(x', y')))
(*And*)
| Simplify (And (_, False)) = False
| Simplify (And (False, _)) = False
| Simplify (And (True, True)) = True
| Simplify (And (True, x)) = (Simplify x)
| Simplify (And (x, True)) = (Simplify x)
| Simplify (And (Var x, Var y)) = And (Var x, Var y)
| Simplify (And (x, y)) = (case Simplify x of
False => False
| True => Simplify y
| x' => (case Simplify y of
False => False
| True => x'
| y' => And(x', y')))
(*Not*)
| Simplify (Not (Not x)) = (Simplify x)
| Simplify (Not True) = False
| Simplify (Not False) = True
| Simplify (Not (Var x)) = Not (Var x)
| Simplify (Not x) = (case Simplify x of
True => False
| False => True
| x' => Not x')
(*general*)
| Simplify True = True
| Simplify False = False
| Simplify (Var x) = Var x
Atleast this compiles with this rather wrongish datatype:
datatype Expr = Or of Expr * Expr
| And of Expr * Expr
| Not of Expr
| Var of Expr
| True
| False