I am writing a language interpeter with OCaml.
With ApplyOver I have to map a function on every value of the type dictionary, which is made of (ide * exp) -> ("key", value).
If the function is "fun x-> x+1" on a dictionary ("key1", Eint 2), ("key2", Eint 3), then ApplyOver will add +1 to 2 and +1 to 3.
I have this error on the last line, This function has type exp -> evT env -> evT
It is applied to too many arguments; maybe you forgot a `;'.
Code (without standard evaluations):
type exp = ... | Dict of (ide * exp) list | ApplyOver of exp * exp;;
type evT = ... | DictVal of (ide * exp) list
let rec eval (e : exp) (r : evT env) : evT = match e with
Dict(pairs) ->
if invariant pairs then DictVal(evalDictList pairs r)
else failwith("The Dictionary has multiple copy of the same key")|
ApplyOver(ex, dict) ->
(match (eval dict r) with
DictVal(pairs) -> DictVal(applyover ex pairs)|
_-> failwith ("not a dictionary"))|
Estring s -> String s |
Eint n -> Int n |
Ebool b -> Bool b |
IsZero a -> iszero (eval a r) |
Den i -> applyenv r i |
Eq(a, b) -> eq (eval a r) (eval b r) |
Prod(a, b) -> prod (eval a r) (eval b r) |
Sum(a, b) -> sum (eval a r) (eval b r) |
Diff(a, b) -> diff (eval a r) (eval b r) |
Minus a -> minus (eval a r) |
And(a, b) -> et (eval a r) (eval b r) |
Or(a, b) -> vel (eval a r) (eval b r) |
Not a -> non (eval a r) |
Ifthenelse(a, b, c) ->
let g = (eval a r) in
if (typecheck "bool" g)
then (if g = Bool(true) then (eval b r) else (eval c r))
else failwith ("nonboolean guard") |
Let(i, e1, e2) -> eval e2 (bind r i (eval e1 r)) |
Fun(i, a) -> FunVal(i, a, r) |
FunCall(f, eArg) ->
let fClosure = (eval f r) in
(match fClosure with
FunVal(arg, fBody, fDecEnv) ->
eval fBody (bind fDecEnv arg (eval eArg r)) |
RecFunVal(g, (arg, fBody, fDecEnv)) ->
let aVal = (eval eArg r) in
let rEnv = (bind fDecEnv g fClosure) in
let aEnv = (bind rEnv arg aVal) in
eval fBody aEnv |
_ -> failwith("non functional value")) |
Letrec(f, funDef, letBody) ->
(match funDef with
Fun(i, fBody) -> let r1 = (bind r f (RecFunVal(f, (i, fBody, r)))) in
eval letBody r1 |
_ -> failwith("non functional def"))
and evalDictList (pairs : (ide * exp) list) (r : evT env) : (ide * evT) list = match pairs with
[ ] -> [ ] |
(key,value) :: other -> (key, eval value r) :: evalDictList other r
and applyover (ex : exp) (listtoscan : (ide * evT) list) : (ide * evT) list = match listtoscan with
[ ] -> [ ] |
(key,value) :: other -> (key, eval FunCall(ex, value) r) :: applyover ex other;;
Function application has the second highest precedence after method calls (and similar user-defined operators). Thus the compiler reads eval FunCall(ex, value) r as
(eval FunCall) (ex, value) r
while you intended to write
eval (Funcall(ex,value)) r
Related
i am asket to Define the function:
treeMap :: (a -> b) -> BinaryTree a -> BinaryTree b
Which takes a function and a binary tree, and produces a binary tree in which all nodes are the result of applying the function on the given tree
the binary tree is:
data BinaryTree a = Nil | BNode a (BinaryTree a) (BinaryTree a)
and my code doesnt complie. i am getting an error of:
error: Not in scope: data constructor ‘BinaryTree’
treeMap f (BNode x (BinaryTree l) (BinaryTree r)) = | ^^^^^^^^^^
my code:
data BinaryTree a = Nil | BNode a (BinaryTree a) (BinaryTree a)
treeMap :: (a -> b) -> BinaryTree a -> BinaryTree b
treeMap f Nil = Nil
treeMap f (BNode x (BinaryTree l) (BinaryTree r)) =
BNode (f x) (BinaryTree (treeMap f l)) (BinaryTree (treeMap f r))
Your pattern (BNode x (BinaryTree l) (BinaryTree r)) is not a valid pattern. Indeed the data definition of a binary tree says:
data BinaryTree a = Nil | BNode a (BinaryTree a) (BinaryTree a)
so that means that BNode is a data constructor that packs three arguments. The type of the last two arguments is BinaryTree a, but you can not use types in pattern matching.
You thus should use l and r as variables for these parameters (or you can use the data constructors of the BinaryTree a type).
The same when you construct a BinaryTree a type. You call the constructor with BNode x l r with x, l and r the values, you do not specify the types here in the expression. You can specify the types, byt then you use the :: operator.
You can thus fix your code with:
treeMap :: (a -> b) -> BinaryTree a -> BinaryTree b
treeMap f Nil = Nil
treeMap f (BNode x l r) = BNode (f x) (treeMap f l) (treeMap f r)
or more elegant:
treeMap :: (a -> b) -> BinaryTree a -> BinaryTree b
treeMap f = go
where go Nil = Nil
go (BNode x l r) = BNode (f x) (go l) (go r)
That being said, you can let ghc derive the Functor instance for you, by using the DeriveFunctor pragma:
{-# LANGUAGE DeriveFunctor #-}
data BinaryTree a = Nil | BNode a (BinaryTree a) (BinaryTree a) deriving Functor
The treeMap is just fmap :: Functor f => (a -> b) -> f a -> f b with f ~ BinaryTree here.
I set myself the following challenge (and failed):
I want to write a map functional, map f lofls, that takes a function, f 'a -> 'b and a list of lists, lofls 'a list list and applies the function f on every element of the list of lists. The constraint that I added is that I am not allowed to used nested maps for lists, and I have to do it recursively.
I tried to do it in F# but any language should do. Any ideas?
Edit
Here is my attempt (which works but is ugly and I am not a fan of the use of rev either . . .)
let map f lis =
let rec map2 f lis aux =
match (lis, aux) with
|([], []) -> []
|([], aux) -> [aux]
|(hd::tl, aux) ->
match hd with
|[] -> (List.rev aux) :: (map2 f tl [])
|x::xs -> map2 f (xs::tl) ( (f x) :: aux )
map2 f lis []
(I also realised that this has been posted in a more concise form already)
Lets go step by step, from simple to complex.
This is the signature that you want your map function to have:
('a -> 'b) -> 'a list list -> 'b list list
The simple solution is this:
let map0 (f:'a -> 'b) (lofls:'a list list) : 'b list list = lofls |> List.map (List.map f)
But that one is not recursive and it uses nested maps.
A recursive solution could be this:
let rec map1 (f:'a -> 'b) (lofls:'a list list) : 'b list list =
match lofls with
| [] -> []
| l::rest -> (List.map f l) :: map1 f rest
It is recursive although it is still calling List.map in there.
So, here is the next level:
let rec map (f:'a -> 'b) (lofls:'a list list) : 'b list list =
match lofls with
| [ ] -> [ ]
| [ ] :: rest -> [ ] :: (rest |> map f)
| ( e::restl ) :: rest ->
match restl :: rest |> map f with
| [ ] -> [ ]
| [ ] :: rest -> [ f e ] :: rest
| ( restl ) :: rest -> ( f e :: restl ) :: rest
Another way:
let rec mapNested f lofls =
match lofls with
| [] -> []
| h::t -> (map f h) :: (mapNested f t)
and map f lst =
match lst with
| [] -> []
| h::t -> (f h) :: (map f t)
If this were a homework question, which I am sure it is not, the answer depends on what constitutes "a nested map for lists".
A construct like map [] (map [] f) can be rewritten with pipelining as f |> map [] |> map [], or with the function composition operator as (map [] >> map []) f, but may be still considered a nested map.
let mapNested f =
let rec map acc g = function
| [] -> List.rev acc
| x::xs -> map (g x::acc) g xs
f |> map [] |> map []
// val mapNested : f:('a -> 'b) -> ('a list list -> 'b list list)
This is the opportunity to demonstrate your grasp of lambda calculus and the Y combinator. Nested passing of the map function as an argument should clearly pass muster.
let rec Y f x = f (Y f) x
let map f acc g = function
| [] -> List.rev acc
| x::xs -> f (g x::acc) g xs
let map1 f =
Y map [] f
// val map1 : f:('a -> 'b) -> ('a list -> 'b list)
let map2 f =
Y map [] f
|> Y map []
// val map2 : f:('a -> 'b) -> ('a list list -> 'b list list)
A tail recursive way
let mapNested f lofls =
let rec map f lst acc =
match lst with
| [] -> List.rev acc
| h::t -> map f t (f h :: acc)
map (fun x -> map f x []) lofls []
I'm not sure why this question is tagged with SML, but since it is, here is how it can be done in SML:
First, this is the idiomatic solution that you're explicitly avoiding:
fun mapmap f = map (map f)
(You could write val mapmap = map o map if it weren't for ML's value restriction.)
And if you'd like to write mapmap using explicit recursion:
fun mapmap f [] = []
| mapmap f (xs::xss) = map f xs :: mapmap f xss
and map f [] = []
| map f (x::xs) = f x :: map f xs
One reason behind why this function is hard to write with a single explicitly recursive function is that the call stack is used for two things:
Collecting the result of each inner list, and
Collecting the result of the outer list.
One of those uses of the call stack can be turned into an explicit stack in an accumulating argument. This is how e.g. a tail-recursive rev is defined:
fun rev xs =
let fun aux [] acc = acc
| aux (x::xs) acc = aux xs (x::acc)
in aux xs [] end
The accumulating argument similarly isn't needed in the interface to mapmap, so it can be hidden in an inner helper function. So a single function that performs explicit recursion on both the inner and the outer list is complicated by this explicit bookkeeping:
fun mapmap f xss =
let fun aux f [] _ = []
| aux f ([]::xss) ys = rev ys :: aux f xss []
| aux f ((x::xs)::xss) ys = aux f (xs::xss) (f x :: ys)
in aux f xss [] end
I am trying to get first and last element of the list in OCaml. I expect that my function will be like
'a list -> 'a * 'a
What I am trying to do is
let lista = [1;2;3;4;6;0];;
let rec first_last myList =
match myList with
[x] -> (List.hd lista,x)
| head::tail ->
first_last tail;;
first_last lista;;
Of course because of I made list as integer then I am doing this syntax like
*int list -> int * 'a
The point is that I dont have idea how to do this function for 'a.
Whats the direction?
The direction is to write two different functions first and last and implement the first_and_last function as:
let first_and_last xs = first xs, last xs
Another possibility with only one function:
let rec first_last = function
| [] -> failwith "too bad"
| [e] -> failwith "too bad"
| [e1;e2] -> (e1,e2)
| e1 :: _ :: r -> first_last (e1::r)
You may prefer it like that:
let rec first_last myList = match myList with
| [] -> failwith "too bad"
| [e] -> failwith "too bad"
| [e1;e2] -> (e1,e2)
| e1 :: _ :: r -> first_last (e1::r)
You can create two separate functions to return first element and last element, and then in your first_and_last function return a tuple (first_element, last_element).
let rec first_element list =
match list with
| [] -> failwith "List is empty"
| first_el::rest_of_list -> first_el
let rec last_element list =
match list with
| [] -> failwith "List is empty"
| [x] -> x
| first_el::rest_of_list -> last_element rest_of_list
You can create a helper function that has a base-case of the empty-list - for which it returns itself, and otherwise checks if the next recursive call will return an empty list. If it does, return the current element (which is by definition the last element in the list), and if it doesn't, return what was returned by the recursive call.
For the regular (non-helper) method, if the list is at least one element long (i.e. hd::tl = hd::[]) then you can just concatenate the list you got from the last function onto the head from ls.
It can be implemented as follow:
let rec last ls =
match ls with
| [] -> []
| hd::tl -> let next = last tl in
if next = [] then [hd]
else next
;;
let first_last ls =
match ls with
| [] -> failwith "Oh no!!!!! Empty list!"
| hd::tl -> hd::last tl
;;
Yet another take on this problem.
let first_last xs =
let rec last_non_empty = function
| [x] -> x
| _ :: xs' -> last_non_empty xs'
| [] -> failwith "first_last: impossible case!"
in
match xs with
| [] -> failwith "first_last"
| x::_ -> (x, last_non_empty xs)
Some properties of this implementation:
(1) it meets the specification 'a list -> 'a * 'a:
utop > #typeof "first_last";;
val first_last : 'a list -> 'a * 'a
(2) it works for singleton lists: first_last [x] = (x,x):
utop> first_last [1];;
- : int * int = (1, 1) utop> first_last ["str"];;
- : bytes * bytes = ("str", "str")
(3) it's tail-recursive (hence it won't cause stack overflow for sufficiently big lists):
utop > first_last (Array.to_list (Array.init 1000000 (fun x -> x+1)));;
- : int * int = (1, 1000000)
(4) it traverses the input list one time only; (5) it avoids creating new lists as it goes down the recursive ladder; (6) it avoids polluting the namespace (with the price of not allowing the reuse of a function like last).
And another rather simple variant, from the first principles (I was trying to illustrate "wishful thinking" in the spirit of the SICP book):
(* Not tail-recursive, might result in stack overflow *)
let rec first_last = function
| [] -> failwith "first_last"
| [x] -> (x,x)
| x :: xs -> (x, snd (first_last xs))
You could write it like this:
let first_last = function
| [] -> assert false
| x :: xs -> (x, List.fold_left (fun _ y -> y) x xs)
Or, if you are using the Base library, you could write in this way:
let first_last xs = (List.hd_exn xs, List.reduce_exn ~f:(fun _ y -> y) xs)
The basic idea is that List.fold_left (fun _ y -> y) x xs will compute the last element of x :: xs. You can prove this by induction on xs: if xs = [] then List.fold_left (fun _ y -> y) x [] = x, which is the last element of x :: []; moreover, if xs = x' :: xs' then List.fold_left (fun _ y -> y) x (x' :: xs') can be rewritten as List.fold_left (fun _ y -> y) x' xs', because List.fold_left f acc (x :: xs) = List.fold_left (f acc x) xs, hence we are finished, because this is the last element of x' :: xs' by our induction hypothesis.
I have an SML program which represents a language with Expressions that are comprised of Values:
datatype Value = IntVal of int
| ListVal of Value list
datatype Exp = Const of Value
| Plus of Exp * Exp
| Minus of Exp * Exp
| Times of Exp * Exp
I'm also writing an eval function that converts an expression into a value. If the expression is a Plus expression (e.g. Plus (Const (IntVal 1), Const (IntVal 1)) which represents 1+1), I just want to take out the integer stored in the IntVal and just add them together and return that.
But as far as I can tell, I have to have a seemingly redundant case statement with only one case just to get at the integer inside the IntVal data type:
(*Evaluates an Exp and returns a Value*)
fun eval e =
(*Evaluate different types of Exp*)
case e of
(*If it's a constant, then just return the Value*)
Const v => v
(*If it's a Plus, we want to add together the two Values*)
| Plus (x,y) =>
(*Case statement with only one case that seems redundant*)
case (eval x, eval y) of
(IntVal xVal, IntVal yVal) => IntVal (xVal + yVal)
Is there no easy way to do simplify this? I'd like to do something like this, which of course isn't valid SML:
fun eval e =
case e of
Const v => v
| Plus (x,y) => IntVal (eval x + eval x)
If you want your eval function to return an int and you haven't figured out how to get an int from a Value which uses the ListVal constructor -- it is enough to just supply patterns which correspond to the cases that your intended definition covers.
fun eval (Const (IntVal v)) = v
| eval (Plus (e1,e2)) = eval(e1) + eval(e2)
| eval (Minus (e1,e2)) = eval(e1) - eval(e2)
| eval (Times (e1,e2)) = eval(e1) * eval(e2);
SML/NJ gives Warning: match nonexhaustive - but if it matches your intention then you can ignore the warning.
The above code returns an int. If you want to return values which look like e.g. IntVal 3 then you could define 3 functions which take pairs of IntVals and return IntVals corresponding to their sums, differences, and products and use these functions on the right hand sides of the above definition.
Yes, there are at least two ways to simplify this: Exceptions, or monads.
The problem you have is that eval (Const (ListVal [...])) does not have a meaningful integer value. To ensure that this remains a total function (one for which all input values result in an output value, as opposed to a partial function), its type could instead be expressed as:
val eval : Exp -> int option
You could implement this most easily by using exceptions:
local
fun eval' (Const (IntVal v)) = v
| eval' (Const (ListVal _)) = raise Domain
| eval' (Plus (e1, e2)) = eval' e1 + eval' e2
| eval' (Minus (e1, e2)) = eval' e1 - eval' e2
| eval' (Times (e1, e2)) = eval' e1 * eval' e2
in
fun eval e = SOME (eval' e) handle Domain => NONE
end
Or you could implement this by complicating your recursive function:
fun eval (Const (IntVal v)) = SOME v
| eval (Const (ListVal _)) = NONE
| eval (Plus (e1, e2)) =
(case (eval e1, eval e2) of
(SOME v1, SOME v2) => SOME (v1+v2)
| _ => NONE)
| eval (Minus (e1, e2)) =
(case (eval e1, eval e2) of
(SOME v1, SOME v2) => SOME (v1-v2)
| _ => NONE)
| eval (Times (e1, e2)) =
(case (eval e1, eval e2) of
(SOME v1, SOME v2) => SOME (v1*v2)
| _ => NONE)
Clearly that is not easy or pretty.
One way to improve this code is to abstract a common, repetitive pattern into a function:
fun evalBinop (f, e1, e2) =
case (eval e1, eval e2) of
(SOME v1, SOME v2) => SOME (f (v1, v2))
| _ => NONE
and eval (Const (IntVal v)) = SOME v
| eval (Const (ListVal _)) = NONE
| eval (Plus (e1, e2)) = evalBinop (op+, e1, e2)
| eval (Minus (e1, e2)) = evalBinop (op-, e1, e2)
| eval (Times (e1, e2)) = evalBinop (op*, e1, e2)
Here evalBinop depends on calling back on eval, so I made them mutually recursive. I also rely on interpreting binary operators as functions that take tuples as arguments.
An improvement comes in making more generic helper functions that handles the 'a option type:
infix 3 >>=
fun NONE >>= _ = NONE
| (SOME a) >>= f = f a
fun liftM2 f (opt1, opt2) =
opt1 >>= (fn x1 => opt2 >>= (fn x2 => SOME (f (x1, x2))))
fun eval (Const (IntVal v)) = SOME v
| eval (Const (ListVal _)) = NONE
| eval (Plus (e1, e2)) = liftM2 (op+) (eval e1, eval e2)
| eval (Minus (e1, e2)) = liftM2 (op-) (eval e1, eval e2)
| eval (Times (e1, e2)) = liftM2 (op* ) (eval e1, eval e2)
At this point, >>= and liftM2 are useful functions that don't depend on the notion of evaluating an expression or applying integer operators. They're not present in Standard ML's library, but they should be. At this point I incidentally re-invented monads.
A last improvement comes by adding a little syntax sugar, which is most likely overkill:
infix 7 **
infix 6 ++
infix 6 --
val op** = liftM2 op*
val op++ = liftM2 op+
val op-- = liftM2 op-
fun eval (Const (IntVal v)) = SOME v
| eval (Const (ListVal _)) = NONE
| eval (Plus (e1, e2)) = eval e1 ++ eval e2
| eval (Minus (e1, e2)) = eval e1 -- eval e2
| eval (Times (e1, e2)) = eval e1 ** eval e2
(A few examples demonstrating exactly what it is >>= and liftM2 do...)
(* 'x >>= f' means:
* if x is 'NONE', just return NONE
* if x is 'SOME a', apply f to a, and expect f to return either 'SOME b' or 'NONE' *)
(* For example, this should give 'SOME 4': *)
val example_1 = SOME 3 >>= (fn x => SOME (x+1))
(* And these should both give 'NONE': *)
val example_2 = NONE >>= (fn x => SOME (x+1))
val example_3 = SOME 3 >>= (fn x => NONE)
(* If 'f : t1 * t2 -> t3', then 'liftM2 f : t1 option * t2 option -> t3 option' *)
val _ = op+ : int * int -> int
val _ = liftM2 op+ : int option * int option -> int option
(* For example *)
val example_4 = liftM2 op+ (SOME 3, SOME 4) (* gives SOME 7 *)
val example_5 = liftM2 op- (SOME 10, NONE) (* gives NONE *)
val example_6 = liftM2 op* (NONE, SOME 5) (* gives NONE *)
I write a ocaml program that parse an arithmetic expression by parser combinator.
type 'a parser = char list -> ('a * (char list)) list
let return (x: 'a): 'a parser = fun input -> [x, input]
let fail: 'a parser = fun _ -> []
let ( >>= ) (p: 'a parser) (f : 'a -> 'b parser): 'b parser =
fun input -> List.map (fun (x, i) -> f x i) (p input) |> List.flatten
let ( ||| ) (p: 'a parser) (q: 'a parser) =
fun input -> (p input) # (q input)
let token: (char parser) = function
| x::xs -> [x, xs]
| [] -> []
let char(c: char): (char parser) =
token >>= fun x ->
if x = c then return x else fail
let digit: (char parser) =
token >>= fun x ->
if x >= '0' && x <= '9' then return x else fail
let rec many(p: 'a parser): 'a list parser =
(p >>= fun x ->
many p >>= fun xs ->
(return (x::xs)))
||| (return [])
let number =
many digit >>= fun x ->
return (List.fold_left (fun l r -> l * 10 + (int_of_char r - int_of_char '0')) 0 x)
type expr = Add of (expr * expr)
| Sub of (expr * expr)
| Mul of (expr * expr)
| Div of (expr * expr)
| Neg of expr
The code above works well.
let rec expression: expr parser =
term >>= fun l ->
(char '+' ||| char '-') >>= fun op ->
term >>= fun r ->
if op = '+' then return (Add (l, r)) else return (Sub (l, r))
and term: expr parser =
factor >>= fun l ->
(char '*' ||| char '/') >>= fun op ->
factor >>= fun r ->
if op = '*' then return (Mul (l, r)) else return (Div (l, r))
and factor: expr parser =
expression
||| (char '(' >>= fun _ ->
expression >>= fun e ->
char ')' >>= fun _ ->
return e)
||| (char '-' >>= fun _ ->
factor >>= fun e ->
return (Neg e))
But there is an error in this piece of code
Error: This kind of expression is not allowed as right-hand side of `let rec'
This page(link) says:
"the compiler only allows three possible constructs to show up on the righthand side of a let rec: a function definition, a constructor, or the lazy keyword."
I think type parser is a function instead of a value, why this happened?
"Function definition" means a literan fun x -> construct. Functional languages consider partial function applications like
factor >>= fun l -> ...
redexes, not literal values, which means a strict language has to evaluate them immediately when they appear on the RHS of a simple variable binding, like
term = factor >>= fun l -> ...
Since, in general, eagerly evaluating the RHS of a recursive definition produces an infinite loop, strict languages generally either ban the construct or require the binding to be marked explicitly lazy.
The right hand side should be "function definition" not just a function. Function definition is a syntactic construct, of the form fun -> or function ..., including syntactic sugar for let f x .... A more correct wording is in sections 6.7.1 and 7.3 of the manual.