I have those info on my haskell code:
data Symtable a = General a | Stack a
class Evaluable e where
eval :: (Num a, Ord a) => (Ident -> Maybe a) -> (e a) -> (Either String a)
typeCheck :: (Ident -> String) -> (e a) -> Bool
instance (Num a, Ord a) => Evaluable (NExpr a) where
eval f f2 = Left ("Undefined variable: ") --to make the code compilable
typeCheck f f2 = True --to make the code compilable
The thing is, eval function returns the evaluation of a numeric expression (for example 3 + 5, or x + 3), therefore I have to check the value of X on the symtable data but I haven't got it referenced on this function (I cannot edit the function header). How can I do it?
ident = string and Nexpr:
data NExpr n = Const n |
Var Ident |
Plus (NExpr n) (NExpr n) |
Minus (NExpr n) (NExpr n) |
Times (NExpr n) (NExpr n)
The first arugment to eval is a function that will look up the value of a name found in an expression. You ignore it when evaluating a Const value, use it when evaluating a Var value, and just pass it along to the recursive calls for the other cases.
instance (Num a, Ord a) => Evaluable (NExpr a) where
eval _ (Const n) = Right n
eval lookup (Var x) = case lookup x of
Nothing -> Left ("Undefined variable: " ++ x)
Just y -> Right y
eval lookup (Plus left right) = (+) <$> eval lookup left <*> eval lookup right
-- etc
Related
I have this AST data structure
data AST = Integer Int
| Let String AST AST
| Plus AST AST
| Minus AST AST
| Times AST AST
| Variable String
| Boolean Bool
| If AST AST AST
| Lambda String AST Type Type
| Application AST AST
| And AST AST
| Or AST AST
| Quot AST AST
| Rem AST AST
| Negate AST
| Eq AST AST
| Leq AST AST
| Geq AST AST
| Neq AST AST
| Lt AST AST
| Gt AST AST
and this evaluation code:
eval :: AST -> AST
eval = cata go where
go :: ASTF (AST) -> AST
go (LetF var e e') = eval $ substVar (var, e) e'
go (PlusF (Integer n) (Integer m)) = Integer (n + m)
go (MinusF (Integer n) (Integer m)) = Integer (n - m)
go (TimesF (Integer n) (Integer m)) = Integer (n * m)
go (QuotF (Integer n) (Integer m)) = Integer (quot n m)
go (RemF (Integer n) (Integer m)) = Integer (rem n m)
go (IfF (Boolean b) e e') = if b then e else e'
go (ApplicationF (Lambda var e _ _) e') = eval $ substVar (var, e') e
go (AndF (Boolean b) (Boolean b')) = Boolean (b && b')
go (OrF (Boolean b) (Boolean b')) = Boolean (b || b')
go (NegateF (Boolean b)) = Boolean (not b)
go (EqF e e') = Boolean (e == e')
go (NeqF e e') = Boolean (e /= e')
go (LeqF (Integer n) (Integer m)) = Boolean (n <= m)
go (GeqF (Integer n) (Integer m)) = Boolean (n >= m)
go (LtF (Integer n) (Integer m)) = Boolean (n < m)
go (GtF (Integer n) (Integer m)) = Boolean (n > m)
go astf = embed astf
I feel like there should be away to remove the explicit recursion for 'let' and application, but I'm not sure exactly which recursion scheme I should reach for. Which recursion scheme(s) can be used to remove recursion in this case and similar cases and do you have any good ways of identifying situations where said recursion scheme is applicable?
eval isn't directly expressible as a catamorphism because eval (Let x e e') applies eval to subst (x, eval e) e', which is not a subterm of Let x e e' (e or e'). Instead, consider the composition of eval and substitution. If you generalize substitution subst to substitute many variables at once with substs, then you can get the following equation:
(eval . substs s) (Let x e e')
= eval (Let x (substs s e) (substs s e'))
= (eval . subst (x, (eval . substs s) e) . substs s) e'
-- by (subst xe . substs s) = substs (xe : s)
= (eval . substs ((x, (eval . substs s) e) : s)) e'
where we do have a function of the form (eval . substs _) applied to both subterms e and e'. In order to account for the parameter of substs, you can use cata with an F-algebra where the carrier is a function ASTF (Sub -> AST) -> Sub -> AST, then you get to pass a different substitution Sub to each subterm.
{-# LANGUAGE TemplateHaskell, TypeFamilies #-}
import Data.Functor.Foldable (cata)
import Data.Functor.Foldable.TH (makeBaseFunctor)
import Data.Maybe (fromJust)
type Id = String
data AST
= Let Id AST AST
| Var Id
| Int Int
| Plus AST AST
type Sub = [(Id, AST)]
makeBaseFunctor ''AST
evalSubsts :: AST -> Sub -> AST
evalSubsts = cata go where
go (LetF x e e') s = e' ((x, e s) : s)
go (VarF x) s = fromJust (lookup x s)
go (IntF n) _ = Int n
go (PlusF e e') s =
let (Int n, Int m) = (e s, e' s) in
Int (n + m)
-- Or this:
-- go (PlusF e e') = liftA2 plus e e'
-- where plus (Int n) (Int m) = Int (n + m)
eval :: AST -> AST
eval e = evalSubsts e []
Another way to think of evalSubsts is as an evaluator using an environment, mapping variables to values. Then to bind a variable, rather than to do a substitution, is just to insert its value in the environment, which gets looked up once you reach a Var node.
Continuing on the evalSubsts approach from #li-yao-xia, let's try to add lambdas and applications to our language. We start by extending AST:
data AST
...
| Lam Id AST
| App AST AST
But, how do we write our LamF case in evalSubst?
go (LamF x e) s = ???
We want our lambdas to be statically (lexically) scoped, so we need to keep around the environment s, but we also can't possibly apply an environment to e yet because we don't know what the value for x should be. We're in a bind!
The solution here is to recognize that, while AST is a great representation for our input, it is not a great representation for the output. Indeed, it's a bit of a coincidence that input Ints and output Ints both happen to share the same structure, and for lambdas, perhaps they shouldn't. So, we can make a new output representation:
data Val
= IntV Int
| LamV (Val -> Val)
type Sub = [(Id, Val)]
The key here is that LamV is a function, not simply some data. With this, we can finish our definition of evalSubsts:
evalSubsts :: AST -> Sub -> Val
evalSubsts = cata go where
go (LetF x e e') s = e' ((x, e s) : s)
go (VarF x) s = fromJust (lookup x s)
go (IntF n) _ = IntV n
go (LamF x e) s = LamV $ \xVal -> e ((x, xVal) : s)
go (AppF lam e) s =
let (LamV f) = lam s in f (e s)
go (PlusF e e') s =
let (IntV n, IntV m) = (e s, e' s) in
IntV (n + m)
Data type for arithmetic expressions with let bindings in haskell
Here's a variant of the original Expr type that adds variables (V) and let bindings (Let).
data Expr = C Float | V String
| Let [(String, Expr)] Expr
| Expr :+ Expr | Expr :- Expr
| Expr :* Expr | Expr :/ Expr
To help write evaluate, you may want to start with a function that does variable substitution:
data Expr = C Float | V String
| Let [(String, Expr)] Expr
| Expr :+ Expr | Expr :- Expr
| Expr :* Expr | Expr :/ Expr
deriving Show
-- | #sub var value e# replaces variables named #var# with the value #value#
-- wherever anywhere that variable occurs in expression #e#.
sub :: String -> Expr -> Expr -> Expr
-- "let x = y in x" = y
sub v1 value (V v2) | v1 == v2 = value
-- "let x = y in z" = z
sub _ _ e#(V _) = e
-- Constants are unaffected
sub _ _ c#(C _) = c
-- For operators, apply #sub a b# recursively to the operands.
sub a b (e1 :+ e2) = (sub a b e1) :+ (sub a b e2)
sub a b (e1 :- e2) = (sub a b e1) :- (sub a b e2)
sub a b (e1 :* e2) = (sub a b e1) :* (sub a b e2)
sub a b (e1 :/ e2) = (sub a b e1) :/ (sub a b e2)
-- The variable is shadowed by a let binding, so only substitute
-- into the bindings, and leave the body expression unmodified.
sub a b (Let bindings e) | bindingsContains a bindings =
Let (subIntoBindings a b bindings) e
-- Apply #sub a b# recursively to the body of the let expression.
sub a b (Let bindings body) =
Let (subIntoBindings a b bindings) (sub a b body)
bindingsContains :: String -> [(String, Expr)] -> Bool
bindingsContains x bindings =
Data.Maybe.isJust $ Data.List.find ((== x) . fst) bindings
subIntoBindings :: String -> Expr -> [(a, Expr)] -> [(a, Expr)]
subIntoBindings a b bindings = (fmap . fmap) (sub a b) bindings
I want to idenfity what function was passed as parameter to a high-order function.
How can i do that? Using pattern matching?
I want to do something like the following code:
add x y = x+y
sub x y = x-y
myFunc :: (a->a->a) -> a -> a -> IO a
myFunc add x y = do print "add was performed"
add x y
myFunc sub x y = do print "sub was performed"
sum x y
myFunc f x y = do print "another function was performed"
f x y
If this is not possible, does anyone has other idea to do that?
No, this is not possible.
You could achieve something to that effect by having a data type which represents the operation, maybe
data Operation
= Add (a -> a -> a)
| Sub (a -> a -> a)
| Other (a -> a -> a)
myFunc :: Operation -> a -> a -> IO a
myFunc (Add f) x y = do print "add was performed"
return (f x y)
myFunc (Sub f) x y = do print "sub was performed"
return (f x y)
myFunc (Other f) x y = do print "another function was performed"
return (f x y)
It's not possible to do exactly what you requested. I would recommend that you instead make an embedded domain-specific language (EDSL) and write one or more interpreters for it. The most common approach is to represent the EDSL using an algebraic datatype or (in more complicated situations) a generalized algebraic datatype. Here you might have something like
data Expr a = Lit a
| BinOp (Op a) (Expr a) (Expr a)
deriving (Show)
data Op a = Add
| Sub
| Other (a -> a -> a)
instance Show (Op a) where
show Add = "Add"
show Sub = "Sub"
show Other{} = "Other"
Now you can write an evaluator that takes an Expr a and performs the requested operations:
evalExpr :: Num a => Expr a -> a
evalExpr (Lit x) = x
evalExpr (BinOp op e1 e2) = runOp op (evalExpr e1) (evalExpr e2)
runOp :: Num a => Op a -> a -> a -> a
runOp Add a b = a + b
runOp Sub a b = a - b
runOp (Other f) a b = f a b
You can add tracing too:
evalExpr' :: (Num a, MonadWriter [(Expr a, a)] m) => Expr a -> m a
evalExpr' e = do
result <- case e of
Lit a -> return a
BinOp op e1 e2 -> runOp op <$> evalExpr' e1 <*> evalExpr' e2
tell [(e, result)]
return result
Sample use:
*Write> runWriter $ evalExpr' (BinOp Add (Lit 3) (BinOp Sub (Lit 4) (Lit 5)))
(2,[(Lit 3,3),(Lit 4,4),(Lit 5,5),(BinOp Sub (Lit 4) (Lit 5),-1),(BinOp Add (Lit 3) (BinOp Sub (Lit 4) (Lit 5)),2)])
For convenience, you can write
instance Num a => Num (Expr a) where
fromInteger = Lit . fromInteger
(+) = BinOp Add
(-) = BinOp Sub
Then the above can be abbreviated
*Write Control.Monad.Writer> runWriter $ evalExpr' (3 + (4-5))
(2,[(Lit 3,3),(Lit 4,4),(Lit 5,5),(BinOp Sub (Lit 4) (Lit 5),-1),(BinOp Add (Lit 3) (BinOp Sub (Lit 4) (Lit 5)),2)])
Maybe to simplify and not to change a lot the overall look of your code, if it's already a long project and that's a concern, you could do something like:
add x y = x+y
sub x y = x-y
myFunc :: (Eq a, Num a) => (a->a->a) -> a -> a -> IO a
myFunc f x y = if (add x y) == (f x y) then
do print "add was performed"
return (add x y)
else if (sub x y) == (f x y) then
do print "sub was performed"
return (sub x y)
else
do print "another function was performed"
return (f x y)
It works, the only problem is that you wont be able to diferentiate for example an add 2 1 from a multiplication 2 1, so if thats a possibility you can throw new cases in there to cover all important grounds, like instead of only comparing add x y = f x y, also compare add y x with f y x. With some thought it will work 100% of the time.
I have a recursive function f that takes two parameters x and y. The function is uniquely determined by the first parameter; the second one merely makes things easier.
I now want to memoise that function w.r.t. it's first parameter while ignoring the second one. (I.e. f is evaluated at most one for every value of x)
What is the easiest way to do that? At the moment, I simply define an array containing all values recursively, but that is a somewhat ad-hoc solution. I would prefer some kind of memoisation combinator that I can just throw at my function.
EDIT: to clarify, the function f takes a pair of integers and a list. The first integer is some parameter value, the second one denotes the index of an element in some global list xs to consume.
To avoid indexing the list, I pass the partially consumed list to f as well, but obviously, the invariant is that if the first parameter is (m, n), the second one will always be drop n xs, so the result is uniquely determined by the first parameter.
Just using a memoisation combinator on the partially applied function will not work, since that will leave an unevaluated thunk \xs -> … lying around. I could probably wrap the two parameters in a datatype whose Eq instance ignores the second value (and similarly for other instances), but that seems like a very ad-hoc solution. Is there not an easier way?
EDIT2: The concrete function I want to memoise:
g :: [(Int, Int)] -> Int -> Int
g xs n = f 0 n
where f :: Int -> Int -> Int
f _ 0 = 0
f m n
| m == length xs = 0
| w > n = f (m + 1) n
| otherwise = maximum [f (m + 1) n, v + f (m + 1) (n - w)]
where (w, v) = xs !! m
To avoid the expensive indexing operation, I instead pass the partially-consumed list to f as well:
g' :: [(Int, Int)] -> Int -> Int
g' xs n = f xs 0 n
where f :: [(Int, Int)] -> Int -> Int -> Int
f [] _ _ = 0
f _ _ 0 = 0
f ((w,v) : xs) m n
| w > n = f xs (m + 1) n
| otherwise = maximum [f xs (m + 1) n, v + f xs (m + 1) (n - w)]
Memoisation of f w.r.t. the list parameter is, of course, unnecessary, since the list does not (morally) influence the result. I would therefore like the memoisation to simply ignore the list parameter.
Your function is unnecessarily complicated. You don't need the index m at all:
foo :: [(Int, Int)] -> Int -> Int
foo [] _ = 0
foo _ 0 = 0
foo ((w,v):xs) n
| w > n = foo xs n
| otherwise = foo xs n `max` foo xs (n - w) + v
Now if you want to memoize foo then both the arguments must be considered (as it should be).
We'll use the monadic memoization mixin method to memoize foo:
First, we create an uncurried version of foo (because we want to memoize both arguments):
foo' :: ([(Int, Int)], Int) -> Int
foo' ([], _) = 0
foo' (_, 0) = 0
foo' ((w,v):xs, n)
| w > n = foo' (xs, n)
| otherwise = foo' (xs, n) `max` foo' (xs, n - w) + v
Next, we monadify the function foo' (because we want to thread a memo table in the function):
foo' :: Monad m => ([(Int, Int)], Int) -> m Int
foo' ([], _) = return 0
foo' (_, 0) = return 0
foo' ((w,v):xs, n)
| w > n = foo' (xs, n)
| otherwise = do
a <- foo' (xs, n)
b <- foo' (xs, n - w)
return (a `max` b + v)
Then, we open the self-reference in foo' (because we want to call the memoized function):
type Endo a = a -> a
foo' :: Monad m => Endo (([(Int, Int)], Int) -> Int)
foo' _ ([], _) = return 0
foo' _ (_, 0) = return 0
foo' self ((w,v):xs, n)
| w > n = foo' (xs, n)
| otherwise = do
a <- self (xs, n)
b <- self (xs, n - w)
return (a `max` b + v)
We'll use the following memoization mixin to memoize our function foo':
type Dict a b m = (a -> m (Maybe b), a -> b -> m ())
memo :: Monad m => Dict a b m -> Endo (a -> m b)
memo (check, store) super a = do
b <- check a
case b of
Just b -> return b
Nothing -> do
b <- super a
store a b
return b
Our dictionary (memo table) will use the State monad and a Map data structure:
import Prelude hiding (lookup)
import Control.Monad.State
import Data.Map.Strict
mapDict :: Ord a => Dict a b (State (Map a b))
mapDict = (check, store) where
check a = gets (lookup a)
store a b = modify (insert a b)
Finally, we combine everything to create a memoized function memoFoo:
import Data.Function (fix)
type MapMemoized a b = a -> State (Map a b) b
memoFoo :: MapMemoized ([(Int, Int)], Int) Int
memoFoo = fix (memo mapDict . foo')
We can recover the original function foo as follows:
foo :: [(Int, Int)] -> Int -> Int
foo xs n = evalState (memoFoo (xs, n)) empty
Hope that helps.
---- update 2 ----
At last, he told me that is Exists…
thank you all.
---- update ----
Okay, we call it Forsome
ex3: forsome x0::[False,True]. forsome x1::[0,1,2]. (x0 || (0 < x1))
(whom told me "what is forall" added):
the constructor says "forall x in blah" but it really means "for some x in blah".
the formula is satisfied for some assignment of variables so it is satisfiable.
How can I do it?
Thanks
---- original ----
Suppose we have a formula ex3
ex3: forall x0::[False,True]. forall x1::[0,1,2]. (x0 || (0 < x1)).
At first I think ex3 is False, cause when x0 = False and x1 = 0 the formula is (False || (0 < 0)) so ex3 is absolutely false. But I be told that ex3 is True,
"satisfiable ex3 is true because there is at least one combination from sets x0 and x1 which returns true. So as long as there is 1 valid solution in Forall, it is true."
Assume that is correct…
I think it need to check groups of combination with same level but I am not figure out how to do it. To determine 'Are them same group` seems difficult.
Here is my codes:
File: Formula.hs
{-# LANGUAGE GADTs #-}
module Formula where
-- Datatype of formulas
-- --------------------
data Formula ts where
Body :: Term Bool -> Formula ()
Forall :: Show a
=> [a] -> (Term a -> Formula as) -> Formula (a, as)
data Term t where
Con :: t -> Term t
And :: Term Bool -> Term Bool -> Term Bool
Or :: Term Bool -> Term Bool -> Term Bool
Smaller :: Term Int -> Term Int -> Term Bool
Plus :: Term Int -> Term Int -> Term Int
Name :: String -> Term t -- to facilitate pretty printing
-- Pretty printing formulas
-- ------------------------
instance Show t => Show (Term t) where
show (Con v) = show v
show (And p q) = "(" ++ show p ++ " && " ++ show q ++ ")"
show (Or p q) = "(" ++ show p ++ " || " ++ show q ++ ")"
show (Smaller n m) = "(" ++ show n ++ " < " ++ show m ++ ")"
show (Plus n m) = "(" ++ show n ++ " + " ++ show m ++ ")"
show (Name name) = name
instance Show (Formula ts) where
show = show' ['x' : show i | i <- [0..]]
where
show' :: [String] -> Formula ts' -> String
show' ns (Body body) = show body
show' (n:ns) (Forall vs p) = "forall " ++ n ++ "::" ++ show vs ++ ". " ++ show' ns (p (Name n))
-- Example formulas
-- ----------------
ex1 :: Formula ()
ex1 = Body (Con True)
ex2 :: Formula (Int, ())
ex2 = Forall [1..10] $ \n ->
Body $ n `Smaller` (n `Plus` Con 1)
ex3 :: Formula (Bool, (Int, ()))
ex3 = Forall [False, True] $ \p ->
Forall [0..2] $ \n ->
Body $ p `Or` (Con 0 `Smaller` n)
wrongFormula :: Formula (Int, ())
wrongFormula = Forall [0..4] $ \n ->
Body $ n `Smaller` (Con 0)
File: Solver.hs
{-# LANGUAGE GADTs #-}
module Solver where
import Formula
-- Evaluating terms
-- ----------------
eval :: Term t -> t
eval (Con v) = v
eval (And p q) = eval p && eval q
eval (Or p q) = eval p || eval q
eval (Smaller n m) = eval n < eval m
eval (Plus n m) = eval n + eval m
eval (Name _) = error "eval: Name"
-- Checking formulas
-- -----------------
satisfiable :: Formula ts -> Bool
satisfiable (Body body) = eval body
-- FIXME wrong implement
--satisfiable (Forall xs f) = helper f xs
-- where helper :: (Term a -> Formula t) -> [a] -> Bool
-- helper fn (a:as) = (satisfiable $ (fn . Con) a) && (helper fn as)
-- helper _ [] = True
Any suggestion will be appreciated.
I agree with Daniel that this describes Exists, not Forall, but if you want to interpret it that way, you just have to change && to || and True to False.
Or, even better, using the Prelude functions
all :: (a -> Bool) -> [a] -> Bool -- is predicate true for all elements?
any :: (a -> Bool) -> [a] -> Bool -- is predicate true for any element?
you can write your existing implementation as
satisfiable (Forall xs f) = all (satisfiable . f . Con) xs
so to change it, you just change the all to any.