Splitting a premise with conjunction conclusion in Coq - functional-programming

I often have to do "induction loading" to prove goals in Coq, where I prove multiple things simultaneously by induction.
The problem is, I often end up with Inductive Hypotheses of the following form:
forall a1 ... an,
Premise1 -> Premise2 -> ... Premisek ->
Conclusion1 /\ Conclusion2 /\ ... Conclusion_m
This is fine, but tactics like eauto really don't know how to handle things like this, so it kills automation most of the time.
What I'm wondering is, is there a way to automatically break such a premise into m different premises, i.e.
forall a1 ... an,
Premise1 -> Premise2 -> ... Premisek ->
Conclusion1
...
forall a1 ... an,
Premise1 -> Premise2 -> ... Premise_k ->
Conclusion_m
The main problem I'm running into is that I don't know how to match with an arbitrary length chain of arrows in LTac. I could hard-code up to a certain length, but I'm hoping there's a better way.
Additionally, if it were possible to do the dual (i.e. split on all combinations of disjunctions in Premise1 .. Premise_k) that would also be useful.

I am not an expert of Ltac, but I gave it a try and came up with the following tactic.
Ltac decomp H :=
try match type of H with
context c [?A /\ ?B] =>
let H' := fresh H in
let Pa := context c[A] in
assert (H' : Pa) by (apply H);
let H'' := fresh H in
let Pb := context c[B] in
assert (H'' : Pb) by (apply H);
clear H;
rename H' into H;
rename H'' into H';
decomp H'
end.
Tactic Notation "decomp_hyp" hyp(H) := decomp H.
decomp H searches occurrences of conjunctions in H, then decomposes it into H' and H'', clean the state and calls itself recursively.
On a trivial example, this seems to work.

Perhaps something like this (minus the debug printouts)?
Ltac foo :=
match goal with
| |- forall q, ?X =>
let x := fresh in intros x; idtac x q ; (try foo); generalize x as q; clear x
| |- ?X -> _ =>
let x := fresh in intros x; idtac x ; (try foo); generalize x; clear x
| |- _ /\ _ => repeat split
end; idtac "done".
Goal forall {T} (a1 a2 a3:T) P1 P2 P3 Q1 Q2 Q3, P1 a1 -> P2 a2 -> P3 a3 -> Q1 /\ Q2 /\ Q3.
foo.
This leaves you with the goals
3 subgoals (ID 253)
============================
forall (T : Type) (a1 a2 a3 : T) (P1 P2 P3 : T -> Type) (Q1 : Prop),
Prop -> Prop -> P1 a1 -> P2 a2 -> P3 a3 -> Q1
subgoal 2 (ID 254) is:
forall (T : Type) (a1 a2 a3 : T) (P1 P2 P3 : T -> Type),
Prop -> forall Q2 : Prop, Prop -> P1 a1 -> P2 a2 -> P3 a3 -> Q2
subgoal 3 (ID 255) is:
forall (T : Type) (a1 a2 a3 : T) (P1 P2 P3 : T -> Type),
Prop -> Prop -> forall Q3 : Prop, P1 a1 -> P2 a2 -> P3 a3 -> Q3

Related

Lambda calculus implementation using CBV small step operational semantics

I'm trying to implement an interpreter for the lambda calculus that has constant intergers and supports the addition operation. The interpreter should use the call-by-value small-step operational semantics. So I've implemented a step that should be able to reduce a lambda term by one step. However, the stepper is losing the surrounding program of the reduced subterm when reduced.
This is my implementation in F#:
type Exp =
| Cst of int
| Var of string
| Abs of string * Exp
| App of Exp * Exp
| Arith of Oper * Exp * Exp
and Oper =
Plus
and the stepper looks like this:
let rec step (exp : Exp) (env : Map<string, Exp>) : Exp =
match exp with
| Cst _ | Abs(_) -> exp
| Var x ->
match Map.tryFind x env with
| Some v -> v
| None -> failwith "Unbound variable"
| App(e1, e2) ->
match step e1 env with
| Abs(x, e) ->
let newEnv = Map.add x (step e2 env) env
step e newEnv
| e1' -> failwithf "%A is not a lambda abstraction" e1'
| Arith(Plus, Cst a, Cst b) -> Cst (a + b)
| Arith(Plus, e1, Cst b) -> Arith(Plus, step e1 env, Cst b)
| Arith(Plus, Cst a, e2) -> Arith(Plus, Cst a, step e2 env)
| Arith(Plus, a, b) -> Arith(Plus, step a env, step b env)
So, given the following example of a program (\x.(\y.y x) 21 + 21) \x.x + 1
App
(Abs
("x", App (Abs ("y", App (Var "y", Var "x")), Arith (Plus, Cst 21, Cst 21))),
Abs ("x", Arith (Plus, Var "x", Cst 1)))
I expect the step function to only reduce the 21 + 21 while keeping the rest of the program i.e. I expect the following output after one step (\x.(\y.y x) 42) \x.x + 1. However, I'm not able to retain the surrounding code around the Cst 42. How should I modify the program such that it reduction only steps once while maintaining the rest of the program?
I think there are two things that you should do differently if you want to implement standard small-step CBV lambda calculus.
First, you want to always perform just one step. This means that you should always call step recursively only once. For example, you have Arith(Plus, step a env, step b env) - but this means that if you have an expression representing (1+2)+(2+3), you will reduce this in "one step" to 3+5 but this is really two steps in one.
Second, I don't think your way of handling variables will work. If you have (\x.x+2) 1, this should reduce to 1+2 using variable substitution. You could reduce this to x+2 and remember the assignment x=1 on the side, but then your function would need to work on expression alongside with variable assignment Exp * Map<string, Exp> -> Exp * Map<string, Exp>. It is easier to use normal substitution, at least for the start.
So, I would first define subst x repl exp which substitutes all free occurences of x in the expression exp with repl:
let rec subst (n : string) (repl : Exp) (exp : Exp) =
match exp with
| Var x when x = n -> repl
| Cst _ | Var _ -> exp
| Abs(x, _) when x = n -> exp
| Abs(x, b) -> Abs(x, subst n repl b)
| App(e1, e2) -> App(subst n repl e1, subst n repl e2)
| Arith(op, e1, e2) -> Arith(op, subst n repl e1, subst n repl e2)
Now you can implement your step function.
let rec step (exp : Exp) =
match exp with
// Values - do nothing & return
| Cst _ | Abs _ -> exp
// There should be no variables, because we substituted them
| Var x -> failwith "Unbound variable"
// App #1 - e1 is function, e2 is a value, apply
| App(Abs(x, e1), (Cst _ | Abs _)) -> subst x e2 e1
// App #2 - e1 is not a value, reduce that first
| App(e1, e2) -> App(step e1, e2)
// App #3 - e1 is value, but e2 not, reduce that
| App(Abs(x,e1), e2) -> App(Abs(x,e1), step e2)
// Similar to App - if e1 or e2 is not value, reduce e1 then e2
| Arith(Plus, Cst a, Cst b) -> Cst (a + b)
| Arith(Plus, Cst a, e2) -> Arith(Plus, Cst a, step e2)
| Arith(Plus, a, b) -> Arith(Plus, step a, b)
Using your example:
App
(Abs
("x", App (Abs ("y", App (Var "y", Var "x")), Arith (Plus, Cst 21, Cst 21))),
Abs ("x", Arith (Plus, Var "x", Cst 1)))
|> step
|> step
|> step
|> step
I get:
App (Cst 42, Abs ("x", Arith (Plus, Var "x", Cst 1)))
And if I'm correctly making sense of your example, this is correct - because now you are trying to treat a number as a function, which gets stuck.

Find "short enough" paths in a given graph

I need to design an algorithm to find a path in a public transportation system. In theory only the best (lowest cost) path is required, but in reality it's different. When traveling in a public transportation system, it's difficult to define the cost, it cannot be simplified to traveling time, waiting time, transfer time, bus/subway fees etc, are all need to take into consideration.
Firstly I need to simplify the problem, design a cost function which is a combination of all those "time" and "fee", then use a graph algorithm to find a few paths (3~5 paths). Finally present all these paths to the end users and let them make the decision.
The reason I need to present more than one path is that, for different users/situations these "time" and "fee" are different, thus presenting a few paths is better than just giving out the "best" path.
Algorithms like A* are good for finding the shortest path, but how can I find those "short enough" paths in a graph ? or how can I find the shortest N paths ?
BTW, I don't even need to find the shortest path, because in practice the end users never know the shortest path (unless the shortest path is obvious), they will be happy if the results are close to the shortest path.
A* star's "cost" is more versatile than you are thinking. A* is typically explained with nodes who's cost is simply a distance. We can, however, beef this up a little.
I'm not seeing a language you prefer, maybe Graph? Oh well, here's some c++:
namespace Astar
{
struct CostEvaluation
{
int distance_cost;
int transfer_cost;
// others
int costToTraverseNodes( const Node& first, const Node& second ) const
{
int distance = // apply distance_cost to distance between nodes
int transfer = // apply transfer_cost if there is a transfer between nodes
return distance + transfer;
}
}
}
Now, the actual implementation of your A* will take a CostEvaluation object to determine the cost on the route. If transfers don't matter, set the transfer_cost to zero.
As far as a "good enough" route: I'm sure other people would be able to help you better, but I feel like you might run into a situation where the program says something like "oh, you want to be there in an hour, but the best route only takes twenty minutes? Here, go around in circles for forty minutes, that's good enough".
As I hinted in my comments, it is possible to create a modified A* version which reports multiple routes. I just drove my implementation to the point where it is obviously confirming this statement.
The code below starts with a "classic" A* implementation, which I keep around so one can study the differences between "classic" and "modified".
The basic idea for the modified version is to start the search both forwards and backwards in parallel. This often also yields more robust results, given that the "greediness" of A* is largely driven by its heuristic function (h(x)). It is possible to construct cases, where the greediness opts for fast progress at the start of the route, while that route towards the end "slows down" drastically. Starting from both sides (source, target), this effect can be mitigated to bits. (If one calculates to the end, it should always be optimal routes, if not necessarily the same route. If one were to calculate to the "classic" ending condition in both directions a picture as the one below could result, showing that the both directions yield 2 different paths.
Now, the "explored lists" of both directions can be used to find out when while searching e.g. "forwards", the next node is already explored by the "backwards" search - or vice versa. Obviously, those "connection points" between the two searches yield a route, which is not necessarily optimal but - a valid route.
My implementation traces those intermediate routes and I did not bother to collect them. The traces show the id of the node where both exploration lists "meet" and the resulting 2 parts of the route (source -> meeting point, meeting point -> destination).
Now, using those intermediate lists along with some post processing, e.g. by means of evaluating the routes according to single dimensions of the heuristics function (e.g. comfort, speed, ...), it should be possible to find a good enough selection of routes, associated with different trade-offs in those dimensions.
The full F# script is around 340 lines - a bit too long for this site, so I will omit some nonessential parts (such as my rendering function, creating those bitmaps, etc.
module AStar =
module Internals =
let makeRoute (explo : Map<int,(int * float)>) at tgt =
let rec loop at acc =
let dst,c = explo.[at]
match at,dst with
| (_,b) when b = tgt -> (at,c) :: acc
| (_,b) -> loop b ((at,c) :: acc)
[(tgt,0.0)] # loop at []
let makeRouteBackward (exploBW : Map<int, (int * float)>) at tgt =
let rec loop at acc =
let src,c = exploBW.[at]
match at,src with
| (_,b) when b = tgt -> acc # [(at,c)]
| (_,b) -> loop b (acc # [at,c])
let r = loop at [] # [(tgt,0.0)]
let rev = List.rev r
List.zip r rev |> List.map (fun ((id1,c1),(id2,c2)) -> id1,c2)
let classic neighbors h cost start goal =
let prioSelect (lopen : (int * float) list) =
let sorted = List.sortBy (fun (id,p) -> p) lopen //|> List.rev
(fst (List.head sorted), List.tail sorted)
let rec search (lopen : (int * float) list) (routes : Map<int,int * float>) =
let rec searchNeighbors cur nl o (r : Map<int,(int * float)>) =
match nl with
| [] -> o,r
| next::others ->
let newCost = (snd (r.[cur])) + cost cur next
if (not (Map.containsKey next r)) || (newCost < snd r.[next])
then
let r1 = r |> Map.remove next |> Map.add next (cur,newCost)
let prio = newCost + h next goal
//printfn "current = %d -- next = %d -- newCost = %f -- prio = %f -- h = %f" cur next newCost prio (h next goal)
let o1 = (next,prio) :: o
searchNeighbors cur others o1 r1
else
searchNeighbors cur others o r
match lopen with
| [] -> []
| _::_ ->
let current,rest = prioSelect lopen
if current = goal then Internals.makeRoute routes current start
else
let lopen1,routes1 = searchNeighbors current (neighbors current) rest routes
search lopen1 routes1
search [start,0.] (Map.ofList [start,(start,0.0)])
let twoWay sources targets hforward hbackward costforward costbackward (start : int) (goal : int) (n : int) rr =
let prioSelect (lopen : (int * float) list) =
let sorted = List.sortBy (fun (id,p) -> p) lopen //|> List.rev
(fst (List.head sorted), List.tail sorted)
let searchforward lopen exploredF exploredB nfound acc =
let rec searchNeighbors cur nl o (r : Map<int,(int * float)>) =
match nl with
| [] -> o,r
| next::others ->
//printfn "fwd: current = %d -- next = %d -- nl = %A -- r = %A" cur next nl r
let newCost = (snd (r.[cur])) + costforward cur next
if (not (Map.containsKey next r)) || (newCost < snd r.[next])
then
let r1 = r |> Map.remove next |> Map.add next (cur,newCost)
let prio = newCost + hforward next goal
let o1 = (next,prio) :: o
if Map.containsKey next exploredB then
rr (next, Internals.makeRoute r1 next start, Internals.makeRouteBackward exploredB next goal)
searchNeighbors cur others o1 r1
else
searchNeighbors cur others o r
match lopen with
| [] -> (lopen,exploredF,0,acc)
| _::_ ->
let current,rest = prioSelect lopen
if current = goal then
(rest,exploredF,nfound+1,acc # [Internals.makeRoute exploredF current start] )
else
let lopen1,explored1 = searchNeighbors current (targets current) rest exploredF
(lopen1, explored1, nfound, acc)
let searchbackward lopen exploredB exploredF nfound acc =
let rec searchNeighbors cur nl o (r : Map<int,(int * float)>) =
match nl with
| [] -> o,r
| next::others ->
//printfn "bwd: current = %d -- next = %d -- nl = %A -- r = %A" cur next nl r
let newCost = (snd (r.[cur])) + costbackward cur next
if (not (Map.containsKey next r)) || (newCost < snd r.[next])
then
let r1 = r |> Map.remove next |> Map.add next (cur,newCost)
let prio = newCost + hbackward next start
let o1 = (next,prio) :: o
searchNeighbors cur others o1 r1
else
searchNeighbors cur others o r
match lopen with
| [] -> (lopen,exploredB,0,acc)
| _::_ ->
let current,rest = prioSelect lopen
if current = start then
//(rest,explored,nfound+1,acc # [Internals.makeRoute explored current goal []])
(rest,exploredB,nfound+1,acc # [Internals.makeRouteBackward exploredB current goal] )
else
let lopen1,explored1 = searchNeighbors current (sources current) rest exploredB
(lopen1, explored1, nfound, acc)
let rec driver openF openB exploredF exploredB nfoundF nfoundB accF accB =
let openF1, exploredF1,nfoundF1,accF1 = searchforward openF exploredF exploredB nfoundF accF
let openB1, exploredB1,nfoundB1,accB1 = searchbackward openB exploredB exploredF nfoundB accB
match (nfoundF1+nfoundB1), List.isEmpty openF1, List.isEmpty openB1 with
| (s,false,false) when s < n ->
driver openF1 openB1 exploredF1 exploredB1 nfoundF1 nfoundB1 accF1 accB1
| _ ->
accF1 # accB1
driver [start,0.0] [goal,0.0] (Map.ofList [start,(start,0.0)]) (Map.ofList [goal,(goal,0.0)]) 0 0 [] []
// Location : x,y coordinate or lat/long - whatever.
// Edges: (id,cost) list
type Node = { Id : int; Location : int * int; Edges : (int * float) list; EdgesBackward : (int * float) list}
type Graph = Map<int,Node>
let addNode node graph =
Map.add (node.Id) node graph
let newNode idgen x y =
{ Id = idgen(); Location = (x,y); Edges = []; EdgesBackward = [] }
let addEdge id cost node =
{ node with Node.Edges = node.Edges # [(id,cost)]; }
let addEdgeBackward id cost node =
{ node with Node.EdgesBackward = node.EdgesBackward # [(id,cost)]; }
let idgen startvalue =
let next = ref startvalue
fun () ->
let id = !next
next := !next + 1
id
let appendNode node nodeList = nodeList # [node]
let sq x = x*x
let distance p1 p2 =
let x1,y1 = p1
let x2,y2 = p2
sqrt( float (sq (x2-x1) + sq (y2-y1)) )
let solve (g : Graph) s e =
let ns id =
g.[id].Edges |> List.map (fun (id,c) -> id)
let h at goal =
float (distance (g.[at].Location) (g.[goal].Location))
let c a b =
g.[a].Edges |> List.pick (fun (id,cost) -> if id = b then Some(cost) else None)
[AStar.classic ns h c s e] // give it the same return type as solveTwoWay to make stuff below easier and shorter
let solveTwoWay (g : Graph) s e n =
let edges id =
let nl = g.[id].Edges |> List.map (fun (id,c) -> id)
//printfn "2way edges id = %d list = %A" id nl
nl
let edgesBackward id =
let nl = g.[id].EdgesBackward |> List.map (fun (id,c) -> id)
//printfn "2way backwards edges id = %d list = %A" id nl
nl
let hforward at goal =
float (distance (g.[at].Location) (g.[goal].Location))
let hbackward at start =
float (distance (g.[at].Location) (g.[start].Location))
let costF a b =
g.[a].Edges |> List.pick (fun (id,cost) -> if id = b then Some(cost) else None)
let costB a b =
g.[a].EdgesBackward |> List.pick (fun (id,cost) -> if id = b then Some(cost) else None)
let debugView arg =
let id,r1,r2 = arg
printfn "meeting at %d: r1 = %A r2 = %A" id r1 r2
AStar.twoWay edgesBackward edges hforward hbackward costF costB s e n debugView
let solveProblem problem =
let g, start, goal = problem
g,start,goal,solve g start goal
let solveProblemTwoWay problem n =
let g, start, goal = problem
g,start,goal,solveTwoWay g start goal n
let save name solution =
let graph, start, goal, routes = solution
use writer = System.IO.File.CreateText("""E:\temp\""" + name + """.txt""")
fprintf writer "------------------------------------\n start = %d ----> goal = %d: %d routes found.\n" start goal (List.length routes)
fprintf writer "Graph:\n"
graph |> Map.iter
(fun id node ->
fprintf writer "Node: %A\n" node
)
routes |> List.iteri
(fun index route ->
fprintf writer "Route %d: %A\n" index route
)
// An example problem I used to play with:
// The graph is such, that the nodes are connected to the right and
// downwards and diagonally downwards only.
// The cost is either 1.0 or sqrt(2), for the horizontal or vertical and
// the diagonal connection, respectively.
let problem2 () =
let newNodeAN = newNode (idgen 0)
let cond c x n =
if c then n |> x else n
let accessCost p =
match p with
| (4,4) | (4,5) | (5,4) | (5,5) -> 10.0
| _ -> 1.0
let right (n : Node) : Node =
let t = 1 + fst n.Location, snd n.Location
let c = accessCost t
n
|> cond (fst n.Location < 9) (fun n -> addEdge (n.Id + 1) c n)
|> cond (fst n.Location > 0) (fun n -> addEdgeBackward (n.Id - 1) c n)
let down n =
let t = fst n.Location, 1 + snd n.Location
let c = accessCost t
n
|> cond (snd n.Location < 9) (fun n -> addEdge (n.Id + 10) c n)
|> cond (snd n.Location > 0) (fun n -> addEdgeBackward (n.Id - 10) c n)
let diagdown n =
let t = 1 + fst n.Location, 1 + snd n.Location
let c = (sqrt(2.0)) * accessCost t
n
|> cond (fst n.Location < 9 && snd n.Location < 9) (fun n -> addEdge (n.Id + 11) c n)
|> cond (fst n.Location > 0 && snd n.Location > 0) (fun n -> addEdgeBackward (n.Id - 11) c n)
[
for y = 0 to 9 do
for x = 0 to 9 do
yield newNodeAN x y
]
|> List.map
(fun n ->
n
|> right
|> down
|> diagdown
)
|> List.map (fun n -> (n.Id,n))
|> Map.ofList
, 0, 99
// Last not least, the code can be executed like this:
// And since both implementations yield the same data structures,
// they can be used interchangeably and compared to each other.
solveProblemTwoWay (problem2() 5) |> save "problem2_solution"
The output printed during runtime which shows the "intermediate routes", then looks like this:
...
meeting at 48:
r1 = [(0, 0.0); (11, 1.414213562); (12, 2.414213562); (23, 3.828427125);
(34, 5.242640687); (35, 6.242640687); (46, 7.656854249); (47, 8.656854249);
(48, 9.656854249)]
r2 = [(48, 0.0); (58, 1.414213562); (68, 2.414213562); (78, 3.414213562);
(88, 4.414213562); (99, 5.414213562)]
meeting at 84:
r1 = [(0, 0.0); (11, 1.414213562); (21, 2.414213562); (32, 3.828427125);
(43, 5.242640687); (53, 6.242640687); (64, 7.656854249); (74, 8.656854249);
(84, 9.656854249)]
r2 = [(84, 0.0); (85, 1.414213562); (86, 2.414213562); (87, 3.414213562);
(88, 4.414213562); (99, 5.414213562)]
meeting at 95:
r1 = [(0, 0.0); (11, 1.414213562); (21, 2.414213562); (32, 3.828427125);
(43, 5.242640687); (53, 6.242640687); (64, 7.656854249); (75, 9.071067812);
(85, 10.07106781); (95, 11.07106781)]
r2 = [(95, 0.0); (96, 1.0); (97, 2.0); (98, 3.0); (99, 4.0)]
...

logical calculation of Integer interval

what are the rules to calculate logical op. (AND OR XOR) of two integer intervals ?
Given two intervals [a,b] [c,d] i want to calculate [a,b] xor [c,d]
I assume the result to be multiple ranges
I looked at filib++ and read WIKI but found just Arithmetic op. support
Can anyone educate me
You can find an implementation of “bitwise and”, “bitwise xor” and “bitwise or” between intervals in the latest version of Frama-C, in file src/ai/ival.ml. In fact these functions operate on values of type Ival.t, which represent either a small set of integer values, an interval with congruence information or a floating-point interval. You will only be interested in the case Top _, Top _ (which corresponds to the integer intervals with congruence information). The function compute the result as an Ival.t, possibly over-approximated, but which contains all the values x op y with x in the first interval and y in the second interval.
As the comment says, the algorithm for pos_max_land is optimal for precision but does not have the best complexity with respect to the number of bits of the integers. I only understood this after I was finished with writing the function, and the width of an integer does not go beyond 64 for this usecase, so I didn't bother writing the faster version.
The file src/ai/ival.ml is licensed under the LGPL 2.1. If you do something cool with it, I would be happy to hear about it.
(* [different_bits min max] returns an overapproximation of the mask
of the bits that can be different for different numbers
in the interval [min]..[max] *)
let different_bits min max =
let x = Int.logxor min max in
next_pred_power_of_two x
(* [pos_max_land min1 max1 min2 max2] computes an upper bound for
[x1 land x2] where [x1] is in [min1]..[max1] and [x2] is in [min2]..[max2].
Precondition : [min1], [max1], [min2], [max2] must all have the
same sign.
Note: the algorithm below is optimal for the problem as stated.
It is possible to compute this optimal solution faster but it does not
seem worth the time necessary to think about it as long as integers
are at most 64-bit. *)
let pos_max_land min1 max1 min2 max2 =
let x1 = different_bits min1 max1 in
let x2 = different_bits min2 max2 in
(* Format.printf "pos_max_land %a %a -> %a | %a %a -> %a#."
Int.pretty min1 Int.pretty max1 Int.pretty x1
Int.pretty min2 Int.pretty max2 Int.pretty x2; *)
let fold_maxs max1 p f acc =
let rec aux p acc =
let p = Int.shift_right p Int.one in
if Int.is_zero p
then f max1 acc
else if Int.is_zero (Int.logand p max1)
then aux p acc
else
let c = Int.logor (Int.sub max1 p) (Int.pred p) in
aux p (f c acc)
in aux p acc
in
let sx1 = Int.succ x1 in
let n1 = fold_maxs max1 sx1 (fun _ y -> succ y) 0 in
let maxs1 = Array.make n1 sx1 in
let _ = fold_maxs max1 sx1 (fun x i -> Array.set maxs1 i x; succ i) 0 in
fold_maxs max2 (Int.succ x2)
(fun max2 acc ->
Array.fold_left
(fun acc max1 -> Int.max (Int.logand max1 max2) acc)
acc
maxs1)
(Int.logand max1 max2)
let bitwise_or v1 v2 =
if is_bottom v1 || is_bottom v2
then bottom
else
match v1, v2 with
Float _, _ | _, Float _ -> top
| Set s1, Set s2 ->
apply2_v Int.logor s1 s2
| Set s, v | v, Set s when Array.length s = 1 && Int.is_zero s.(0) -> v
| Top _, _ | _, Top _ ->
( match min_and_max v1 with
Some mn1, Some mx1 when Int.ge mn1 Int.zero ->
( match min_and_max v2 with
Some mn2, Some mx2 when Int.ge mn2 Int.zero ->
let new_max = next_pred_power_of_two (Int.logor mx1 mx2) in
let new_min = Int.max mn1 mn2 in (* Or can only add bits *)
inject_range (Some new_min) (Some new_max)
| _ -> top )
| _ -> top )
let bitwise_xor v1 v2 =
if is_bottom v1 || is_bottom v2
then bottom
else
match v1, v2 with
| Float _, _ | _, Float _ -> top
| Set s1, Set s2 -> apply2_v Int.logxor s1 s2
| Top _, _ | _, Top _ ->
(match min_and_max v1 with
| Some mn1, Some mx1 when Int.ge mn1 Int.zero ->
(match min_and_max v2 with
| Some mn2, Some mx2 when Int.ge mn2 Int.zero ->
let new_max = next_pred_power_of_two (Int.logor mx1 mx2) in
let new_min = Int.zero in
inject_range (Some new_min) (Some new_max)
| _ -> top )
| _ -> top )

Manipulate unmutable variables inside of loop in OCaml

I have the following code in OCaml.I have defined all necesar functions and tested them step by step the evalution should work good but I didn't succed to manipulate the variables inside of while.How can I make x,vn,v to change their value?I think I should rewrite the while like a rec loop but can't figure out exactly:
Here is the rest of code: http://pastebin.com/Ash3xw6y
Pseudocode:
input : f formula
output: yes if f valid
else not
begin:
V =set of prop variables
eliminate from f => and <=>
while (V is not empty)
choose x from V
V =V -{x}
replace f with f[x->true]&&f[x->false]
simplify as much as possible f
if f is evaluated with true then return true
else if (not f) is evaluated true then return false
end if
end while
return false
end
type bexp = V of
| string
| B of bool
| Neg of bexp
| And of bexp * bexp
| Or of bexp * bexp
| Impl of bexp * bexp
| Eqv of bexp * bexp
module StringSet=Set.make(String)
let is_valide f=
let v= stringset_of_list (ens f []) in (*set of all variables of f *)
let g= elim f in (*eliminate => and <=> *)
let quit_loop=ref false in
while not !quit_loop
do
let x=StringSet.choose v in
let vn=StringSet.remove x v in
if StringSet.is_empty vn=true then quit_loop:=true;
let h= And( replace x (B true) g ,replace x (B false) g)in
let j=simplify h in
if (only_bools j) then
if (eval j) then print_string "yes"
else print_string "not"
done
(New form)
let tautology f =
let rec tautology1 x v g =
let h= And( remplace x (B true) g ,remplace x (B false) g)in
let j= simplify h in
if not (only_bools j) then tautology (StringSet.choose (StringSet.remove x v) (StringSet.remove x v) j
else
if (eval1 j) then print_string "yes \n " else
if (eval1 (Neg (j))) then print_string "not \n";
in tautology1 (StringSet.choose (stringset_of_list (ens f [])) (stringset_of_list (ens f [])) (elim f);;
while loop belongs to imperative programming part in OCaml.
Basically, you can't modify immutable variables in while or for loops or anywhere.
To let a variable to be mutable, you need to define it like let var = ref .... ref is the keyword for mutables.
Read these two chapters:
https://realworldocaml.org/v1/en/html/a-guided-tour.html#imperative-programming
https://realworldocaml.org/v1/en/html/imperative-programming-1.html
You can define x,vn,v as refs, but I guess it will be ugly.
I suggest you think your code in a functional way.
Since you haven't placed functions ens etc here, I can't produce an example refine for u.

Deriving type expression in ML

All,
I want to derive the type expression for the function below in ML:
fun f x y z = y (x z)
Now I know typing the same would generate the type expression. But I wish to derive these values by hand.
Also, please mention the general steps to follow when deriving type expressions.
I'm going to try to do this in the most mechanical way possible, exactly as the implementation in most compilers would.
Let's break it down:
fun f x y z = y (x z)
This is basically sugar for:
val f = fn x => fn y => fn z => y (x z)
Let's add some meta-syntactic type variables (these are not real SML-types, just place holders for this example's sake):
val f : TX = fn (x : T2) => fn (y : T3) => fn (z : T4) => y (x z) : T5
OK, so we can start generating a system of constraints from this. T5 is the eventual return type of f. For the moment, we're going to just call the eventual type of this whole function "TX" - some fresh, unknown type variable.
So the thing that is going to be generating constraints in the example you've given is function application. It tells us about the types of things in the expression. In fact, it's the only information we have!
So what do the applications tell us?
Ignoring the type variables we assigned above, let's just look at the body of the function:
y (x z)
z is not applied to anything, so we're going to just look up what the type variable we assigned to it was earlier (T4) and use that as its type.
x is applied to z, but we don't know its return type yet, so let's generate a fresh type variable for that and use the type we assigned x (T2) earlier to create a constraint:
T2 = T4 -> T7
y is applied to the result of (x z), which we just called T7. Once again, we don't know the return type of y yet, so we'll just give it a fresh variable:
T3 = T7 -> T8
We also know that the return type of y is the return type for the whole body of the function, we we called "T5" earlier, so we add the constraint:
T5 = T8
For compactness, I'm going to kludge this a little and add a constraint for TX based on the fact that there are functions being returned by functions. This is derivable by exactly the same method, except it's a little more complex. Hopefully you can do this yourself as an exercise if you're not convinced that we would eventually end up with this constraint:
TX = T2 -> T3 -> T4 -> T5
Now we collect all the constraints:
val f : TX = fn (x : T2) => fn (y : T3) => fn (z : T4) => y (x z) : T5
TX = T2 -> T3 -> T4 -> T5
T2 = T4 -> T7
T3 = T7 -> T8
T5 = T8
We start to solve this system of equations by substituting left hand sides with right hand sides in the system of constraints, as well as in the original expression, starting from the last constraint and working our way to the top.
val f : TX = fn (x : T2) => fn (y : T3) => fn (z : T4) => y (x z) : T8
TX = T2 -> T3 -> T4 -> T8
T2 = T4 -> T7
T3 = T7 -> T8
val f : TX = fn (x : T2) => fn (y : T7 -> T8) => fn (z : T4) => y (x z) : T8
TX = T2 -> (T7 -> T8) -> T4 -> T8
T2 = T4 -> T7
val f : TX = fn (x : T4 -> T7) => fn (y : T7 -> T8) => fn (z : T4) => y (x z) : T8
TX = (T4 -> T7) -> (T7 -> T8) -> T4 -> T8
val f : (T4 -> T7) -> (T7 -> T8) -> T4 -> T8 = fn (x : T4 -> T7) => fn (y : T7 -> T8) => fn (z : T4) => y (x z) : T8
OK, so this looks horrible at the moment. We don't really need the whole body of the expression sitting around at the moment - it was just there to provide some clarity in the explanation. Basically in the symbol table we would have something like this:
val f : (T4 -> T7) -> (T7 -> T8) -> T4 -> T8
The last step is to generalise all the type variables that are left over into the more familiar polymorphic types that we know and love. Basically this is just a pass, replacing the first unbound type variable with 'a, the second with 'b and so on.
val f : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
Which I'm pretty sure you'll find is the type that your SML compiler will suggest for that term too. I did this by hand and from memory, so apologies if I've botched something somewhere :p
I found it difficult to find a good explanation of this inference and type constraint process. I used two books to learn it - 'Modern Compiler Implementation in ML' by Andrew Appel, and 'Types and Programming Languages' by Pierce. Neither one was independently completely illuminating for me, but between the two of them I figured it out.
To determine the type of something you need to look at every place where it is used. For example if you see val h = hd l, you know that l is a list (because hd takes a list as an argument) and you also know that the type of h is the type that l is a list of. So let's say the type of h is a and the type of l is a list (where a is a placeholder). Now if you see val h2 = h*2, you know that h and h2 are ints, because 2 is an int, you can multiply an int with another int and the result of multiplying two ints is an int. Since we previously said the type of h is a this means that a is int, so the type of l is int list.
So let's tackle your function:
Let's consider the expressions in the order in which they are evaluated: First you do x z, i.e. you apply x to z. That means x is a function, so it has the type a -> b. Since z is given as an argument to the function it has to have the type a. The type of x z is therefor b because that is the result type of x.
Now y is called with the result of x z. This means y is also a function and its argument type is the result type of x, which is b. So y has the type b -> c. Again the type of the expression y (x z) is therefor c because that is the result type of y.
Since those are all the expressions in the function, we cannot restrict the types any further and therefor the most general types for x, y and z are 'a -> 'b, 'b -> 'c and 'a respectively and the type of the whole expression is 'c.
This means the overall type of f is ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
For an explanation of how types are inferred programatically read about Hindley–Milner type inference.
Another way to explain type inference is that every (sub)-expression and every (sub)-pattern are assigned a type variable.
Then, each construct in the program has an equation relating those type variables that are relevant to that construct.
E.g., if the program contains f x
and 'a1 is the type variable for the f, and 'a2 the type variable for the x, and 'a3 is the type variable for "f x",
then the application results in the type equation:
'a1 = 'a2 -> 'a3
Then, type inference basically involves solving the set of type equations for a declaration. For ML this is done just by using unification, and it's pretty easy to do by hand.

Resources