creating a module in order to print nested functions in ocaml - ocaml

I have such type:
type lT = LV of name
| LC of name
| LA of lT * lT
| LAb of name * lT
I want to implement a function called let's say s in a way that, it is gonna behave in the following way:
let println x = printf "%s\n" (s x)
s (`App(`App(`App(`Bs, `K), `K), `K)) ==> "B* K K K”
For this reason, I have implemented the following module:
module type L2C =
sig
val c1 : lT -> ([> `T | `L | `J
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val c2 : lT -> ([> `T | `L | `J | `C | `D
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val c3 : lT -> ([> `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val e : ([< `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b) ->
([ `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b)
end
But since I am new in ocaml, I couldn't manage to create an "s" function to have the output I wanted.
What might be a possible way to do that?

I don't really understand the details of what you're trying to do, but I hope this can help:
let s expr =
let rec loop acc = function
| `Bs -> "B* "^acc
| `K -> "K "^acc
| `App(a,b) -> (loop acc a)^(loop acc b)
in
loop "" expr
The above works pretty well for the example you gave:
s (`App(`App(`App(`Bs, `K), `K), `K));;
- : string = "B* K K K "
You'll need to add extra cases to the pattern-match, and maybe a few type annotations if you want helpful type inference instead of the ugly polymorphic variant types.

In case you do not have to stick to :
s (`App(`App(`App(`Bs, `K), `K), `K)) ==> "B* K K K”
You could use ppx_deriving to automatically produce a function that transform your type into string (example in utop below) :
#require "ppx_deriving.std";;
type t = [`App of (t * t) | `B | `K] [##deriving show];; (* assuming your type is like this *)
> type t = [ `App of t * t | `B | `K ]
> val pp : Format.formatter -> t -> unit = <fun>
> val show : t -> string = <fun> ...
show (`App (`B , `App (`K , `K)));;
- : string = "`App ((`B, `App ((`K, `K))))"

Related

Error: This variant pattern is expected to have type prim1. The constructor Id does not belong to type prim1

I don't have much experience with ocmal and the compiler error message isn't very helpful. I don't see any obvious problem with the code. I have the full code and the error message below. Thank you.
Full compiler error message:
File "compile.ml",
| Id(x) ->
^^
Error: This variant pattern is expected to have type prim1
The constructor Id does not belong to type prim1
type reg =
| EAX
| ESP
type arg =
| Const of int
| Reg of reg
| RegOffset of int * reg
type instruction =
| IMov of arg * arg
| IAdd of arg * arg
| IRet
type prim1 =
| Add1
| Sub1
type expr =
| Number of int
| Prim1 of prim1 * expr
| Let of (string * expr) list * expr
| Id of string
let rec find (ls : (string * int) list) (x : string) =
match ls with
| [] -> None
| (y,v)::rest ->
if y = x then Some(v) else find rest x
let rec compile_env (p : expr) (stack_index : int) (env : (string * int) list) : instruction list =
match p with
| Number(n) -> [ IMov(Reg(EAX), Const(n)) ]
| Prim1(op, e) ->
match op with
| Add1 -> (compile_env e stack_index env) # [ IAdd(Reg(EAX), Const(1)) ]
| Sub1 -> (compile_env e stack_index env) # [ IAdd(Reg(EAX), Const(-1)) ]
| Id(x) ->
match find env x with
| None -> failwith "%s not in scope" x
| Some value -> [IMov(Reg(EAX), RegOffset(value, Reg(ESP)))]
| Let(binds, body) ->
match binds with
| [] -> [] # (compile_env body stack_index env)
| (str, exp)::rest ->
let new_env = env # [(str, -4*stack_index)] in
let eval_expr = (compile_env exp stack_index env) in
let eval_tail = (compile_env Let(rest, body) stack_index+1 new_env) in
eval_expr # [IMov(RegOffset(-4*stack_index, Reg(ESP)), Reg(EAX))] # eval_tail
It looks like your problem is that you have nested match expressions. The difficulty is that the compiler is thinking that the next case of the outer match is in fact the next case of the inner match.
The solution is to parenthesize all of the the inner match expressions.
It should look something like this:
match p with
| Number(n) -> [ IMov(Reg(EAX), Const(n)) ]
| Prim1(op, e) ->
(match op with
| Add1 -> (compile_env e stack_index env) # [ IAdd(Reg(EAX), Const(1)) ]
| Sub1 -> (compile_env e stack_index env) # [ IAdd(Reg(EAX), Const(-1)) ]
)
. . .
You need to do this for all of the nested match expressions (I see 3 of them).

difference between dune utop and utop

If I load the following code in utop, after #require "mparser", it is accepted in the top level and give the signature below
open MParser
let infix p op = Infix (p |>> (fun _ a b -> (`Binop (op, a, b))), Assoc_left)
let operators =
[
[
infix (char '*') `Mul;
infix (char '/') `Div;
];
[
infix (char '+') `Add;
infix (char '-') `Sub;
];
]
let decimal = many1_chars digit |>> int_of_string
let term = (decimal |>> fun i -> `Int i)
let expr s = expression operators term s
let rec calc = function
| `Int i -> i
| `Binop (op, a, b) ->
match op with
| `Add -> calc a + calc b
| `Sub -> calc a - calc b
| `Mul -> calc a * calc b
| `Div -> calc a / calc b
accepted by utop as
val infix :
('a, 'b) MParser.t ->
'c -> ([> `Binop of 'c * 'd * 'd ] as 'd, 'b) MParser.operator = <fun>
val operators :
(_[> `Binop of _[> `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ]
as 'a, unit)
MParser.operator list list =
[[Infix (<fun>, Assoc_left); Infix (<fun>, Assoc_left)];
[Infix (<fun>, Assoc_left); Infix (<fun>, Assoc_left)]]
val decimal : (int, unit) MParser.t = <fun>
val term : ([> `Int of int ], unit) MParser.t = <fun>
val expr :
unit MParser.state ->
(_[> `Binop of _[> `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ]
as 'a, unit)
MParser.reply = <fun>
val calc :
([< `Binop of [< `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ] as 'a) ->
int = <fun>
Now, if I try to load with dune utop a library containing this code as a file/module, I received the following error :
~$ dune utop lib
ocamlc lib/.lib.objs/lib__VariantExemple.{cmi,cmo,cmt} (exit 2)
(cd _build/default && /usr/local/bin/ocamlc.opt -w #a-4-29-40-41-42-44-45-48-58-59-60-40 -strict-sequence -strict-formats -short-paths -keep-locs -g -bin-annot -I lib/.lib.objs -I lib/.lib.objs/.private -I /Users/nrolland/.opam/system/lib/bytes -I /Users/nrolland/.opam/system/lib/mparser -I /Users/nrolland/.opam/system/lib/re -I /Users/nrolland/.opam/system/lib/re/perl -I /Users/nrolland/.opam/system/lib/seq -no-alias-deps -opaque -open Lib -o lib/.lib.objs/lib__VariantExemple.cmo -c -impl lib/variantExemple.ml)
File "lib/variantExemple.ml", line 5, characters 4-13:
Error: The type of this expression,
(_[> `Binop of _[> `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ]
as 'a, '_weak1)
operator list list, contains type variables that cannot be generalized
It looks like there are some type annotation missing.
I am not too familiar with polymorphic variant type and , is there an obvious solution out ?
I was hoping that sticking the signature part given by utop in an interface would work, but it does not seem to be valid in a .mli file
Edit : the simple solution is to add a closed type annotation.
let operators : ([ `Binop of [ `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ] as 'a, unit) operator list list =
I am not sure if there is a reason for why an interactive session and a dune utop lib one-shot loading should behave differently
You have _ in front of your types, which suggest your type is weakly polymorphic, and the compiler refuse to let such things live in a compiled object.
you can get the same result with the mwe :
let store = ref None
The toplevel is ok with that as it can be resolved to a monomorphic type later if you evaluate something like store:= Some1, which "monomorphise" the type from _a option ref to int option ref

Error Implement an interpreter in Ocaml

i'm trying to write an interpreter in Ocaml but I do not know resolve the error in this program:
SYNTAX
type ide = string
type exp =
| Eint of int
| Ebool of bool
| Den of ide
| Sum of exp * exp
| Diff of exp * exp
| Prod of exp * exp
| Eq of exp * exp
| Minus of exp
| Iszero of exp
| Or of exp * exp
| And of exp * exp
| Not of exp
| Ifthenelse of exp * exp * exp
| Let of ide * exp * 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*)
;;
SEMANTIC
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
;;
RUN-TIME SUPPORT
| 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(etupla) = sem(Etup(tupla), r) in
ValTup(Seq(evex1, etupla))
| 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")
and applyPipe tup argo r = match tup with
| Seq(Den f, tupla) ->
applyPipe tupla (Apply(Den f,argo)) r
| Seq(Pipe(tuplaP),tupla) ->
let appf = applyPipe tuplaP argo r in
applyPipe tupla appf r (**)
| Nil -> sem(argo,r)
| _ -> failwith("Not a valid Pipe")
;;
The error is on the line (***) : "the variant type tuple has no constructor Pipe"
How can I solve it?
The compiler expects the first argument of applyPipe to have type tuple. On the line (***) the applyPipe is applied to the value Pipe(tupla) which has type exp.

Implement an interpreter in Ocaml

i'm trying to write an interpreter in Ocaml, i have defined the syntax already and the semantic for the most of the operations.
I'm trying to implement two more operations:
Ntimes: this has two argouments, an Integer and a function. Ntimes has to apply the function n times.
Pipe: this is the same has the pipe in the linux bash.
example of Ntimes:
Ntimes(Int(4),f);;
example of Pipe:
Pipe(f1,(f2,(f3,(f4,(f5,Nil)))));;
The interpeter that i have is this:
SYNTAX
type ide = string;;
type operator = Plus | Minus | Mul | Div | And | Or | Eq;;
type exp = Int of int
| Bool of bool
| Den of string
| Op of exp * operator * exp
| Let of ide * exp * exp
| Fun of ide * exp
| Apply of exp * exp
| Ifz of exp * exp * exp
| Etup of tuple
| Pipe of tuple
| ManyTimes of int * exp
and tuple = Nil | Seq of exp * tuple;;
type dexp = Dint of int | Dbool of bool | Dstring of string | Unbound | Dtuple of dexp list | Funval of efun and efun = ide * exp * dexp env ;;
RUN-TIME SUPPORT
let rec eval ((e: exp), (r:dexp env)) = match e with
Int i -> Dint i
| Bool i -> Dbool i
.
.
.
.
| Etup e1 -> let v = (evalList e1 r) in Dtuple v
| Apply(e1, e2) -> (match eval(e1, r) with
| Funval(i, a, r1) -> eval(a, bind(r1, i, eval(e2, r)))
| _ -> failwith("no funct in apply"))
| NTimes(i,e) -> *I have no idea*
| Pipe(e) -> * I have no idea*
;;
Thanks for the any help that you will give me!

OCaml: type inference with polymorphic variants

Function f argument type is [< 'A | 'B] that's what I want.
# let rec f = function
| `A -> 0
| `B -> let _ = f in 1
;;
val f : [< `A | `B ] -> int = <fun>
However, if I call it recursively with 'A it infers an undesired for me type [< 'A | 'B > 'A] which requires at least 'A:
# let rec f = function
| `A -> 0
| `B -> let _ = f `A in 1
;;
val f : [< `A | `B > `A ] -> int = <fun>
I still need to recursively call f 'A, but how do I keep the type [< 'A | 'B]?
This is yet another instantiation of the let-polymorphism constraints, that hinders the usage of polymorphic recursive function. Since, OCaml 3.12 we have an explicit way to declare that your function is polymorphic.
Your case is a little bit more complex, since you have implicit type variable, that occurs inside the row-polymorphic type. Maybe there is a better way, but my approach is to make this type variable explicit, with the following type definition
type 'a t = 'a constraint 'a = [< `A | `B]
With such handy type, it is easy to write a proper annotation for a function:
let rec f : 'a . 'a t -> int = function
| `A -> 0
| `B -> let _ = f `A in 1
Just in case, if you don't want to expose this 'a t, that's ok, since you're not required, 'a t is equal to [< 'A | 'B] it just makes 'a type variable explicit:
module M : sig
val f : [< `A | `B] -> int
end = struct
let rec f : 'a . 'a t -> int = function
| `A -> 0
| `B -> let _ = f `A in 1
end;;
Without introducing 'a t type, you can make it with a little bit uglier (but this is of course a matter of taste) notation:
let rec f : 'a . ([< `A | `B] as 'a) -> int = function
| `A -> 0
| `B -> let _ = f `A in 1
Of course, this will not scale, for non trivial types.