Haskell - Using previously computed values in next function calls in a sequence - list

I'm trying to make a function for syntax tree arithmetic operations and thus far I'm almost where I want it to be. In the code I attach you can see my current function definitions. eval is the function that decides what to do with each operation and foldAndPropagateConstants is the main function. parse is a simple parser that takes a String of a mathematical expression and returns the equivalent tree. e.g.
ghci> parse "3+x"
BinaryOperation Plus (Leaf (Constant 3)) (Leaf (Variable "x"))
The issue I'm facing is how to have the evaluated values to be used in subsequent operations. For example, this operation should work as follows:
ghci> foldAndPropagateConstants [("x", parse "1+2+3"), ("y", parse "5*x + 7")]
[("x",Leaf (Constant 6)),("y",Leaf (Constant 37))]
Notice that the function should use the value that "x" got, when calculating the value for "y". Thing is, I can't seem to find a way to use "x"'s value in my eval function.
--foldAndPropagateConstants :: [(String, Exprv)] -> [(String, ExprV)]
eval :: ExprV -> Int
eval (Leaf (Variable n)) = --this part is what's missing
eval (Leaf (Constant n)) = n
eval (BinaryOperation Plus expr1 expr2) = eval expr1 + eval expr2
eval (BinaryOperation Times expr1 expr2) = eval expr1 * eval expr2
eval (UnaryOperation Minus expr1) = -1 * eval expr1
foldAndPropagateConstants (x:xs) = [(fst x, parse (show (eval(snd x)))) ] : foldAndPropagateConstants xs
foldAndPropagateConstants _ = []

