I am dealing with some weird problem. I want to write a Haskell program, which will print given logical formulae, i.e.
print (showFormula (I (N (Z 'p')) (A (C (Z 'p') (Z 'q')) (Z 'r'))))
(where I is implication, A - alternative, N - negation, C - conjunction and Z - character)
should print something like that:
"(~p => ((p & q) | r))"
So far, my code looks like that:
data Formula
= Z Char
| V Bool
| N Formula
| C Formula Formula
| A Formula Formula
| I Formula Formula
| Join Formula Formula
showFormula :: Formula -> String
showFormula (Z c) = [c]
showFormula (Join a b) = (showFormula a) ++ (showFormula b)
showFormula (N a) = '~':(showFormula a)
showFormula (C a b) = "("++(showFormula a)++" & "++(showFormula b)++")"
showFormula (A a b) = "("++(showFormula a)++" | "++(showFormula b)++")"
showFormula (I a b) = "("++(showFormula a)++" => "++(showFormula b)++")"
It does print proper string but only when you input simple formula like (C (Z 'a') (Z 'b')) and it crashes with some expanded formulae. I know that the problem is passing a Formula parameter instead of String to showFormula function, but I have no idea how to change that. Please give me some advices how to fix that.
If you compile your code with the -Wall flag it will show you the following warning:
fml.hs:4:1: Warning:
Pattern match(es) are non-exhaustive
In an equation for `showFormula': Patterns not matched: V _
You forgot to write the V case for showFormula so it will crash if it reaches that, similarly to how the head function crashes if you call it with an empty list.
Looks like you just missed the (V b) case in your pattern match.
data Formula
= Z Char
| V Bool
| N Formula
| C Formula Formula
| A Formula Formula
| I Formula Formula
| Join Formula Formula
showFormula :: Formula -> String
showFormula (V b) = show b
showFormula (Z c) = [c]
showFormula (Join a b) = (showFormula a) ++ (showFormula b)
showFormula (N a) = '~':(showFormula a)
showFormula (C a b) = "("++(showFormula a)++" & "++(showFormula b)++")"
showFormula (A a b) = "("++(showFormula a)++" | "++(showFormula b)++")"
showFormula (I a b) = "("++(showFormula a)++" => "++(showFormula b)++")"
main :: IO ()
main = do
print (showFormula (I (N (Z 'p')) (A (C (Z 'p') (Z 'q')) (Z 'r'))))
-- "(~p => ((p & q) | r))"
Related
I am not quite sure what this ZInt is actually describing.
data Nat = Zero | S Nat
data ZInt = Z Nat Nat deriving Show
addZ :: ZInt -> ZInt -> ZInt
addZ (Z a b) (Z c d) = Z (add a c) (add b d)
with
add :: Nat -> Nat -> Nat
add a Zero = a
add a (S b) = S (add a b)
mult :: Nat -> Nat -> Nat
mult _ Zero = Zero
mult a (S b) = add a (mult a b)
At first glance i thought maybe it's a presentation of complex numbers, adding imaginary and real components (in function addZ) without displaying form of
a+b*i
But what is happening in this functions?
subZ :: ZInt -> ZInt -> ZInt
subZ (Z a b) (Z c d) = Z (add a d) (add b c)
multZ :: ZInt -> ZInt -> ZInt
multZ (Z a b) (Z c d) = Z (add (mult a d) (mult c b)) (add (mult a c) (mult b d))
So I do understand data Nat = Zero | S Nat and also the add and mult functions, but not addZ, subZ and multZ.
It's just integer numbers. Nat represents a natural number. ZInt represents an integer number. In Z a b if a >= b then integer is a - b else -(b - a).
For example:
ZInt representation | Traditional representation
Z Zero Zero | 0
Z (S Zero) Zero | 1
Z Zero (S Zero) | -1
Z (S Zero) (S Zero) | 0
...
As we can see, to negate an integer you just swap the Nat values in its representation:
negate :: ZInt -> ZInt
negate (Z n m) = Z m n
And we can define subZ like this:
a `subZ` b = a `addZ` negate b
This representation is not canonical, Z (S Zero) (S Zero) is the same integer as Z Zero Zero. So, we can define canonical form like this:
canonical :: ZInt -> ZInt
canonical (Z (S n) (S m)) = canonical (Z n m)
canonical x = x
What reason is to define integer numbers by this way?
First of all, it mathematically clear. If someone defined the set of natural number named N the we can easy define the set of integers named Z as Z = N * N where (*) is product of two sets.
In Haskell, I can see only one reason for that. By this way we can define integer numbers on type level.
First, ZInt is representing each integer as an ordered pair of natural numbers. #freestyle covers how this representation works well; I will just expand on how the arithmetic operators take advantage of this encoding.
addZ, subZ and multZ are simply manipulating the pair of natural numbers that represent each integer.
addZ (Z a b) (Z c d) = Z (add a c) (add b d)
(a - b) + (c - d) == a - b + c - d
== a + c - b - d
== (a + c) - (b + d)
subZ (Z a b) (Z c d) = Z (add a d) (add b c)
(a - b) - (c - d) == a - b - c + d
== a + d - b - c
== (a + d) - (b + c)
multZ (Z a b) (Z c d) = Z (add (mult a d) (mult c b)) (add (mult a c) (mult b d))
(a - b) * (c - d) == ac - ad - bc + bd
== ac + bd - ad - bc
== (ac + bd) - (ad + bc)
Note that the given definition of multZ can get the sign wrong; it should be
multZ (Z a b) (Z c d) = Z (add (mult a c) (mult b d)) (add (mult a d) (mult b c))
(For clarity, it should also use mult b c instead of mult c b, even though multiplication of natural numbers is commutative.)
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
I've taken András Kovács's DBIndex.hs, a very simple implementation of a dependently typed core, and tried simplifying it even further, as much as I possibly could, without "breaking" the type system. After several simplifications, I was left with something much smaller:
{-# language LambdaCase, ViewPatterns #-}
data Term
= V !Int
| A Term Term
| L Term Term
| S
| E
deriving (Eq, Show)
data VTerm
= VV !Int
| VA VTerm VTerm
| VL VTerm (VTerm -> VTerm)
| VS
| VE
type Ctx = ([VTerm], [VTerm], Int)
eval :: Bool -> Term -> Term
eval typ term = err (quote 0 (eval term typ ([], [], 0))) where
eval :: Term -> Bool -> Ctx -> VTerm
eval E _ _ = VE
eval S _ _ = VS
eval (V i) typ ctx#(vs, ts, _) = (if typ then ts else vs) !! i
eval (L a b) typ ctx#(vs,ts,d) = VL a' b' where
a' = eval a False ctx
b' = \v -> eval b typ (v:vs, a':ts, d+1)
eval (A f x) typ ctx = fx where
f' = eval f typ ctx
x' = eval x False ctx
xt = eval x True ctx
fx = case f' of
(VL a b) -> if check a xt then b x' else VE -- type mismatch
VS -> VE -- non function application
f -> VA f x'
check :: VTerm -> VTerm -> Bool
check VS _ = True
check a b = quote 0 a == quote 0 b
err :: Term -> Term
err term = if ok term then term else E where
ok (A a b) = ok a && ok b
ok (L a b) = ok a && ok b
ok E = False
ok t = True
quote :: Int -> VTerm -> Term
quote d = \case
VV i -> V (d - i - 1)
VA f x -> A (quote d f) (quote d x)
VL a b -> L (quote d a) (quote (d + 1) (b (VV d)))
VS -> S
VE -> E
reduce :: Term -> Term
reduce = eval False
typeof :: Term -> Term
typeof = eval True
The problem is that I have no idea what makes a type system consistent, so I had no criteria (other than intuition) and probably broke it in several ways. It, more or less, does what I think a type system should do, though:
main :: IO ()
main = do
-- id = ∀ (a:*) . (λ (x:a) . a)
let id = L S (L (V 0) (V 0))
-- nat = ∀ (a:*) . (a -> a) -> (a -> a)
let nat = L S (L (L (V 0) (V 1)) (L (V 1) (V 2)))
-- succ = λ (n:nat) . ∀ (a:*) . λ (s : a -> a) . λ (z:a) . s (n a s z)
let succ = L nat (L S (L (L (V 0) (V 1)) (L (V 1) (A (V 1) (A (A (A (V 3) (V 2)) (V 1)) (V 0))))))
-- zero = λ (a:*) . λ (s : a -> a) . λ (z : a) . z
let zero = L S (L (L (V 0) (V 1)) (L (V 1) (V 0)))
-- add = λ (x:nat) . λ (y:nat) . λ (a:*) . λ(s: a -> a) . λ (z : a) . (x a s (y a s z))
let add = L nat (L nat (L S (L (L (V 0) (V 1)) (L (V 1) (A (A (A (V 4) (V 2)) (V 1)) (A (A (A (V 3) (V 2)) (V 1)) (V 0)))))))
-- bool = ∀ (a:*) . a -> a -> a
let bool = L S (L (V 0) (L (V 1) (V 2)))
-- false = ∀ (a:*) . λ (x : a) . λ(y : a) . x
let false = L S (L (V 0) (L (V 1) (V 0)))
-- true = ∀ (a:*) . λ (x : a) . λ(y : a) . y
let true = L S (L (V 0) (L (V 1) (V 1)))
-- loop = ((λ (x:*) . (x x)) (λ (x:*) . (x x)))
let loop = A (L S (A (V 0) (V 0))) (L S (A (V 0) (V 0)))
-- natOrBoolId = λ (a:bool) . λ (t:(if a S then nat else bool)) . λ (x:t) . t
let natOrBoolId = L bool (L (A (A (A (V 0) S) nat) bool) (V 0))
-- nat
let c0 = zero
let c1 = A succ zero
let c2 = A succ c1
let c3 = A succ c2
let c4 = A succ c3
let c5 = A succ c4
-- Tests
let test name pass = putStrLn $ "- " ++ (if pass then "OK." else "ERR") ++ " " ++ name
putStrLn "True and false are bools"
test "typeof true == bool " $ typeof true == bool
test "typeof false == bool " $ typeof false == bool
putStrLn "Calling 'true nat' on two nats selects the first one"
test "reduce (true nat c1 c2) == c1" $ reduce (A (A (A true nat) c1) c2) == reduce c1
test "typeof (true nat c1 c2) == nat" $ typeof (A (A (A true nat) c1) c2) == nat
putStrLn "Calling 'true nat' on a bool is a type error"
test "reduce (true nat true c2) == E" $ reduce (A (A (A true nat) true) c2) == E
test "reduce (true nat c2 true) == E" $ reduce (A (A (A true nat) c2) true) == E
putStrLn "More type errors"
test "reduce (succ true) == E" $ reduce (A succ true) == E
putStrLn "Addition works"
test "reduce (add c2 c3) == c5" $ reduce (A (A add c2) c3) == reduce c5
test "typeof (add c2 c2) == nat" $ typeof (A (A add c2) c3) == nat
putStrLn "Loop isn't typeable"
test "typeof loop == E" $ typeof loop == E
putStrLn "Function with type that depends on value"
test "typeof (natOrBoolId true c2) == nat" $ typeof (A (A natOrBoolId true) c2) == nat
test "typeof (natOrBoolId true true) == E" $ typeof (A (A natOrBoolId true) true) == E
test "typeof (natOrBoolId false c2) == E" $ typeof (A (A natOrBoolId false) c2) == E
test "typeof (natOrBoolId false true) == bool" $ typeof (A (A natOrBoolId false) true) == bool
My question is, what exactly makes a system consistent? Specifically:
What problems do I get from the things I did (removing Pi, merging infer/eval, etc.)? Can those be somehow "justified" (generating a different system but still "correct")?
Basically: is it possible to fix this system (i.e., make it "suitable as the core of a dependently typed language just like CoC") while keeping it small?
Runnable code.
First of all, consistency is a thing in mathematical logic, meaning that a logic doesn't contain a contradiction. I've seen people speaking about the "consistency" of type theories, but unfortunately it is not a well-defined term.
In the context of lambda calculus, many people use the term "consistency" to mean vastly different things. Some people say the untyped lambda-calculus is consistent, by which they mean that different derivations of a lambda-term lead to the same result (i.e. the Church-Rosser property). In that respect, most calculi are consistent.
However, consistent can also mean that the Curry-Howard isomorphic logic of the calculus is consistent. Simply-typed lambda-calculus corresponds to first-order intuitionistic logic (without equality), and when people say STLC is consistent they really mean that first-order intuitionistic logic is consistent. In this sense of consistency, consistency means that the bottom (void) type doesn't have an inhabitant (and, thus, a derivation). That is, every expression must produce a value with a valid type. Bottom corresponds to falsehood, so this means that falsehood can't be derived (because you can derive anything from falsehood).
Now, in this sense, to be consistent you can't have nontermination (fix), non-returning functions, or control operators (call/cc and friends). Haskell is not consistent in this sense, because you can write functions that produce arbitrary types (the function f x = f x has type a -> b; obviously, this isn't consistent). Similarly, you can return undefined from anything, making it producing something of the bottom type. So, to make sure that a type theory is consistent in this sense, you'd have to make sure that you can't return the empty type from any expression.
But then, in the first sense of "consistency", Haskell is consistent I believe (barring some wacky features). Equational equivalence should be good.
i am making tiny language. Let E be a tiny programming language that supports the declaration of arithmetic expressions and equality comparison on integers.
given the following data type E:
data E = IntLit Int
| BoolLit Bool
| Plus E E
| Minus E E
| Multiplies E E
| Exponentiate E E
| Equals E E
deriving (Eq, Show)
here is my code with above data it is working all of these.
data E = IntLit Int
| BoolLit Bool
| Plus E E
| Minus E E
| Multiplies E E
| Divides E E
| Equals E E
| log2Sim E E
deriving (Eq, Show)
eval :: E -> E
eval c#(IntLit i) = c
eval c#(BoolLit b) = c
eval (Plus a b) = plus (eval a) (eval b)
eval (Minus a b) = minus (eval a) (eval b)
eval (Multiplies a b) = multiplies (eval a) (eval b)
eval (Divides a b) = divides (eval a) (eval b)
eval (Equals a b) = equals (eval a) (eval b)
log2Sim :: E -> E
log2sim = case (eval x) of
IntLit i -> IntLit (logBase 2 i)
x1 -> "type error: can't take the log of a non-IntLit-valued expresstio" ++ show x1
plus (IntLit i) (IntLit j) = IntLit $ i + j
plus _ _ = error "Type error in addition"
minus (IntLit i) (IntLit j) = IntLit $ i - j
minus _ _ = error "Type error in subtraction"
multiplies (IntLit i) (IntLit j) = IntLit $ i * j
multiplies _ _ = error "Type error in multiplication"
divides (IntLit i) (IntLit j) = IntLit $ i `div` j
divides _ _ = error "Type error in division"
equals (IntLit i) (IntLit j) = BoolLit $ i == j
equals (BoolLit a) (BoolLit b) = BoolLit $ a == b
equals _ _ = error "Type error in equals"
when i compiled it, there are some errors.
what error is this?
A3.hs:56:7:
Couldn't match expected type `E' against inferred type `[Char]'
In the expression:
"type error: can't take the lof of a non-IntLit-valued expression: "
++
show x1
In a case alternative:
x1
-> "type error: can't take the lof of a non-IntLit-valued expression: "
++
show x1
In the expression:
case (eval x) of
IntLit i -> IntLit (logBase 2 i)
x1
-> "type error: can't take the lof of a non-IntLit-valued expression: "
++
show x1
There are many problems in your code:
All constructors must start with an upper-case letter. So data E = ... | log2Sim E E is incorrect. You also probably just want one E, hence for example data E = ... | Log E would fix both these problems.
You declared log2Sim but defined log2sim (notice the difference in capitalization). You also forgot to write the argument x to the left of the = in the definition. Fix both problems by writing
log2Sim x = ...
Strings are not valid expressions of type E. You probably wanted to follow the pattern in the rest of your code by calling error to turn your error string into an E. Thus:
x1 -> error $ "type error: can't take the log of a non-IntLit-valued expresstio" ++ show x1
logBase operates on Floating-point numbers, and Int is not one. There's a few ways to fix this, but the shortest distance between here and there is to convert to a Double and back. For example:
IntLit i -> IntLit . floor . logBase 2 . fromIntegral $ i
This is enough to make your code compile, though there may be other problems.
I have a string sort function defined as below and want to prove a lemma
sort_str_list_same below. I am not Coq expert, I tried to solve it using induction, but could not solve it. Please help me solving it. Thanks,
Require Import Ascii.
Require Import String.
Notation "x :: l" := (cons x l) (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x , .. , y ]" := (cons x .. (cons y nil) ..).
Fixpoint ble_nat (n m : nat) : bool :=
match n with
| O => true
| S n' =>
match m with
| O => false
| S m' => ble_nat n' m'
end
end.
Definition ascii_eqb (a a': ascii) : bool :=
if ascii_dec a a' then true else false.
(** true if s1 <= s2; s1 is before/same as s2 in alphabetical order *)
Fixpoint str_le_gt_dec (s1 s2 : String.string)
: bool :=
match s1, s2 with
| EmptyString, EmptyString => true
| String a b, String a' b' =>
if ascii_eqb a a' then str_le_gt_dec b b'
else if ble_nat (nat_of_ascii a) (nat_of_ascii a')
then true else false
| String a b, _ => false
| _, String a' b' => true
end.
Fixpoint aux (s: String.string) (ls: list String.string)
: list String.string :=
match ls with
| nil => s :: nil
| a :: l' => if str_le_gt_dec s a
then s :: a :: l'
else a :: (aux s l')
end.
Fixpoint sort (ls: list String.string) : list String.string :=
match ls with
| nil => nil
| a :: tl => aux a (sort tl)
end.
Notation "s1 +s+ s2" := (String.append s1 s2) (at level 60, right associativity) : string_scope.
Lemma sort_str_list_same: forall z1 z2 zm,
sort (z1 :: z2 :: zm) =
sort (z2 :: z1 :: zm).
Proof with o.
Admitted.
Your lemma is equivalent to forall z1 z2 zm, aux z1 (aux z2 zm) = aux z2 (aux z1 zm). Here's how you can prove a similar theorem, for an arbitrary type with an order relation. To use it in your case, you just have to prove the given hypothesis. Note that the Coq standard library defines some sorting functions and proves lemmas about them, so you may be able to solve your problem without having to prove too many things.
Require Import Coq.Lists.List.
Section sort.
Variable A : Type.
Variable comp : A -> A -> bool.
Hypothesis comp_trans :
forall a b c, comp a b = true ->
comp b c = true ->
comp a c = true.
Hypothesis comp_antisym :
forall a b, comp a b = true ->
comp b a = true ->
a = b.
Hypothesis comp_total :
forall a b, comp a b = true \/ comp b a = true.
Fixpoint insert (a : A) (l : list A) : list A :=
match l with
| nil => a :: nil
| a' :: l' => if comp a a' then a :: a' :: l'
else a' :: insert a l'
end.
Lemma l1 : forall a1 a2 l, insert a1 (insert a2 l) = insert a2 (insert a1 l).
Proof.
intros a1 a2 l.
induction l as [|a l IH]; simpl.
- destruct (comp a1 a2) eqn:E1.
+ destruct (comp a2 a1) eqn:E2; trivial.
rewrite (comp_antisym _ _ E1 E2). trivial.
+ destruct (comp a2 a1) eqn:E2; trivial.
destruct (comp_total a1 a2); congruence.
- destruct (comp a2 a) eqn:E1; simpl;
destruct (comp a1 a) eqn:E2; simpl;
destruct (comp a1 a2) eqn:E3; simpl;
destruct (comp a2 a1) eqn:E4; simpl;
try rewrite E1; trivial;
try solve [rewrite (comp_antisym _ _ E3 E4) in *; congruence];
try solve [destruct (comp_total a1 a2); congruence].
+ assert (H := comp_trans _ _ _ E3 E1). congruence.
+ assert (H := comp_trans _ _ _ E4 E2). congruence.
Qed.
Section sort.