Edit: I seem to have answered only this part of the question:
I can't seem to find a way to use "x" value in my eval function.
Since your question does not include a Minimal, Reproducible Example, here is a simplified version of what you seem to be doing (that doesn't contain variables) that both contains the data definition and the eval function:
module Eval where
data Expr
= Constant Int
| UnOp UnaryOperation Expr
| BinOp BinaryOperation Expr Expr
deriving (Eq, Show)
data UnaryOperation
= UnaryMinus
| UnaryFactorial
| UnaryAbsolute
deriving (Eq, Show)
data BinaryOperation
= Plus
| Minus
| Times
| Divide
deriving (Eq, Show)
eval :: Expr -> Int
eval (Constant n) = n
eval (UnOp UnaryMinus e) = negate (eval e)
eval (UnOp UnaryFactorial e) = product [1..eval e]
eval (UnOp UnaryAbsolute e) = abs (eval e)
eval (BinOp bop e1 e2) = evalBinOp bop (eval e1) (eval e2)
evalBinOp :: BinaryOperation -> Int -> Int -> Int
evalBinOp Plus = (+)
evalBinOp Minus = (-)
evalBinOp Times = (*)
evalBinOp Divide = div
Extending this evaluator with another constructor in data Expr, and extending the eval function with an "environment" as luqui suggests, which in this case is a list of name-value pairs:
data Expr
= Constant Int
| Variable String
| UnOp UnaryOperation Expr
| BinOp BinaryOperation Expr Expr
deriving (Eq, Show)
-- ...
eval :: Expr -> [(String, Int)] -> Int
eval (Constant n) _env = n
eval (Variable s) env = lookup' s env
eval (UnOp UnaryMinus e) env = negate (eval e env)
eval (UnOp UnaryFactorial e) env = product [1..eval e env]
eval (UnOp UnaryAbsolute e) env = abs (eval e env)
eval (BinOp bop e1 e2) env = evalBinOp bop (eval e1 env) (eval e2 env)
-- ...
lookup' :: String -> [(String, Int)] -> Int
lookup' s [] = error ("Could not find variable " ++ s)
lookup' s ((t,n):env)
| s == t = n
| otherwise = lookup' s env
It seems to me that the most urgent improvement to this evaluator is better error handling using error-aware return types. I made the lookup' helper function because the standard library function Data.List.lookup uses the safer Maybe return type which would encourage the rewrite I'm suggesting:
eval :: Expr -> [(String, Int)] -> Maybe Int
eval (Constant n) _env = pure n
eval (Variable s) env = lookup s env
eval (UnOp UnaryMinus e) env =
case eval e env of
Just n -> pure (negate n)
Nothing -> Nothing
eval (UnOp UnaryFactorial e) env =
eval e env >>= \n ->
pure (product [1..n])
eval (UnOp UnaryAbsolute e) env =
abs <$> eval e env
eval (BinOp bop e1 e2) env = do
n1 <- eval e1 env
n2 <- eval e2 env
pure (evalBinOp bop n1 n2)
I've used a different style in each function body, but they're all variations of a similar theme: case-of uses explicit pattern matching, which gets tedious. (Imagine doing the eval (BinOp ...) body using case-of.) Explicit use of the >>= operator is... I suppose some people like it, but do notation looks prettier. The <$> applicative style is the neatest of them all in this case, I think.
What you could do next is make the env implicit by using the Reader monad: It is a bit messy that only one function body in eval actually uses it, and all the others either throw it away or pass it along.

What you want is for
foldAndPropagateConstants [("x", parse "1+2+3"), ("y", parse "5*x + 7"), ("z", parse "x+y-1")]
to be equivalent to
= let s0 = []
r1 = parse' "1+2+3" s0
-- r1 = Leaf (Constant 6)
s1 = [("x",6)]
r2 = parse' "5*x + 7" s1
-- r2 = Leaf (Constant 37)
s2 = [("x",6),("y",37)]
r3 = parse' "x+y-1" s2
-- r3 = Leaf (Constant 42)
s3 = [("x",6),("y",37),("z",42)]
in
[r1,r2,r3]
parse' is like parse, but it can also consult a store of values known so far which it receives as its second argument.
The above is easier encoded with functions if restructured as
= let s0 = []
(s1, r1) = parse'' "1+2+3" s0
-- r1 = Leaf (Constant 6)
-- s1 = [("x",6)]
(s2, r2) = parse'' "5*x + 7" s1
-- r2 = Leaf (Constant 37)
-- s2 = [("x",6),("y",37)]
(s3, r3) = parse'' "x+y-1" s2
-- r3 = Leaf (Constant 42)
-- s3 = [("x",6),("y",37),("z",42)]
in
snd (s3, [r1,r2,r3])
Incidentally this pattern of state-passing computations is known as State Monad, but that's a matter for another day.
The above fits the recursion pattern when expressed as
foldAndPropagateConstants [("x", parse "1+2+3"), ("y", parse "5*x + 7"), ("z", parse "x+y-1")] =
snd $ foldAndPropagateConstants'
[("x", parse "1+2+3"), ("y", parse "5*x + 7"), ("z", parse "x+y-1")]
[]
foldAndPropagateConstants' [("x", parse "1+2+3"), ("y", parse "5*x + 7"), ("z", parse "x+y-1")] s0 =
let
(s1, r1) = parse'' "1+2+3" s0
(sn, rs) = foldAndPropagateConstants' [("y", parse "5*x + 7"), ("z", parse "x+y-1")] s1
in
(sn, r1 : rs)
-- and
foldAndPropagateConstants' [] s0 = (s0, [])
And now, Generalize! (by replacing an example value with a symbolic one).

Related

Why does ocaml keep miss understanding type?

module Value =
struct
type t = Int of int
end
module M = Map.Make(String)
type expr =
| Num of int
| Add of expr * expr
type t = Value.t M.t (* Value.t is Int of int *)
let rec add_map (st: string list) (e: expr list) (s: t): t =
match st with
| [] -> s
| s1::st ->
match e with
| e1::e ->
M.add s1 e1 s;
add_map st e s;;
In above function, e is list of user defined type expr, and s is user defined map "t = Int M.t" which store int in key of string. Problem is if I compile this, error says that type of e1 is t = t M.t, and I need expr M.t. Clearly e1 is element of expr list, why does ocaml think it is t?? I know M.add need (M.add string expr (map)
You didn't show the exact error message, but there is a problem with your call to M.add: the map s has type Value.t M.t, but you are giving it a value of type expr, not Value.t.
You have a Map type t that maps strings to Value.t values. But in your add_map function, you're adding values of type expr to the map.
You need to map values of type expr to Value.t:
let rec expr_to_value_t = function
| Num n -> Value.Int n
| Add (e1, e2) ->
let Value.Int n1 = expr_to_value_t e1 in
let Value.Int n2 = expr_to_value_t e2 in
Value.Int (n1 + n2)
let rec add_map (st: string list) (e: expr list) (s: t): t =
match st with
| [] -> s
| s1::st ->
match e with
| e1::e ->
M.add s1 (expr_to_value_t e1) s;
add_map st e s
However, while this compiles, it does prompt errors about non-exhaustive pattern-matching, and worse, M.add s1 (expr_to_value_t e1) s in this context doesn't do anything. Maps in OCaml are functional data structures. You don't mutate them, but rather transform them. M.add doesn't modify s, it just creates a new map with an additional binding.
You can overcome this with relatively few modifications to your function.
let rec add_map (st: string list) (e: expr list) (s: t): t =
match st with
| [] -> s
| s1::st ->
match e with
| e1::e ->
let s = M.add s1 (expr_to_value_t e1) s in
add_map st e s
Here I've shadowed the original s binding with the new map which is used in the recursive call to add_map. Testing this:
utop # add_map ["hello"; "world"] [Num 23; Num 42] M.empty |> M.bindings;;
- : (string * Value.t) list =
[("hello", Value.Int 23); ("world", Value.Int 42)]
This would be a great place to use List.fold_left2, assuming both lists are of equal length. Otherwise Invalid_argument will be raised.
let add_map st e s =
List.fold_left2 (fun m a b -> M.add a b m) s st e

How to return a SOME list instead of a normal list?

I am trying to implement a program that takes a string and a list and returns NONE if it doesn't find any match and the list without the element if it does.
fun all_except_option ("string",["he","she","string"]) = SOME["he","she"]
I have managed to make it working, but without the options type and i have no idea how to make it return SOME list instead a normal list.
fun all_except_option(str,lst)=
case lst of
[] => []
| x::lst' => if same_string(x,str) = false
then let fun append (word, list) = word::list
in append(x,[]) :: all_except_option(str,lst')
end
else all_except_option(str,lst')
Thank you. I managed to make it working, but i still don't understand the "else case" and how is my programm handling it. Here is the working code. I would be glad if you can explain me the "else case all_except_option(str,list') of".
fun all_except_option(str,list)=
case list of
[] => NONE
| x::list' => if same_string(x,str) then
SOME( list')
else case all_except_option(str,list') of
NONE=>NONE
| SOME list'=>SOME(x::list')
implement a program that takes a string and a list and returns NONE if it doesn't find any match and the list without the element if it does.
all_except_option ("string",["he","she","string"]) = SOME ["he","she"]
How is SOME [] different from NONE? As in, if this function returned just a list, it would be possible to say that removing occurrences of "string" results in no other strings: Either the list was empty already, or it contained only occurrences of "string". I am not sure why NONE vs. SOME [] is warranted in one case over the other.
So the better function is one that simply returns a plain list:
fun except (x, ys) = List.filter (fn y => x <> y)
When is it useful to return 'a option?
For example when the return type does not have a way to indicate no result already:
fun lookup k1 [] = NONE
| lookup k1 ((k2,v)::pairs) =
if k1 = k2
then SOME v
else lookup k1 pairs
This function returns 0 or 1 thing. But it's also a simple function because it never aggregates results over its recursion. Recursive functions become complicated when they return composite data types like 'a option when it needs to unpack the result of the recursion.
A good example is an eval function that sometimes fails:
datatype expr
= Add of expr * expr
| Sub of expr * expr
| Mul of expr * expr
| Div of expr * expr
| Int of int
fun eval (Int n) = SOME n
| eval (Add (e1, e2)) = evalHelper ( op+ ) (e1, e2)
| eval (Sub (e1, e2)) = evalHelper ( op- ) (e1, e2)
| eval (Mul (e1, e2)) = evalHelper ( op* ) (e1, e2)
| eval (Div (e1, e2)) =
case eval e1 of
NONE => NONE
| SOME x => case eval e2 of
NONE => NONE
| SOME 0 => NONE
| SOME y => SOME (x div y)
and evalHelper binop (e1, e2) =
case eval e1 of
NONE => NONE
| SOME x => case eval e2 of
NONE => NONE
| SOME y => SOME (binop (x, y))
Here the return type is int option, which means that you most often return an int, but if you ever divide by zero, that results in "no value", so rather than raise an exception, we return NONE, which necessitates us to return SOME n when there is a result, so that the type fits in both cases.
A quick demonstration:
- eval (Div (Int 5, Int 2));
> val it = SOME 2 : int option
- eval (Div (Int 5, Int 0));
> val it = NONE : int option
- eval (Div (Int 2, Sub (Int 3, Int 3)));
> val it = NONE : int option
- eval (Div (Int 0, Int 1));
> val it = SOME 0 : int option
Here SOME 0 actually means "the result is 0", which is not the same as "cannot divide by zero."

how to implement lambda-calculus in OCaml?

In OCaml, it seems that "fun" is the binding operator to me. Does OCaml have built-in substitution? If does, how it is implemented? is it implemented using de Bruijn index?
Just want to know how the untyped lambda-calculus can be implemented in OCaml but did not find such implementation.
As Bromind, I also don't exactly understand what you mean by saying "Does OCaml have built-in substitution?"
About lambda-calculus once again I'm not really understand but, if you talking about writing some sort of lambda-calculus interpreter then you need first define your "syntax":
(* Bruijn index *)
type index = int
type term =
| Var of index
| Lam of term
| App of term * term
So (λx.x) y will be (λ 0) 1 and in our syntax App(Lam (Var 0), Var 1).
And now you need to implement your reduction, substitution and so on. For example you may have something like this:
(* identity substitution: 0 1 2 3 ... *)
let id i = Var i
(* particular case of lift substitution: 1 2 3 4 ... *)
let lift_one i = Var (i + 1)
(* cons substitution: t σ(0) σ(1) σ(2) ... *)
let cons (sigma: index -> term) t = function
| 0 -> t
| x -> sigma (x - 1)
(* by definition of substitution:
1) x[σ] = σ(x)
2) (λ t)[σ] = λ(t[cons(0, (σ; lift_one))])
where (σ1; σ2)(x) = (σ1(x))[σ2]
3) (t1 t2)[σ] = t1[σ] t2[σ]
*)
let rec apply_subs (sigma: index -> term) = function
| Var i -> sigma i
| Lam t -> Lam (apply_subs (function
| 0 -> Var 0
| i -> apply_subs lift_one (sigma (i - 1))
) t)
| App (t1, t2) -> App (apply_subs sigma t1, apply_subs sigma t2)
As you can see OCaml code is just direct rewriting of definition.
And now small-step reduction:
let is_value = function
| Lam _ | Var _ -> true
| _ -> false
let rec small_step = function
| App (Lam t, v) when is_value v ->
apply_subs (cons id v) t
| App (t, u) when is_value t ->
App (t, small_step u)
| App (t, u) ->
App (small_step t, u)
| t when is_value t ->
t
| _ -> failwith "You will never see me"
let rec eval = function
| t when is_value t -> t
| t -> let t' = small_step t in
if t' = t then t
else eval t'
For example you can evaluate (λx.x) y:
eval (App(Lam (Var 0), Var 1))
- : term = Var 1
OCaml does not perform normal-order reduction and uses call-by-value semantics. Some terms of lambda calculus have a normal form than cannot be reached with this evaluation strategy.
See The Substitution Model of Evaluation, as well as How would you implement a beta-reduction function in F#?.
I don't exactly understand what you mean by saying "Does OCaml have built-in substitution? ...", but concerning how the lambda-calculus can be implemented in OCaml, you can indeed use fun : just replace all the lambdas by fun, e.g.:
for the church numerals: you know that zero = \f -> (\x -> x), one = \f -> (\x -> f x), so in Ocaml, you'd have
let zero = fun f -> (fun x -> x)
let succ = fun n -> (fun f -> (fun x -> f (n f x)))
and succ zero gives you one as you expect it, i.e. fun f -> (fun x -> f x) (to highlight it, you can for instance try (succ zero) (fun s -> "s" ^ s) ("0") or (succ zero) (fun s -> s + 1) (0)).
As far as I remember, you can play with let and fun to change the evaluation strategy, but to be confirmed...
N.B.: I put all parenthesis just to make it clear, maybe some can be removed.

Generating a type annotation using DataKinds within a TH QuasiQuote

In a haskell project using template haskell, I am trying to generate an expression that has a type annotation as a phantom type.
A simple example would be a situation with DataKinds and KindSignatures like:
{-# LANGUAGE DataKinds, KindSignatures #-}
data Foo = A | B
data GenMe (w :: Foo) = GenMe Int
[| $(generate some code) :: GenMe $(genType someCompileTimeData) |]
How can I write a function, like genType such that
genType :: Foo -> Q Type
lifting just lifts the variable holding the compile time Foo value? I don't know which constructor to use from the Type Data Constructors
to make data kinds.
Any thoughts? Thanks!
Another way to slice this problem is to define a promote :: Exp -> Maybe Type function and then use lift on Foo.
-- | Takes the AST for an expression and tries to produce the corresponding
-- promoted type AST.
promote :: Exp -> Q Type
promote (VarE n) = fail ("Cannot promote variable " ++ show n)
promote (ConE n) = pure (PromotedT n)
promote (LitE l) = LitT <$> promoteLit l
promote (TupE es) = foldl AppT (PromotedTupleT (length es)) <$> (traverse promote es)
promote (ListE es) = foldr (\x xs -> AppT (AppT PromotedConsT x) xs) PromotedNilT <$> (traverse promote es)
promote (ParensE e) = ParensT <$> promote e
promote (AppE e1 e2) = AppT <$> promote e1 <*> promote e2
promote (InfixE (Just e1) e2 (Just e3)) = AppT <$> (AppT <$> promote e2 <*> promote e1) <*> promote e3
promote _ = fail "Either impossible to promote or unimplemented"
-- | Promote an expression literal to a type one
promoteLit :: Lit -> Q TyLit
promoteLit (StringL s) = pure (StrTyLit s)
promoteLit (IntegerL i) = pure (NumTyLit i)
promoteLit _ = fail "Expression literal cannot be promoted"
Then, I think something along the lines of the following should work
ghci> :set -XDeriveLift -XDataKinds -XKindSignatures -XTemplateHaskell -XQuasiQuotes
ghci> data Foo = A | B deriving (Lift)
ghci> foo1 = A
ghci> data GenMe (w :: Foo) = GenMe Int
ghci> runQ [| GenMe 1 :: GenMe $(promote =<< lift foo1) |]
SigE (AppE (ConE Ghci5.GenMe) (LitE (IntegerL 1))) (AppT (ConT Ghci5.GenMe) (PromotedT Ghci3.A))

Is there a way to code a chainl function in idris lightyear library?

I'm trying to formalise a regular expression based string search tool in Idris
(current status here). But I'm fighting with the problem of parsing regular expressions. I've tried to build a small parsing library but gave up on this in favor to use Lightyear, a parsing combinator library for Idris.
Since I'm used to Haskell, I've tried to use a similar strategy that I would do using Parsec. My main problem is how to handle left recursion on Lightyear parsers? I've tried several encodings but pretty much all parsers end up looping and causing segmentation faults in generated code.
I don't know Lightyear, but I had some success porting Parsec to Idris:
module Parser
data Parser : Type -> Type where
P : (String -> List (a, String)) -> Parser a
unP : Parser a -> String -> List (a, String)
unP (P f) = f
total stripPrefix : (Eq a) => List a -> List a -> Maybe (List a)
stripPrefix [] ys = Just ys
stripPrefix (x::xs) (y::ys) = if (x == y) then stripPrefix xs ys else Nothing
stripPrefix _ _ = Nothing
total token : String -> Parser ()
token tk = P $ \s => case stripPrefix (unpack tk) (unpack s) of
Just s' => [((), pack s')]
Nothing => []
total skip : Parser ()
skip = P $ \s => case unpack s of
[] => []
(_::s') => [((), pack s')]
instance Functor Parser where
map f p = P $ \s => map (\(x, s') => (f x, s')) (unP p s)
instance Applicative Parser where
pure x = P $ \s => [(x, s)]
(P pf) <*> (P px) = P $ \s => concat (map (\(f, s') => map (\(x, s'') => (f x, s'')) (px s')) (pf s))
instance Alternative Parser where
empty = P $ \s => []
(P p1) <|> (P p2) = P $ \s => case p1 s of
[] => p2 s
results => results
instance Monad Parser where
px >>= f = P $ \s => concat (map (\(x, s') => unP (f x) s') (unP px s))
total runParser : Parser a -> String -> Maybe a
runParser (P p) s = case p s of
[(x, "")] => Just x
_ => Nothing
This allows a straight copy-paste implementation of chainl:
chainl1 : Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 p op = p >>= rest
where
rest x = do { f <- op; y <- p; rest $ f x y } <|> return x
chainl : Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op x = chainl1 p op <|> return x
We can then take a straight transliteration of the expression parser from the chainl docs (I'm too lazy to implement a proper integer parser so we'll just use unary):
parens : Parser a -> Parser a
parens p = token "(" *> p <* token ")"
symbol : String -> Parser ()
symbol = token
integer : Parser Nat
integer = P $ \s => case unpack s of
('Z'::s') => [(Z, pack s')]
('S'::s') => map (\(n, s'') => (S n, s'')) $ unP integer (pack s')
_ => []
mutual
expr : Parser Nat
expr = term `chainl1` addop
term : Parser Nat
term = factor `chainl1` mulop
factor : Parser Nat
factor = parens expr <|> integer
mulop : Parser (Nat -> Nat -> Nat)
mulop = (symbol "*" *> pure (*)) <|>
(symbol "/" *> pure div)
addop : Parser (Nat -> Nat -> Nat)
addop = (symbol "+" *> pure (+)) <|>
(symbol "-" *> pure (-))
Now, if you try this:
main : IO ()
main = do
s <- getLine
printLn $ runParser expr s
then it will have the same divergant behaviour that you've observed. However, we can make two small changes:
Introduce a lazy alternative combinator:
orElse : Parser a -> Lazy (Parser a) -> Parser a
orElse p1 p2 = P $ \s => case unP p1 s of
[] => unP p2 s
results => results
Make sure the recursive part of factor, i.e. the parens expr part, is in this lazy position, by flipping the two alternatives:
factor = integer `orElse` parens expr
This then works as expected:
13:06:07 [cactus#galaxy brainfuck]$ idris Expr.idr -o Expr
13:06:27 [cactus#galaxy brainfuck]$ echo "SZ+(SSZ*SSSZ)" | ./Expr
Just 7
The chainl and chainl1 combinators can be used with the Lightyear package. However, they are provided by default. I've added the combinators to my own modules where I've needed them:
chainl1 : Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 p op = p >>= rest
where rest a1 = (do f <- op
a2 <- p
rest (f a1 a2)) <|> pure a1
chainl : Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op a = (p `chainl1` op) <|> pure a
Seems to work fine. Hope that helps.