From 9f088752bd24e03ee32872c9842cd9d335ad83b7 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Thu, 11 Sep 2025 17:26:30 +0200 Subject: [PATCH 01/20] Symbolic evaluator: Description and ideas for the thesis + solution for the k step problem --- src/Symbolic/Assignments.v | 617 +++++++++++++++++++++++++++++++++++++ 1 file changed, 617 insertions(+) create mode 100644 src/Symbolic/Assignments.v diff --git a/src/Symbolic/Assignments.v b/src/Symbolic/Assignments.v new file mode 100644 index 00000000..b26615f4 --- /dev/null +++ b/src/Symbolic/Assignments.v @@ -0,0 +1,617 @@ +(* From CoreErlang.BigStep Require Import FunctionalBigStep. *) +From CoreErlang.FrameStack Require SubstSemantics SubstSemanticsLemmas. + +Open Scope string_scope. + +Module FrameStack. + +Import FrameStack.SubstSemantics. + +Import ListNotations. +(* + Let "e" be a parameter expression. + + letrec 'fact'/1 = + fun(X) -> + case X of + <0> -> 1 + -> let = apply 'fact'/1(call 'erlang':'-'(Z, 1)) + in call 'erlang':'*'(Z,Y); + in + apply 'fact'/1(e) + + Define the above expression! + *) + +Definition fact_frameStack (e : Exp) : Exp := + ELetRec + [(1, °ECase (˝VVar 1) [ + ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); + ([PVar], ˝ttrue, + °ELet 1 (EApp (˝VFunId (1, 1)) + [°ECall (˝VLit "erlang") (˝VLit "-") [˝VVar 0; ˝VLit 1%Z]]) + (°ECall (˝VLit "erlang") (˝VLit "*") [˝VVar 1; ˝VVar 0]) + ) + ])] + (EApp (˝VFunId (0, 1)) [e]) + (* Write the definition here *) +. + + +(* Hint: to solve statements about scopes (e.g., VALCLOSED), use "scope_solver"! + Also using "(e)constructor" could help you determine which rule of the semantics + can be used. Beware, not all semantic rules are syntax-driven, there are rules + about ECase expressions that can applied to the same configuration. + + Since you prove the evaluation of a factorial function, thus expect repetition + of proof steps in the script you write. This proof should not be short (>120 LOC), + if you write out each step. + + Tactics you should use: apply, (e)constructor, simpl, relfexivity, auto, congruence + *) +(* Prove the following theorem *) +Theorem fact_eval_3 : + ⟨[], fact_frameStack (˝VLit 3%Z)⟩ -->* RValSeq [VLit 6%Z]. +Proof. + +Admitted. + +From CoreErlang.Interpreter Require Import StepFunctions Equivalences. + +Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (k : nat) : option (FrameStack * Redex) := + match k with + | 0 => Some (fs, r) + | S k' => match sequentialStepFunc fs r with + | Some (fs', r') => sequentialStepMaxK fs' r' k' + | None => match fs, r with + | [], RValSeq _ => Some (fs, r) + | _, _ => None + end + end + end. + +Arguments sequentialStepFunc !_ !_ /. +Arguments sequentialStepMaxK !_ !_ !_ /. + +Fixpoint sequentialStepMaxK' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := + match p with + | xH => + match sequentialStepFunc fs r with + | Some (fs', r') => Some (fs', r') + | None => + match fs, r with + | [], RValSeq _ => Some (fs, r) + | _, _ => None + end + end + | xO p' => + let res := sequentialStepMaxK' fs r p' in + match res with + | Some (fs', r') => sequentialStepMaxK' fs' r' p' + | None => None + end + | xI p' => + let res := sequentialStepMaxK' fs r p' in + match res with + | Some (fs', r') => + let res' := sequentialStepMaxK' fs' r' p' in + match res' with + | Some (fs'', r'') => + match sequentialStepFunc fs'' r'' with + | Some (fs''', r''') => Some (fs''', r''') + | None => + match fs'', r'' with + | [], RValSeq _ => Some (fs'', r'') + | _, _ => None + end + end + | None => None + end + | None => None + end + end. + +Fixpoint sequentialStepMaxK'' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := + match fs, r with + | [], RValSeq _ => Some (fs, r) + | _, _ => + match p with + | xH => sequentialStepFunc fs r + | xO p' => + match sequentialStepMaxK'' fs r p' with + | Some (fs', r') => sequentialStepMaxK'' fs' r' p' + | None => None + end + | xI p' => + match sequentialStepFunc fs r with + | Some (fs', r') => + match sequentialStepMaxK'' fs' r' p' with + | Some (fs'', r'') => sequentialStepMaxK'' fs'' r'' p' + | None => None + end + | None => None + end + end + end. + +Arguments sequentialStepMaxK' !_ !_ !_ /. +Arguments sequentialStepMaxK'' !_ !_ !_ /. + +(* +Theorem kSeqStepEquiv: forall fs fs' e e' k, FSCLOSED fs -> REDCLOSED e -> + ⟨ fs, e ⟩ -[ k ]-> ⟨ fs', e' ⟩ <-> sequentialStepMaxK fs e k = Some (fs', e'). +Proof. + intros. split; intro. + * induction H1. + + simpl. reflexivity. + + simpl. destruct (sequentialStepFunc fs e) eqn:Hssf. + - destruct p. apply sequentialStepEquiv in Hssf;[|auto]. + pose proof (@step_determinism e e' fs fs' H1 f r Hssf). + destruct H3. subst. clear H1. + destruct (step_closedness fs e fs' e' Hssf H H0). + apply (IHstep_rt H1 H3). + - apply (sequentialStepEquiv fs fs' e e' H0) in H1. congruence. + * revert H1 H H0. revert fs fs' e e'. induction k; intros. + + simpl in H1. inv H1. constructor. + + simpl in H1. destruct (sequentialStepFunc fs e) eqn:Hssf. + - destruct p. + apply sequentialStepEquiv in Hssf;[|auto]. + destruct (step_closedness fs e f r Hssf H H0). + specialize (IHk f fs' r e' H1 H2 H3). + apply step_trans with (fs' := f) (e' := r); auto. + - discriminate. +Qed.*) + +Ltac case_innermost_term t := + lazymatch t with + | context[match ?x with _ => _ end] => + first [ case_innermost_term x + | destruct x eqn:?H ] + | _ => fail "No match subterm found" + end. + +Ltac case_innermost := + match goal with + | |- ?g => case_innermost_term g + end. + +(*Ltac case_innermost' := + match goal with + | [ H: context[match ?x with _ => _ end] |- _ ] => + destruct x eqn:?Hx in H; inv Hx; try case_innermost + | [ |- context[match ?x with _ => _ end] ] => + destruct x eqn:?Hx; inv Hx; try case_innermost + | _ => idtac + end.*) + +Ltac match_unwind t := + lazymatch t with + | context[match ?x with _ => _ end] => match_unwind x; idtac "hello"; simpl + | _ => simpl + end. + +Ltac unwind := + match goal with + | |- ?g => match_unwind g + end. + +(* Ltac hypothesize_matchstack_term t := + lazymatch t with + | context[match ?x with _ => _ end] => destruct x eqn:?Hx;hypothesize_matchstack_term Hx + | _ => idtac + end. + +Ltac hypothesize_matchstack := + match goal with + | |- ?g => hypothesize_matchstack_term g + end. *) + +Theorem fact_eval_example': + forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. unfold fact_frameStack. + all:simpl. all:try lia. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. +Qed. + + +Theorem fact_eval_example'': + forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. unfold fact_frameStack. + all:simpl. all:try lia. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. +Qed. + + +Fixpoint sequentialStepMaxK''' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := + match sequentialStepFunc fs r with + | None => + match fs, r with + | [], RValSeq _ => Some (fs, r) + | _, _ => None + end + | Some (fs', r') => + match p with + | xH => Some (fs', r') + | xO p' => + match sequentialStepMaxK''' fs r p' with + | Some (fs'', r'') => sequentialStepMaxK''' fs'' r'' p' + | None => None + end + | xI p' => + match sequentialStepMaxK''' fs' r' p' with + | Some (fs'', r'') => sequentialStepMaxK''' fs'' r'' p' + | None => None + end + end + end. + +Arguments sequentialStepMaxK''' !_ !_ !_ /. + +Theorem fact_eval_example''': + forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK''' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. unfold fact_frameStack. + all:simpl. all:try lia. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. +Qed. + + +(* symbolic execution plans TODO: + These plans come "outside in", starting with the big picture. + Although the actual implementation is likely to be "inside out". + + - Start out with an Erlang module file + - Add comments to it in a standard format, containing preconditions and postconditions about a function + - Preconditions should be about the input of the function (be mindful about arity) + - Postconditions should be about the output of the function (termination in RValSeq) + - Search depth: the "k" steps required for the execution. This should also be a parameter, since + Coq can not handle divergence. + - Utilize and change the pretty-printer, so it prints a theorem, where the function to be + tested is given the arguments specified in the precondition comments. The postcondition is given by the + value the program leads to and the condition after. The standard format should look like + fact_eval_example' above. + - with this approach, we don't need to develop as much metatheory. + - however, "k" steps is still an issue. even with the arguments + bang pattern thingy. It gets slower + as k increases. "simpl" still causes stack overflow for big enough values. + - Make a custom tactic that tries to solve the goal. Utilize smt solvers (this is when the lack of + metatheory is a big advantage). + - Possibly more than 1 SMT solvers should be utilized, with a heuristic? + - SMT solvers are utilized in 2 cases. Either finding out if the termination satisfies the goal + (end of config execution), or finding out that a configuration is impossible (moving along with + config execution). + - if termination does not satisfy a goal: FAIL: the message should provide the configuration of the + symbolic variables under which the fail (list of hypotheses). INVESTIGATE: can 'a' (or 'the') + concrete value be given for symbolic variables under the hypotheses? + - if termination satisfies the goal, but SMT solvers can not solve the goal: POTENTIAL FAIL: the + message should provide the hypotheses. Maybe the goal is actually solvable, just not by the SMT + solver. Unfortunately, because of the laws of the universe as we know it in 2025, not all goals + are trivially solvable by SMT solvers. It's probably impossible to tell this point and the + previous one apart (at least I think). + - if moving along with a configuration can not happen, and the SMT solver find that it can not happen: + HAPPINESS: goal should be solved automatically. + - if moving along with a configuration can not happen, and the SMT solver does not find out: + UNHAPPINESS, TRY MOVING ALONG: this stinks, but as I've stated not all goals are solvable by SMT + solvers. Maybe we get to configurations that can be solvable? Unfortunately I don't + think we can do induction automatically (if we can, I think it's a big big hassle). + - if moving along with the configuration can happen: HAPPINESS, TRY MOVING ALONG: this is a standard + case. Again, I do not think that we can differentiate between this point and the previous one. + - The output of the tactic should be a list of goals that could not be solved automatically. + - Have a way to try to prove everything without even opening the Coq file. So generate the file with the + new pretty printer from the Erlang source code, and have a 'running' file that tries compiling the + coq file. If the custom tactic can solve everything, inform the user. If it can not solve everything, + display the unsolved goals. The user should only have to open Coq for unsolved goals if absolutely + necessary. + + PROS for this approach: + - The tool should easily integrate with the Erlang code + - Writing preconditions and postconditions in a standardized way should make goal generation standard + - If goal generation is standard, metatheory in Coq should not be needed to be developed + - If metatheory is not needed, integrating SMT solvers should be more straightforward + CONS (or more precisely, THINGS TO SOLVE): + - developing the standard way of writing pre- and postconditions in the Erlang file is not + as easy as it first seems. Preconditions are the trickier part: Arity and symbolic variable order + might need to be defined by hand (since the precond is just a conjunction of conditions). + Postconditions need a special symbol for the value produced. This might also need to be hand defined. + - SMT solvers can not solve everything. We just have to live with this fact. + - The "k" step problem. A step count needs to be defined, or else the multi-step function is not + descending. Defining "k" with "nat"-s causes stack overflow, even with the tactics having + bang pattern arguments. "k" can not be existential, because that would mean that we need to be able + to calculate it beforehand (impossible). A good solution needs to be devised. I suspect choosing + "nat"-s for a step count also causes the proofs to be slow. + - running out of "k" steps should be explicitly stated somehow, somewhere. + - what about concurrency? I suspect that, since steps are not deterministic, a new way of doing + multiple steps in a row is required. Like with the pmap example, have a list of actions taken + along the way (at least I think that's how that works?). This would be very complicated, and honestly, + it might go beyond the scope of the thesis. Somebody in the future will have the unfortunate task + of figuring all that out. + - installing SMT solvers might be a bit complex since the change from Coq to Rocq + - what about other data types? Integers are one thing, lists, strings and maps are a whole problem + in their own right. Especially because of bounds (if they are needed). + - Bounds: I don't think there is a general way to have unbounded expressions. Limiting the step count + to "k" should solve this issue somewhat. Programs without recursion should be fine, and for recursive + programs the step limit should suffice. + + PLANS for the thesis: + [x] investigate solutions for the "k" problem < + [ ] install SMT solvers (not trivial unfortunately). | do most of this before the trip to + Actually, just "lia" can be used until it's done. | Singapore, and before lab work + [ ] Have a few nice example programs | kicks into high gear + [ ] implement the solver tactic | + [ ] figure out the pretty printer part < + [ ] equivalence proofs + [ ] if I have time (hopefully): look into concurrency + [ ] write the text of the thesis + *) + +Theorem fact_eval_example: + forall (x y : Z), (x >= 0)%Z /\ (x < 3)%Z -> ⟨[], fact_frameStack (˝VLit x)⟩ -->* RValSeq [VLit y] -> (x <= y)%Z. +Proof. + intros. unfold step_any in H0. destruct H0. destruct H0. unfold fact_frameStack in H1. + inv H1; apply sequentialStepEquiv in H2;[|scope_solver]; simpl in H2; inv H2. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + destruct x eqn:Hx; inv H4. + * inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3. Search "<="%Z 0. apply Z2Nat.neq_0_nonneg. auto. inv H1. + * inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. + destruct (if (Z.pos p - 1 =? 0)%Z then Some [] else None) eqn:Hp. + + inv H4. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. + inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. + inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. + inv H3. inv H1. inv H17. inv H2. + - Search "*"%Z. rewrite Z.mul_1_r. apply Z.le_refl. + - inv H1. + + inv H4. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. + inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. + inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. + inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. + inv H1. inv H2. admit. + * lia. (* H is impossible *) +Admitted. + +(* Define the following function in Core Erlang! To compile a Core Erlang file + use the "from_core" option of the standard compiler/interpreter. + For examples, we refer to the language specification: + https://www.it.uu.se/research/group/hipe/cerl/doc/core_erlang-1.0.3.pdf + You can also check example codes in the Erl_codes folder. + Instead of the letrec expression, define it as a top level function *) +Definition collatz (e : Exp) : Exp := + ELetRec [ + (1, °ECase (˝VVar 1) + [ + ([PLit 1%Z], ˝ttrue, ˝VNil); + ([PVar], + °ECall (˝erlang) (˝VLit "and") [ + °ECall (˝erlang) (˝VLit "<") [˝VLit 0%Z; ˝VVar 0]; + °ECall (˝erlang) (˝VLit "=") [ + ˝VLit 0%Z; + °ECall (˝erlang) (˝VLit "rem") [˝VVar 0; ˝VLit 2%Z] + ] + ], + °ECons (˝VVar 0) (EApp (˝VFunId (1,1)) [ + °ECall (˝erlang) (˝VLit "div") [˝VVar 0; ˝VLit 2%Z] + ]) + ); + ([PVar], °ECall (˝erlang) (˝VLit "<") [˝VLit 0%Z; ˝VVar 0], + °ECons (˝VVar 0) (EApp (˝VFunId (1,1)) [ + °ECall (˝erlang) (˝VLit "+") + [°ECall (˝erlang) (˝VLit "*") [˝VLit 3%Z; ˝VVar 0]; + ˝VLit 1%Z] + ]) + ) + ]) + ] + (EApp (˝VFunId (0, 1)) [e]). + +(* + module 'exercise' ['fun_func'/1, + 'module_info'/0, + 'module_info'/1] + attributes [] + 'collatz'/1 = + (fun (_0) -> + (case <_0> of + <1> when 'true' -> [] + when + call 'erlang':'and'( + call 'erlang':'<'(0, _0), + call 'erlang':'=='(0, call 'erlang':'rem'(_0, 2)) + ) -> + [X|apply 'collatz'/1(call 'erlang':'div'(X,2))] + when + call 'erlang':'<'(0, _0) -> + [X|apply 'collatz'/1(call 'erlang':'+' + (call 'erlang':'*'(3, X), 1))] + end + -| [{'function',{'fun_func',1}}] ) + -| [{'function',{'fun_func',1}}] ) + +%% Needed by erlc + + 'module_info'/0 = + ( fun () -> + call 'erlang':'get_module_info' + ('exercise') + -| [{'function',{'module_info',0}}] ) + 'module_info'/1 = + ( fun (_0) -> + call 'erlang':'get_module_info' + ('exercise', ( _0 + -| [{'function',{'module_info',1}}] )) + -| [{'function',{'module_info',1}}] ) +end +*) + +(* Erlang def + + collatz(1) -> []; + collatz(X) when ((0 == (X rem 2)) band (0 < X)) -> + [X | collatz(X div 2)]; + collatz(X) when 0 < X -> + [X | collatz(3 * X + 1)]. + +*) + + +(* + Hard task: + Prove the following theorem about the correctness of fact! + + Use induction over n! Follow the scheme described in fact_eval_3. Check what + theorems are available about transitive evaluation. +*) + +Ltac do_step := econstructor; [constructor;auto|simpl]. + +Theorem fact_eval : forall n, + ⟨[], fact_frameStack (˝VLit (Z.of_nat n))⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. +Proof. + (* + induction n; intros. + - unfold step_any. eexists. split. + + apply valseq_is_result. apply Forall_cons. + scope_solver. + apply Forall_nil. + + do 3 do_step. scope_solver. + do 2 do_step. discriminate. + do 1 do_step. scope_solver. + econstructor. eapply eval_cool_params. reflexivity. simpl. + do 2 do_step. scope_solver. + econstructor. apply eval_step_case_match. reflexivity. simpl. + econstructor. apply cool_value. scope_solver. + econstructor. apply eval_step_case_true. + econstructor. apply cool_value. scope_solver. + econstructor. + + - unfold step_any. + inv IHn. inv H. unfold fact_frameStack in H1. + inv H1. inv H. simpl in H2. inv H2. inv H. inv H1. inv H. + inv H2. inv H. inv H1. inv H. clear H10 H4 H0. inv H2. inv H. + inv H0. inv H. simpl in H8. inv H8. cbn in H1. + + eexists. split. + + + apply valseq_is_result. apply Forall_cons. + scope_solver. + apply Forall_nil. + + do 3 do_step. scope_solver. + do 2 do_step. discriminate. + econstructor. apply cool_value. scope_solver. + econstructor. eapply eval_cool_params. reflexivity. simpl. + + do 2 do_step. scope_solver. + econstructor. apply eval_step_case_not_match. reflexivity. + econstructor. apply eval_step_case_match. reflexivity. simpl. (* Ask about it *) + econstructor. apply cool_value. scope_solver. + do 4 do_step. scope_solver. + do 2 do_step. discriminate. + do 2 do_step. scope_solver. + do 2 do_step. scope_solver. + do 2 do_step. discriminate. + econstructor. apply cool_value. scope_solver. + do 2 do_step. scope_solver. + econstructor. eapply eval_cool_params. reflexivity. + Search Pos.of_succ_nat Z.of_nat. rewrite Znat.Zpos_P_of_succ_nat. simpl. + econstructor. eapply eval_cool_params. reflexivity. simpl. + + replace (Z.succ (Z.of_nat n) - 1)%Z with (Z.of_nat n)%Z by lia. + eapply FrameStack.SubstSemanticsLemmas.transitive_eval. + + ++ eapply (FrameStack.SubstSemanticsLemmas.frame_indep_nil _ _ _ _ H1). + + ++ clear H1 H3. do 7 do_step. congruence. + do 3 do_step. econstructor. econstructor. econstructor. simpl. + unfold eval_arith. simpl. + rewrite Znat.Nat2Z.inj_add. rewrite Z.add_comm. + rewrite <- Znat.Nat2Z.inj_succ. + rewrite Znat.Nat2Z.inj_mul. + replace ((Z.of_nat n) * (Z.of_nat (Factorial.fact n)))%Z with ((Z.of_nat (Factorial.fact n)) * Z.of_nat n)%Z by lia. + Search Zmult. rewrite Zmult_succ_r_reverse. rewrite Z.mul_comm. rewrite <- Znat.Nat2Z.inj_succ. econstructor. + *) +Admitted. + + +End FrameStack. + +Module BigStep. + + + +End BigStep. + + + From 1ff137458c229a898ea63f3476132b04fd665526 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Tue, 28 Oct 2025 08:41:26 +0100 Subject: [PATCH 02/20] Tests for doing symbolic evaluation in Coq --- src/Symbolic/Assignments.v | 336 ++++++++++++++++++++++++++----------- 1 file changed, 238 insertions(+), 98 deletions(-) diff --git a/src/Symbolic/Assignments.v b/src/Symbolic/Assignments.v index b26615f4..b341cd4c 100644 --- a/src/Symbolic/Assignments.v +++ b/src/Symbolic/Assignments.v @@ -58,6 +58,57 @@ Admitted. From CoreErlang.Interpreter Require Import StepFunctions Equivalences. +Ltac case_innermost_term t := + lazymatch t with + | context[match ?x with _ => _ end] => + first [ case_innermost_term x + | destruct x eqn:?H ] + | _ => fail "No match subterm found" + end. + +Ltac case_innermost := + match goal with + | |- ?g => case_innermost_term g + end. + +Fixpoint sequentialStepMaxK0 (fs : FrameStack) (r : Redex) (k : nat) : option (FrameStack * Redex) := + match fs, r with + | [], RValSeq _ => Some (fs, r) + | _, _ => + match k with + | 0 => Some (fs, r) + | S k' => match sequentialStepFunc fs r with + | Some (fs', r') => sequentialStepMaxK0 fs' r' k' + | None => None + end + end + end. + +Arguments sequentialStepFunc !_ !_ /. +Arguments sequentialStepMaxK0 !_ !_ !_ /. + +Theorem fact_eval_example0: + forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK0 [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. unfold fact_frameStack. + all:simpl. all:try lia. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. +Admitted. + Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (k : nat) : option (FrameStack * Redex) := match k with | 0 => Some (fs, r) @@ -70,9 +121,30 @@ Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (k : nat) : option (Fr end end. -Arguments sequentialStepFunc !_ !_ /. Arguments sequentialStepMaxK !_ !_ !_ /. +Theorem fact_eval_example: + forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. unfold fact_frameStack. + all:simpl. all:try lia. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. +Qed. + Fixpoint sequentialStepMaxK' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := match p with | xH => @@ -111,6 +183,32 @@ Fixpoint sequentialStepMaxK' (fs : FrameStack) (r : Redex) (p : positive) : opti end end. +Arguments sequentialStepMaxK' !_ !_ !_ /. +(* Arguments Z.leb : simpl never. *) +Opaque Z.leb. + +Theorem fact_eval_example': + forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. unfold fact_frameStack. + all:simpl. all:try lia. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|lia]. +Qed. + Fixpoint sequentialStepMaxK'' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := match fs, r with | [], RValSeq _ => Some (fs, r) @@ -134,103 +232,10 @@ Fixpoint sequentialStepMaxK'' (fs : FrameStack) (r : Redex) (p : positive) : opt end end. -Arguments sequentialStepMaxK' !_ !_ !_ /. Arguments sequentialStepMaxK'' !_ !_ !_ /. -(* -Theorem kSeqStepEquiv: forall fs fs' e e' k, FSCLOSED fs -> REDCLOSED e -> - ⟨ fs, e ⟩ -[ k ]-> ⟨ fs', e' ⟩ <-> sequentialStepMaxK fs e k = Some (fs', e'). -Proof. - intros. split; intro. - * induction H1. - + simpl. reflexivity. - + simpl. destruct (sequentialStepFunc fs e) eqn:Hssf. - - destruct p. apply sequentialStepEquiv in Hssf;[|auto]. - pose proof (@step_determinism e e' fs fs' H1 f r Hssf). - destruct H3. subst. clear H1. - destruct (step_closedness fs e fs' e' Hssf H H0). - apply (IHstep_rt H1 H3). - - apply (sequentialStepEquiv fs fs' e e' H0) in H1. congruence. - * revert H1 H H0. revert fs fs' e e'. induction k; intros. - + simpl in H1. inv H1. constructor. - + simpl in H1. destruct (sequentialStepFunc fs e) eqn:Hssf. - - destruct p. - apply sequentialStepEquiv in Hssf;[|auto]. - destruct (step_closedness fs e f r Hssf H H0). - specialize (IHk f fs' r e' H1 H2 H3). - apply step_trans with (fs' := f) (e' := r); auto. - - discriminate. -Qed.*) - -Ltac case_innermost_term t := - lazymatch t with - | context[match ?x with _ => _ end] => - first [ case_innermost_term x - | destruct x eqn:?H ] - | _ => fail "No match subterm found" - end. - -Ltac case_innermost := - match goal with - | |- ?g => case_innermost_term g - end. - -(*Ltac case_innermost' := - match goal with - | [ H: context[match ?x with _ => _ end] |- _ ] => - destruct x eqn:?Hx in H; inv Hx; try case_innermost - | [ |- context[match ?x with _ => _ end] ] => - destruct x eqn:?Hx; inv Hx; try case_innermost - | _ => idtac - end.*) - -Ltac match_unwind t := - lazymatch t with - | context[match ?x with _ => _ end] => match_unwind x; idtac "hello"; simpl - | _ => simpl - end. - -Ltac unwind := - match goal with - | |- ?g => match_unwind g - end. - -(* Ltac hypothesize_matchstack_term t := - lazymatch t with - | context[match ?x with _ => _ end] => destruct x eqn:?Hx;hypothesize_matchstack_term Hx - | _ => idtac - end. - -Ltac hypothesize_matchstack := - match goal with - | |- ?g => hypothesize_matchstack_term g - end. *) - -Theorem fact_eval_example': - forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. unfold fact_frameStack. - all:simpl. all:try lia. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. -Qed. - - Theorem fact_eval_example'': - forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. + forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK'' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. Proof. intros. unfold fact_frameStack. all:simpl. all:try lia. @@ -249,8 +254,7 @@ Proof. case_innermost. all:simpl. all:try lia. eexists. split;[reflexivity|lia]. -Qed. - +Admitted. Fixpoint sequentialStepMaxK''' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := match sequentialStepFunc fs r with @@ -275,8 +279,23 @@ Fixpoint sequentialStepMaxK''' (fs : FrameStack) (r : Redex) (p : positive) : op end end. +Print positive. +Print positive_ind. +Print Pos.peano_ind. +Print Pos.lt_ind. + +Definition sequentialStepMaxK'''0 (fs : FrameStack) (r : Redex) (n : N) : option (FrameStack * Redex) := + match n with + | N0 => Some (fs, r) + | Npos p => sequentialStepMaxK''' fs r p + end. + +Print N. + Arguments sequentialStepMaxK''' !_ !_ !_ /. +Require Import SMTCoq.Tactics. + Theorem fact_eval_example''': forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK''' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. Proof. @@ -299,6 +318,127 @@ Proof. eexists. split;[reflexivity|lia]. Qed. +Lemma ssmaxk_can_step: + forall (k : positive) (fs fs' : FrameStack) (r r' : Redex) (v : Val), + fs <> [] -> r <> RValSeq [v] -> + sequentialStepMaxK''' fs r k = Some (fs', r') -> sequentialStepFunc fs r <> None. +Proof. + intros. + destruct k. + all:unfold sequentialStepMaxK''' in H1. + all:destruct (sequentialStepFunc fs r) eqn:Hssf; auto. + all:destruct fs; auto. +Qed. + +Lemma minusplus: forall (x y : Z), (x - 1 =? y)%Z = true -> (x =? y + 1)%Z = true. +Proof. smt. Qed. + +Theorem fact_eval_example'''': + forall (z : Z), (0 <= z)%Z -> exists (y : Z), sequentialStepMaxK''' [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|nia]. + all:simpl. all:try lia. + case_innermost. + eexists. split. reflexivity. (* clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11. *) +(* assert (z = 12%Z) by smt. *) + clear -H12. + assert (forall z, ((z - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 =? 0)%Z = true) -> (z = 12%Z)) by smt. + apply H in H12. subst. lia. + + apply H13 in H12. subst. auto. + clear H0 H1 H12. + assert (((z =? 0 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1)%Z = true) -> (z = 12%Z)) by smt. + + assert ((z =? 0 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1)%Z = true). lia. + assert ((z =? 12)%Z = true) by smt. + + eexists. split;[reflexivity|nia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|nia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|nia]. + all:simpl. all:try lia. + case_innermost. + clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14. + eexists. split. reflexivity. + Search "_ * _"%Z "<="%Z. + assert (z = 15%Z). admit. + assert (z = (15 - 1 + 1)%Z). easy. + +Admitted. + +Lemma ssmaxk_steppy_steppy: + forall (k : positive) (fs fs' fs'' : FrameStack) (r r' r'' : Redex), + sequentialStepMaxK''' fs r k = Some (fs', r') -> + sequentialStepFunc fs' r' = Some (fs'', r'') -> + sequentialStepMaxK''' fs r (k + 1) = Some (fs'', r''). +Proof. + intros k. + Print Pos.lt_ind. +Admitted. + +Theorem ssmaxk_trans: + forall (k l: positive) (fs fs' fs'' : FrameStack) (r r' r'' : Redex), + sequentialStepMaxK''' fs r k = Some (fs', r' ) -> + sequentialStepMaxK''' fs' r' l = Some (fs'', r'') -> + sequentialStepMaxK''' fs r (k + l)%positive = Some (fs'', r''). +Proof. + induction k using Pos.peano_ind. + * induction l using Pos.peano_ind; intros. + + assert ((1+1)%positive = 2%positive). lia. rewrite H1. clear H1. + unfold sequentialStepMaxK'''. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. + unfold sequentialStepMaxK''' in H. rewrite Hssf in H. inv H. + destruct (sequentialStepFunc fs' r') eqn:Hssf0. + ** destruct p. unfold sequentialStepMaxK''' in H0. + rewrite Hssf0 in H0. auto. + ** unfold sequentialStepMaxK''' in H0. rewrite Hssf0 in H0. auto. + - unfold sequentialStepMaxK''' in H. rewrite Hssf in H. + destruct fs eqn:Hfs; try discriminate. destruct r eqn:Hr; try discriminate. + inv H. simpl in H0. exact H0. + + + * +Qed. + (* symbolic execution plans TODO: These plans come "outside in", starting with the big picture. @@ -377,7 +517,7 @@ Qed. PLANS for the thesis: [x] investigate solutions for the "k" problem < - [ ] install SMT solvers (not trivial unfortunately). | do most of this before the trip to + [x] install SMT solvers (not trivial unfortunately). | do most of this before the trip to Actually, just "lia" can be used until it's done. | Singapore, and before lab work [ ] Have a few nice example programs | kicks into high gear [ ] implement the solver tactic | From 3daff3c91f0029f2f6c4e36e8bb02ae988c9e7ba Mon Sep 17 00:00:00 2001 From: mtlevr Date: Tue, 28 Oct 2025 16:48:17 +0100 Subject: [PATCH 03/20] Simplified max K steps + some new tactics --- src/Symbolic/Assignments.v | 369 ++++++++++++++++++++++++++++++++++++- 1 file changed, 362 insertions(+), 7 deletions(-) diff --git a/src/Symbolic/Assignments.v b/src/Symbolic/Assignments.v index b341cd4c..f162b691 100644 --- a/src/Symbolic/Assignments.v +++ b/src/Symbolic/Assignments.v @@ -58,11 +58,18 @@ Admitted. From CoreErlang.Interpreter Require Import StepFunctions Equivalences. +Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. +Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. + Ltac case_innermost_term t := lazymatch t with | context[match ?x with _ => _ end] => first [ case_innermost_term x - | destruct x eqn:?H ] + | let H := fresh "Heq" in + destruct x eqn:H; + first [apply Z_eqb_eq_corr in H + |apply Z_eqb_neq_corr in H + | idtac]] | _ => fail "No match subterm found" end. @@ -297,25 +304,336 @@ Arguments sequentialStepMaxK''' !_ !_ !_ /. Require Import SMTCoq.Tactics. Theorem fact_eval_example''': - forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK''' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. + forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), sequentialStepMaxK''' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. +intros. unfold fact_frameStack. + all:simpl. all:try lia. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. +Qed. + +Fixpoint ssmk (fs : FrameStack) (r : Redex) (p : positive) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match p with + | xH => (fs', r') + | xO p' => + let (fs'', r'') := ssmk fs r p' in ssmk fs'' r'' p' + | xI p' => + let (fs'', r'') := ssmk fs' r' p' in ssmk fs'' r'' p' + end + end. + +Arguments ssmk !_ !_ !_ /. + +(* + +Ltac case_innermost_term t := + lazymatch t with + | context[match ?x with _ => _ end] => + first [ case_innermost_term x + | destruct x eqn:?H ] + | _ => fail "No match subterm found" + end. + +Ltac case_innermost := + match goal with + | |- ?g => case_innermost_term g + end. + +*) + +Require Import Psatz. + +Theorem fact_eval_example'''': + forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk [] (fact_frameStack (˝VLit z)) 10000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. Proof. intros. unfold fact_frameStack. all:simpl. all:try lia. case_innermost. all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. + eexists. split;[reflexivity|nia]. case_innermost. all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. + eexists. split;[reflexivity|nia]. case_innermost. all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. + eexists. split;[reflexivity|nia]. case_innermost. all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. + eexists. split;[reflexivity|nia]. case_innermost. all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. + case_innermost. + all:simpl. all:try lia. + eexists. split;[reflexivity|nia]. +Qed. + +Fixpoint ssmkInner (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs', r') + | S n' => ssmkInner fs' r' n' + end + end. + +Definition isEnd (fs : FrameStack) (r : Redex) : bool := + match fs, r with + | [], RValSeq _ => true + | _, _ => false + end. + +Fixpoint ssmk2 (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := +match isEnd fs r with +| true => (fs, r) +| false => + match n with + | 0 => (fs, r) + | S n' => + let (fs', r') := ssmkInner fs r 1000 in + ssmk2 fs' r' n' + end +end. + +Arguments ssmkInner !_ !_ !_ /. +Arguments ssmk2 !_ !_ !_ /. + +Ltac simpl_and_try_solve := + simpl; (* simplify the goal *) + lazymatch goal with + | [ |- context[ssmk2] ] => try lia (* eval not done: is the case impossible? *) + | _ => try (eexists; split;[reflexivity|nia]) (* eval done: the result exists & postcond holds *) + end. + +Theorem fact_eval_example''''': + forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk2 [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. unfold fact_frameStack. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. Qed. Lemma ssmaxk_can_step: @@ -333,6 +651,43 @@ Qed. Lemma minusplus: forall (x y : Z), (x - 1 =? y)%Z = true -> (x =? y + 1)%Z = true. Proof. smt. Qed. +CoInductive StateStream : Type := +| Cons : FrameStack * Redex -> StateStream -> StateStream. + +CoFixpoint costep (fs : FrameStack) (r : Redex) : StateStream := + match sequentialStepFunc fs r with + | Some (fs', r') => Cons (fs', r') (costep fs' r') + | None => Cons (fs, r) (costep fs r) + end. + +Fixpoint coeval (s : StateStream) (n : nat) : FrameStack * Redex := + match n, s with + | 0, Cons (fs, r) _ => (fs, r) + | S n', Cons _ s' => coeval s' n' + end. + +Theorem fact_eval_example''''': + forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), coeval (costep [] (fact_frameStack (˝VLit z))) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. + case_innermost. + eexists. split;[reflexivity|lia]. + all:simpl. all:try lia. +Qed. + Theorem fact_eval_example'''': forall (z : Z), (0 <= z)%Z -> exists (y : Z), sequentialStepMaxK''' [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. Proof. From 0eaf69771417839ef4c95e69ff4a5e00ff88e502 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Wed, 29 Oct 2025 10:37:40 +0100 Subject: [PATCH 04/20] Moving important tests to new file + even_odd erlang module --- src/Symbolic/Symbolic.v | 175 +++++++++++++++++++++++++++++++++ src/Symbolic/even_odd.core | 192 +++++++++++++++++++++++++++++++++++++ src/Symbolic/even_odd.erl | 40 ++++++++ 3 files changed, 407 insertions(+) create mode 100644 src/Symbolic/Symbolic.v create mode 100644 src/Symbolic/even_odd.core create mode 100644 src/Symbolic/even_odd.erl diff --git a/src/Symbolic/Symbolic.v b/src/Symbolic/Symbolic.v new file mode 100644 index 00000000..11dfcfa6 --- /dev/null +++ b/src/Symbolic/Symbolic.v @@ -0,0 +1,175 @@ +From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. +From CoreErlang.Interpreter Require Import StepFunctions. + +Open Scope string_scope. +Import ListNotations. + +Definition fact_frameStack (e : Exp) : Exp := + ELetRec + [(1, °ECase (˝VVar 1) [ + ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); + ([PVar], ˝ttrue, + °ELet 1 (EApp (˝VFunId (1, 1)) + [°ECall (˝VLit "erlang") (˝VLit "-") [˝VVar 0; ˝VLit 1%Z]]) + (°ECall (˝VLit "erlang") (˝VLit "*") [˝VVar 1; ˝VVar 0]) + ) + ])] + (EApp (˝VFunId (0, 1)) [e]) + (* Write the definition here *) +. + +Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. +Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. + +Ltac case_innermost_term t := + lazymatch t with + | context[match ?x with _ => _ end] => + first [ case_innermost_term x + | let H := fresh "Heq" in + destruct x eqn:H; + first [apply Z_eqb_eq_corr in H + |apply Z_eqb_neq_corr in H + | idtac]] + | _ => fail "No match subterm found" + end. + +Ltac case_innermost := + match goal with + | |- ?g => case_innermost_term g + end. + +Fixpoint ssmkInner (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs', r') + | S n' => ssmkInner fs' r' n' + end + end. + +Definition isEnd (fs : FrameStack) (r : Redex) : bool := + match fs, r with + | [], RValSeq _ => true + | _, _ => false + end. + +Fixpoint ssmk2 (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := +match isEnd fs r with +| true => (fs, r) +| false => + match n with + | 0 => (fs, r) + | S n' => + let (fs', r') := ssmkInner fs r 1000 in + ssmk2 fs' r' n' + end +end. + +Arguments ssmkInner !_ !_ !_ /. +Arguments ssmk2 !_ !_ !_ /. + +Ltac simpl_and_try_solve := + simpl; (* simplify the goal *) + lazymatch goal with + | [ |- context[ssmk2] ] => try lia (* eval not done: is the case impossible? *) + | _ => try (eexists; split;[reflexivity|nia]) (* eval done: the result exists & postcond holds *) + end. + + +Ltac solve_forward := + repeat (simpl_and_try_solve; case_innermost). + + +Theorem fact_eval_example: + forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk2 [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros. unfold fact_frameStack. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. + case_innermost. + all:simpl_and_try_solve. +Qed. + +Theorem fact_eval_example': + forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk2 [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. + intros; unfold fact_frameStack. + solve_forward. +Qed. + + + + + + + + + + + + + + + + + + + diff --git a/src/Symbolic/even_odd.core b/src/Symbolic/even_odd.core new file mode 100644 index 00000000..d5caa662 --- /dev/null +++ b/src/Symbolic/even_odd.core @@ -0,0 +1,192 @@ +module 'even_odd' ['even'/1, + 'even2'/1, + 'main'/1, + 'module_info'/0, + 'module_info'/1, + 'odd'/1, + 'odd2'/1] + attributes [%% Line 1 + 'file' = + %% Line 1 + [{[101|[118|[101|[110|[95|[111|[100|[100|[46|[101|[114|[108]]]]]]]]]]]],1}]] +'even'/1 = + %% Line 4 + ( fun (_0) -> + ( case ( _0 + -| [{'function',{'even',1}}] ) of + <0> when 'true' -> + %% Line 5 + 'true' + %% Line 6 + + when call 'erlang':'>' + (( _0 + -| [{'function',{'even',1}}] ), + 0) -> + let <_1> = + call %% Line 7 + 'erlang':%% Line 7 + '-' + (%% Line 7 + N, %% Line 7 + 1) + in %% Line 7 + apply 'odd'/1 + (_1) + %% Line 8 + <_3> when 'true' -> + %% Line 9 + 'false' + end + -| [{'function',{'even',1}}] ) + -| [{'function',{'even',1}}] ) +'odd'/1 = + %% Line 11 + ( fun (_0) -> + ( case ( _0 + -| [{'function',{'odd',1}}] ) of + <1> when 'true' -> + %% Line 12 + 'true' + %% Line 13 + + when call 'erlang':'>' + (( _0 + -| [{'function',{'odd',1}}] ), + 1) -> + let <_1> = + call %% Line 14 + 'erlang':%% Line 14 + '-' + (%% Line 14 + N, %% Line 14 + 1) + in %% Line 14 + apply 'even'/1 + (_1) + %% Line 15 + <_3> when 'true' -> + %% Line 16 + 'false' + end + -| [{'function',{'odd',1}}] ) + -| [{'function',{'odd',1}}] ) +'even2'/1 = + %% Line 21 + ( fun (_0) -> + ( case ( _0 + -| [{'function',{'even2',1}}] ) of + <0> when 'true' -> + %% Line 22 + 'true' + %% Line 23 + <1> when 'true' -> + %% Line 24 + 'false' + %% Line 25 + + when call 'erlang':'>' + (( _0 + -| [{'function',{'even2',1}}] ), + 1) -> + let <_1> = + call %% Line 26 + 'erlang':%% Line 26 + '-' + (%% Line 26 + N, %% Line 26 + 2) + in %% Line 26 + apply 'even2'/1 + (_1) + %% Line 27 + <_3> when 'true' -> + %% Line 28 + 'false' + end + -| [{'function',{'even2',1}}] ) + -| [{'function',{'even2',1}}] ) +'odd2'/1 = + %% Line 30 + ( fun (_0) -> + ( case ( _0 + -| [{'function',{'odd2',1}}] ) of + <0> when 'true' -> + %% Line 31 + 'false' + %% Line 32 + <1> when 'true' -> + %% Line 33 + 'true' + %% Line 34 + + when call 'erlang':'>' + (( _0 + -| [{'function',{'odd2',1}}] ), + 1) -> + let <_1> = + call %% Line 35 + 'erlang':%% Line 35 + '-' + (%% Line 35 + N, %% Line 35 + 2) + in %% Line 35 + apply 'odd2'/1 + (_1) + %% Line 36 + <_3> when 'true' -> + %% Line 37 + 'false' + end + -| [{'function',{'odd2',1}}] ) + -| [{'function',{'odd2',1}}] ) +'main'/1 = + %% Line 39 + ( fun (_0) -> + ( case ( _0 + -| [{'function',{'main',1}}] ) of + <[]> when 'true' -> + let <_4> = + apply %% Line 40 + 'even'/1 + (%% Line 40 + 5) + in let <_3> = + apply %% Line 40 + 'odd'/1 + (%% Line 40 + 5) + in let <_2> = + apply %% Line 40 + 'even2'/1 + (%% Line 40 + 5) + in let <_1> = + apply %% Line 40 + 'odd2'/1 + (%% Line 40 + 5) + in %% Line 40 + [_4|[_3|[_2|[_1|[]]]]] + ( <_5> when 'true' -> + ( primop 'match_fail' + (( {'function_clause',_5} + -| [{'function',{'main',1}}] )) + -| [{'function',{'main',1}}] ) + -| ['compiler_generated'] ) + end + -| [{'function',{'main',1}}] ) + -| [{'function',{'main',1}}] ) +'module_info'/0 = + ( fun () -> + call 'erlang':'get_module_info' + ('even_odd') + -| [{'function',{'module_info',0}}] ) +'module_info'/1 = + ( fun (_0) -> + call 'erlang':'get_module_info' + ('even_odd', ( _0 + -| [{'function',{'module_info',1}}] )) + -| [{'function',{'module_info',1}}] ) +end \ No newline at end of file diff --git a/src/Symbolic/even_odd.erl b/src/Symbolic/even_odd.erl new file mode 100644 index 00000000..01412d72 --- /dev/null +++ b/src/Symbolic/even_odd.erl @@ -0,0 +1,40 @@ +-module(even_odd). +-export([even/1, odd/1, even2/1, odd2/1, main/1]). + +even(0) -> + true; +even(N) when N > 0 -> + odd(N - 1); +even(_) -> + false. + +odd(1) -> + true; +odd(N) when N > 1 -> + even(N - 1); +odd(_) -> + false. + + + + +even2(0) -> + true; +even2(1) -> + false; +even2(N) when N > 1 -> + even2(N - 2); +even2(_) -> + false. + +odd2(0) -> + false; +odd2(1) -> + true; +odd2(N) when N > 1 -> + odd2(N - 2); +odd2(_) -> + false. + +main([]) -> + [even(5), odd(5), even2(5), odd2(5)]. From b575461fe3ff6292070b89fdc974ed6faab08784 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Thu, 30 Oct 2025 09:03:04 +0100 Subject: [PATCH 05/20] Some changes to Symbolic --- src/Symbolic/Assignments.v | 2 +- src/Symbolic/Symbolic.v | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Symbolic/Assignments.v b/src/Symbolic/Assignments.v index f162b691..7140c674 100644 --- a/src/Symbolic/Assignments.v +++ b/src/Symbolic/Assignments.v @@ -396,7 +396,7 @@ intros. unfold fact_frameStack. all:simpl. all:try lia. eexists. split;[reflexivity|nia]. case_innermost. - all:simpl. all:try lia. + all:simpl. admit. cvc4. all:try lia. eexists. split;[reflexivity|nia]. Qed. diff --git a/src/Symbolic/Symbolic.v b/src/Symbolic/Symbolic.v index 11dfcfa6..11e3d4a5 100644 --- a/src/Symbolic/Symbolic.v +++ b/src/Symbolic/Symbolic.v @@ -4,6 +4,8 @@ From CoreErlang.Interpreter Require Import StepFunctions. Open Scope string_scope. Import ListNotations. +Print positive. + Definition fact_frameStack (e : Exp) : Exp := ELetRec [(1, °ECase (˝VVar 1) [ @@ -170,6 +172,3 @@ Qed. - - - From 3c0b02c6def6cd9bc91cf2918fa00be33c8eb441 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Sat, 8 Nov 2025 23:02:18 +0100 Subject: [PATCH 06/20] First version of induction in the symbolic eval --- src/Symbolic/Symbolic.v | 684 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 636 insertions(+), 48 deletions(-) diff --git a/src/Symbolic/Symbolic.v b/src/Symbolic/Symbolic.v index 11e3d4a5..bf59ee2a 100644 --- a/src/Symbolic/Symbolic.v +++ b/src/Symbolic/Symbolic.v @@ -1,5 +1,5 @@ From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. -From CoreErlang.Interpreter Require Import StepFunctions. +From CoreErlang.Interpreter Require Import StepFunctions Equivalences. Open Scope string_scope. Import ListNotations. @@ -40,12 +40,22 @@ Ltac case_innermost := | |- ?g => case_innermost_term g end. +Ltac case_innermost_in H := + let T := type of H in + case_innermost_term T. + +Tactic Notation "case_innermost" := + case_innermost. + +Tactic Notation "case_innermost" ident(H) := + case_innermost_in H. + Fixpoint ssmkInner (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := match sequentialStepFunc fs r with | None => (fs, r) | Some (fs', r') => match n with - | 0 => (fs', r') + | 0 => (fs, r) | S n' => ssmkInner fs' r' n' end end. @@ -56,7 +66,7 @@ Definition isEnd (fs : FrameStack) (r : Redex) : bool := | _, _ => false end. -Fixpoint ssmk2 (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := +Fixpoint ssmk (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := match isEnd fs r with | true => (fs, r) | false => @@ -64,17 +74,17 @@ match isEnd fs r with | 0 => (fs, r) | S n' => let (fs', r') := ssmkInner fs r 1000 in - ssmk2 fs' r' n' + ssmk fs' r' n' end end. Arguments ssmkInner !_ !_ !_ /. -Arguments ssmk2 !_ !_ !_ /. +Arguments ssmk !_ !_ !_ /. Ltac simpl_and_try_solve := simpl; (* simplify the goal *) lazymatch goal with - | [ |- context[ssmk2] ] => try lia (* eval not done: is the case impossible? *) + | [ |- context[ssmk] ] => try lia (* eval not done: is the case impossible? *) | _ => try (eexists; split;[reflexivity|nia]) (* eval done: the result exists & postcond holds *) end. @@ -84,7 +94,7 @@ Ltac solve_forward := Theorem fact_eval_example: - forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk2 [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. + forall (z : Z), (0 <= z < 10)%Z -> exists (y : Z), ssmk [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. Proof. intros. unfold fact_frameStack. all:simpl_and_try_solve. @@ -108,55 +118,633 @@ Proof. all:simpl_and_try_solve. case_innermost. all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. Qed. Theorem fact_eval_example': - forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk2 [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. + forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. Proof. intros; unfold fact_frameStack. solve_forward. Qed. +Theorem fact_eval_example_rec0: + forall (z : Z), (0 <= z)%Z -> + exists (y : Z), ssmk [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. +Proof. +Abort. + +Lemma ssmkInnerTrans: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n n' : nat), + ssmkInner fs r n = (fs', r') -> ssmkInner fs' r' n' = (fs'', r'') -> ssmkInner fs r (n + n') = (fs'', r''). +Proof. + intros fs fs' fs'' r r' r'' n. revert fs fs' fs'' r r' r''. + induction n; intros. + * simpl. unfold ssmkInner in H. destruct (sequentialStepFunc fs r); try destruct p; inv H; auto. + * simpl. unfold ssmkInner. unfold ssmkInner in H. + destruct (sequentialStepFunc fs r) eqn:Hssf. + + destruct p. fold ssmkInner in *. eapply IHn; eauto. + + inv H. + destruct n'. + - unfold ssmkInner in H0. rewrite Hssf in H0. auto. + - unfold ssmkInner in H0. rewrite Hssf in H0. auto. +Qed. + +Lemma ssmkInnerLet: + forall (fs: FrameStack) (r: Redex) (n n' : nat), + ssmkInner fs r (n + n') = let (fs', r') := ssmkInner fs r n in ssmkInner fs' r' n'. +Proof. + intros. revert fs r n'. induction n; intros. + * simpl. destruct (ssmkInner fs r 0) eqn:HssmkInner. + unfold ssmkInner in HssmkInner. + destruct (sequentialStepFunc fs r) eqn:Hssf. + 1:destruct p. all:inv HssmkInner. all:auto. + * simpl. + unfold ssmkInner. destruct (sequentialStepFunc fs r) eqn:Hssf. + 1:destruct p. all:fold ssmkInner. + + auto. + + destruct n'. + all:unfold ssmkInner. + all:rewrite Hssf. + all:auto. +Qed. + +Theorem ssmkEquiv: + forall (fs : FrameStack) (r : Redex) (n : nat), + ssmk fs r n = ssmkInner fs r (n * 1000). +Proof. + intros fs r n. revert fs r. + induction n; intros. + + simpl. unfold ssmk, ssmkInner. + destruct (isEnd fs r). + all:destruct (sequentialStepFunc fs r). + 1,3:destruct p. all:reflexivity. + + rewrite Nat.mul_succ_l. + unfold ssmk. destruct (isEnd fs r) eqn:HisEnd. + - unfold isEnd in *. destruct fs; try discriminate. destruct r; try discriminate. + rewrite Nat.add_comm. simpl. reflexivity. + - fold ssmk. + destruct (ssmkInner fs r 1000) eqn:Hssmk. + rewrite Nat.add_comm. + rewrite ssmkInnerLet. rewrite Hssmk. auto. +Qed. + +Lemma ssmkTrans: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n n' : nat), + ssmk fs r n = (fs', r') -> ssmk fs' r' n' = (fs'', r'') -> ssmk fs r (n + n') = (fs'', r''). +Proof. + setoid_rewrite ssmkEquiv. + intros. + assert ((n + n') * 1000 = (n * 1000 + n' * 1000)) by lia. + rewrite H1. clear H1. + eapply ssmkInnerTrans; eauto. +Qed. + +Lemma backOneInner: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n n' : nat), + ssmkInner fs r 1 = (fs', r') -> + (let (fs0, r0) := ssmkInner fs' r' n in ssmk fs0 r0 n' = (fs'', r'')) -> + let (fs0, r0) := ssmkInner fs r (S n) in ssmk fs0 r0 n' = (fs'', r''). +Proof. + intros. + destruct (ssmkInner fs' r' n) eqn:HssmkInner. + rewrite ssmkEquiv in H0. + destruct (ssmkInner fs r (S n)) eqn:HssmkInner0. + rewrite ssmkEquiv. + assert (S n = 1 + n) by lia. + rewrite H1 in HssmkInner0. clear H1. + rewrite ssmkInnerLet in HssmkInner0. + rewrite H in HssmkInner0. + rewrite HssmkInner0 in HssmkInner. inv HssmkInner. auto. +Qed. + +Lemma advanceOneInner: + forall (fs fs'' : FrameStack) (r r'' : Redex) (n n' : nat), + (let (fs0, r0) := ssmkInner fs r (S n) in ssmk fs0 r0 n' = (fs'', r'')) -> + exists (fs' : FrameStack) (r' : Redex), + ssmkInner fs r 1 = (fs', r') /\ + (let (fs0, r0) := ssmkInner fs' r' n in ssmk fs0 r0 n' = (fs'', r'')). +Proof. + intros. + destruct (ssmkInner fs r (S n)) eqn:HssmkInner. + rewrite ssmkEquiv in H. + assert (S n = 1 + n) by lia. + rewrite H0 in HssmkInner. clear H0. + rewrite ssmkInnerLet in HssmkInner. + destruct (ssmkInner fs r 1) eqn:HssmkInner0. + do 2 eexists. split. eauto. + rewrite HssmkInner. + rewrite ssmkEquiv. auto. +Qed. + +Lemma backOnePivot: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n : nat), + ssmkInner fs r 1 = (fs', r') -> + ssmk fs' r' n = (fs'', r'') -> + let (fs0, r0) := ssmkInner fs r 1 in ssmk fs0 r0 n = (fs'', r''). +Proof. + intros. rewrite H. auto. +Qed. + +Lemma advanceOnePivot: + forall (fs fs'' : FrameStack) (r r'' : Redex) (n : nat), + (let (fs0, r0) := ssmkInner fs r 1 in ssmk fs0 r0 n = (fs'', r'')) -> + exists (fs' : FrameStack) (r' : Redex), + ssmkInner fs r 1 = (fs', r') /\ + ssmk fs' r' n = (fs'', r''). +Proof. + intros. setoid_rewrite ssmkEquiv. + destruct (ssmkInner fs r 1) eqn:HssmkInner. + rewrite ssmkEquiv in H. + do 2 eexists. split. eauto. auto. +Qed. + +Lemma backOneChange: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n : nat), + ssmkInner fs r 1 = (fs', r') -> + (let (fs0, r0) := ssmkInner fs' r' 999 in ssmk fs0 r0 n = (fs'', r'')) -> + ssmk fs r (S n) = (fs'', r''). +Proof. + intros. + rewrite ssmkEquiv. + destruct (ssmkInner fs' r' 999) eqn:HssmkInner. + rewrite ssmkEquiv in H0. + assert (S n * 1000 = 1 + (999 + n * 1000)) by lia. + rewrite H1. clear H1. + rewrite ssmkInnerLet. rewrite H. + rewrite ssmkInnerLet. rewrite HssmkInner. auto. +Qed. + +Lemma advanceOneChange: + forall (fs fs'' : FrameStack) (r r'' : Redex) (n : nat), + ssmk fs r (S n) = (fs'', r'') -> + exists (fs' : FrameStack) (r' : Redex), + ssmkInner fs r 1 = (fs', r') /\ + (let (fs0, r0) := ssmkInner fs' r' 999 in ssmk fs0 r0 n = (fs'', r'')). +Proof. + intros. rewrite ssmkEquiv in H. + assert (S n * 1000 = 1 + (999 + n * 1000)) by lia. + rewrite H0 in H. clear H0. + rewrite ssmkInnerLet in H. + destruct (ssmkInner fs r 1) eqn:HssmkInner. + rewrite ssmkInnerLet in H. + destruct (ssmkInner f r0 999) eqn:HssmkInner0. + do 2 eexists. split. eauto. + rewrite HssmkInner0. rewrite ssmkEquiv. auto. +Qed. + +Lemma ssmkInnerOneMore: + forall (fs : FrameStack) (r : Redex) (v : list Val) (n : nat), + ssmkInner fs r n = ([], RValSeq v) -> ssmkInner fs r (S n) = ([], RValSeq v). +Proof. + intros fs r v n. revert fs r v. + induction n; intros. + * unfold ssmkInner in *. + destruct (sequentialStepFunc fs r) eqn:Hssf. + 1:destruct p. all:inv H. reflexivity. + * unfold ssmkInner. unfold ssmkInner in H. + destruct (sequentialStepFunc fs r) eqn:Hssf. all:auto. + destruct p. fold ssmkInner in *. + apply IHn in H. + unfold ssmkInner in H. destruct (sequentialStepFunc f r0) eqn:Hssf0. + 1:destruct p. 1:fold ssmkInner in H. all:auto. +Qed. + +Theorem ssmkInnerMore: + forall (fs : FrameStack) (r : Redex) (v : list Val) (n n' : nat), + n <= n' -> + ssmkInner fs r n = ([], RValSeq v) -> ssmkInner fs r n' = ([], RValSeq v). +Proof. + intros fs r v n. revert fs r v. + induction n; intros. + * destruct n'. + all:unfold ssmkInner in *. + all:destruct (sequentialStepFunc fs r) eqn:Hssf. + 1,3:destruct p. + all:auto. inv H0. + * destruct n'. + + inv H. + + assert (n <= n') by lia. + unfold ssmkInner. unfold ssmkInner in H0. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold ssmkInner in *. + apply IHn. lia. auto. + - auto. +Qed. + +Ltac advanceOne H := + first [ apply advanceOneChange in H;destruct H as [fs' [r' [Hfirst H]]];inv Hfirst + | apply advanceOneInner in H;destruct H as [fs' [r' [Hfirst H]]];inv Hfirst + | apply advanceOnePivot in H;destruct H as [fs' [r' [Hfirst H]]];inv Hfirst + | idtac "Nothing to advance"]. + +Theorem fact_eval_rec: + forall (z : nat), (* (0 <= z) -> *) + forall (y : nat), ssmk [] (fact_frameStack (˝VLit (Z.of_nat z))) 1000 = ([], RValSeq [VLit (Z.of_nat y)]) -> + (z <= y). +Proof. + intros. unfold fact_frameStack in H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + + + induction z. + * simpl in H. inv H. nia. + * (*simpl in H0. simpl in IHz.*) + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + advanceOne H. + + + assert ((Z.of_nat (S z) - 1)%Z = Z.of_nat z) by lia. + rewrite H0 in H. clear H0. + + + + + + +Abort. + +Lemma help: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, ssmk fs r (S n) = ([], r')) <-> + exists n, ssmk fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (S x). auto. + * destruct H0. destruct x. + + unfold ssmk in *. + destruct (isEnd fs r) eqn:HisEnd. + - inv H0. exists 0. reflexivity. + - fold ssmk. inv H0. + inv H. simpl. exists 0. simpl. reflexivity. + + exists x. auto. +Qed. + +Definition mayRec (fs : FrameStack) (r : Redex) : bool := + match fs with + | FParams (IApp (VClos (_ :: _) _ _ _)) _ _ :: _ => + match r with + | RValSeq _ => true + | _ => false + end + | _ => false + end. + +Compute mayRec [FParams + (IApp + (VClos + [(0, 1, + ° ECase (˝ VVar 1) + [([PLit 0%Z], ˝ VLit "true", ˝ VLit 1%Z); + ([PVar], ˝ VLit "true", + ° ELet 1 + (° EApp (˝ VFunId (1, 1)) + [° ECall (˝ VLit "erlang") (˝ VLit "-") + [˝ VVar 0; ˝ VLit 1%Z]]) + (° ECall (˝ VLit "erlang") (˝ VLit "*") [˝ VVar 1; ˝ VVar 0]))])] + 0 1 + (° ECase (˝ VVar 1) + [([PLit 0%Z], ˝ VLit "true", ˝ VLit 1%Z); + ([PVar], ˝ VLit "true", + ° ELet 1 + (° EApp (˝ VFunId (1, 1)) + [° ECall (˝ VLit "erlang") (˝ VLit "-") [˝ VVar 0; ˝ VLit 1%Z]]) + (° ECall (˝ VLit "erlang") (˝ VLit "*") [˝ VVar 1; ˝ VVar 0]))]))) + [] []] (RValSeq [VLit (Z.of_nat 1)]). + +Fixpoint ssmkMayRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex * nat := +match mayRec fs r with +| true => (fs, r, n) +| false => + match sequentialStepFunc fs r with + | None => (fs, r, n) + | Some (fs', r') => + match n with + | 0 => (fs, r, n) + | S n' => ssmkMayRec fs' r' n' + end + end +end. + +Compute ssmkMayRec [] (fact_frameStack (˝VLit 4%Z)) 100. + +Theorem ssmkRec: + forall (fs : FrameStack) (r : Redex) (n : nat), + ssmkInner fs r n = + let '(fs', r', n') := ssmkMayRec fs r n in ssmkInner fs' r' n'. +Proof. + intros. revert fs r. induction n; intros. + * simpl. unfold ssmkInner. + destruct (mayRec fs r). + + reflexivity. + + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. rewrite Hssf. reflexivity. + - rewrite Hssf. reflexivity. + * simpl. unfold ssmkInner. + destruct (mayRec fs r). + + reflexivity. + + destruct (sequentialStepFunc fs r) eqn:Hssf. + - fold ssmkInner. destruct p. auto. + - rewrite Hssf. reflexivity. +Qed. + +Theorem fact_eval_example_rec0: + forall (z : nat), (*(0 <= z) -> *) + exists (y : nat), + (exists (n : nat), ssmk [] (fact_frameStack (˝VLit (Z.of_nat z))) n = ([], RValSeq [VLit (Z.of_nat y)])) + /\ (z <= y). +Proof. + intros. setoid_rewrite <- help;[|constructor]. + + Opaque ssmkInner. simpl. + setoid_rewrite ssmkRec. simpl. + Transparent ssmkInner. + +Abort. + +(* Ltac toPotentialRec := + Opaque ssmkInner; simpl; try (setoid_rewrite ssmkRec); simpl; Transparent ssmkInner. + *) + +Fixpoint ssmkInnerNoSimpl (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => ssmkInnerNoSimpl fs' r' n' + end + end. + +Arguments ssmkInnerNoSimpl : simpl never. + +Lemma ssmkInnerSimplEquiv : + forall (fs : FrameStack) (r : Redex) (n : nat), + ssmkInner fs r n = ssmkInnerNoSimpl fs r n. +Proof. reflexivity. Qed. + +Theorem ssmkSimpl : + forall (fs : FrameStack) (r : Redex) (n : nat), + match isEnd fs r with + | true => (fs, r) + | false => let (fs', r') := ssmkInnerNoSimpl fs r 1000 in ssmk fs' r' n + end = ssmk fs r (S n). +Proof. reflexivity. Qed. + +Theorem ssmkRecNoSimpl : + forall (fs : FrameStack) (r : Redex) (n : nat), + ssmkInner fs r n = + let '(fs', r', n') := ssmkMayRec fs r n in ssmkInnerNoSimpl fs' r' n'. +Proof. + intros. rewrite ssmkRec. destruct (ssmkMayRec fs r n). destruct p. rewrite ssmkInnerSimplEquiv. reflexivity. +Qed. + +Ltac toPotentialRec := +match goal with +| |- context[ssmkInner] => idtac +| _ => try (setoid_rewrite <- ssmkSimpl); simpl +end; + try (setoid_rewrite ssmkRecNoSimpl); simpl; + try (setoid_rewrite <- ssmkInnerSimplEquiv). + +Lemma asd: + forall (fs : FrameStack) (r : Redex) (n : nat), + ssmkInner fs r (S n) = let (fs', r') := ssmkInner fs r 1 in ssmkInnerNoSimpl fs' r' n. +Proof. Admitted. + +Theorem fact_eval_example_rec0: + forall (z : nat), (*(0 <= z) -> *) + exists (y : Z), + (exists (n : nat), ssmk [] (fact_frameStack (˝VLit (Z.of_nat z))) n = ([], RValSeq [VLit y])) + /\ ((Z.of_nat z) <= y)%Z. +Proof. + intros. setoid_rewrite <- help;[|constructor]. + toPotentialRec. + induction z. + * simpl. eexists. split;[exists 0;reflexivity|nia]. + * setoid_rewrite asd. simpl. setoid_rewrite <- ssmkInnerSimplEquiv. + toPotentialRec. setoid_rewrite ssmkInnerSimplEquiv. unfold eval_arith_NEW. simpl. + remember (IApp _). clear Heqf. + +Abort. + +Theorem ssmkInnerOuter: + forall (fs : FrameStack) (r r': Redex) (k : nat), + is_result r' -> + (exists n, (let (fs0, r0) := ssmkInner fs r k in ssmk fs0 r0 n) = ([], r')) <-> + (exists n, ssmk fs r n = ([], r')). +Proof. + intros. split. + * intros. + destruct H0. destruct (ssmkInner fs r k) eqn:HssmkInner. + setoid_rewrite ssmkEquiv. + rewrite ssmkEquiv in H0. + exists (x + k). + assert ((x + k) * 1000 = k + ((x * 1000) + (k * 999))) by lia. + rewrite H1. clear H1. + rewrite ssmkInnerLet. rewrite HssmkInner. + rewrite ssmkInnerLet. rewrite H0. + inv H. + + destruct k; simpl; reflexivity. + + destruct k; simpl; reflexivity. + * intros. + destruct H0. + (* setoid_rewrite not working backwards?? *) + assert + ( (exists n : nat, (let (fs0, r0) := ssmkInner fs r k in ssmkInner fs0 r0 (n * 1000)) = ([], r')) -> + (exists n : nat, (let (fs0, r0) := ssmkInner fs r k in ssmk fs0 r0 n) = ([], r'))). + { intros. destruct (ssmkInner fs r k). setoid_rewrite ssmkEquiv. auto. } + apply H1. clear H1. + (* setoid_rewrite not working backwards again??? *) + assert + ( (∃ n : nat, ssmkInner fs r (k + n * 1000) = ([], r')) -> + (∃ n : nat, (let (fs0, r0) := ssmkInner fs r k in ssmkInner fs0 r0 (n * 1000)) = ([], r'))). + { intros. setoid_rewrite ssmkInnerLet in H1. destruct (ssmkInner fs r k). auto. } + apply H1. clear H1. + rewrite ssmkEquiv in H0. + exists x. + assert (k + x * 1000 = x * 1000 + k) by lia. + rewrite H1. clear H1. + rewrite ssmkInnerLet. rewrite H0. + inv H. + + destruct k; simpl; reflexivity. + + destruct k; simpl; reflexivity. +Qed. + +Theorem ssmkOuterIsInner: + forall (fs : FrameStack) (r r': Redex), + is_result r' -> + (exists n, ssmk fs r n = ([], r')) <-> + (exists n, ssmkInner fs r n = ([], r')). +Proof. + intros. split; intro. + * destruct H0. exists (x * 1000). rewrite <- ssmkEquiv. auto. + * destruct H0. + exists x. rewrite ssmkEquiv. + assert (x * 1000 = x + x * 999) by lia. + rewrite H1. clear H1. + rewrite ssmkInnerLet. rewrite H0. + inv H. + + destruct x; simpl; reflexivity. + + destruct x; simpl; reflexivity. +Qed. + +Print frame_indep_core. +Close Scope string_scope. + +Fixpoint ssExactlyk (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := +match n with +| 0 => Some (fs, r) +| S n' => + match sequentialStepFunc fs r with + | Some (fs', r') => ssExactlyk fs' r' n' + | _ => None + end +end. + +Theorem kStepEquiv: + forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), + ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> ssExactlyk fs r k = Some (fs', r'). +Proof. + intros. split. + * revert fs fs' r r'. + induction k; intros. + + simpl. inv H. reflexivity. + + simpl. destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. apply IHk. + inv H. apply sequentialStepEquiv in H1. rewrite Hssf in H1. inv H1. auto. + - inv H. apply sequentialStepEquiv in H1. rewrite H1 in Hssf. discriminate. + * revert fs fs' r r'. + induction k; intros. + + simpl in H. inv H. constructor. + + simpl in H. destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. apply sequentialStepEquiv in Hssf. + econstructor. eauto. apply IHk. auto. + - discriminate. +Qed. + +Theorem kStepMaxkStep: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, ssmkInner fs r n = (fs', r')) <-> + (exists n, ssExactlyk fs r n = Some (fs', r')). +Proof. + intros. split. + * intro. destruct H. revert H. revert fs fs' r r'. + induction x; intros. + + unfold ssmkInner in H. destruct (sequentialStepFunc fs r). + - destruct p. inv H. exists 0. reflexivity. + - inv H. exists 0. reflexivity. + + unfold ssmkInner in H. + destruct (sequentialStepFunc fs r) eqn:Hssf; fold ssmkInner in H. + - destruct p. apply IHx in H. destruct H. exists (S x0). simpl. rewrite Hssf. auto. + - inv H. exists 0. reflexivity. + * intro. destruct H. exists x. + revert H. revert fs fs' r r'. + induction x; intros. + + simpl in H. inv H. unfold ssmkInner. + destruct (sequentialStepFunc _ _). 1:destruct p. all:reflexivity. + + simpl in H. unfold ssmkInner. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold ssmkInner. apply IHx. auto. + - inv H. +Qed. + +Theorem frame_indep_core_functional: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, ssmkInner fs r n = (fs', r')) -> + forall (fsapp : FrameStack), (exists n, ssmkInner (fs ++ fsapp) r n = (fs' ++ fsapp, r')). +Proof. + intros. + apply kStepMaxkStep. apply kStepMaxkStep in H. + destruct H. apply kStepEquiv in H. + exists x. apply kStepEquiv. apply frame_indep_core. auto. +Qed. + +Theorem ssmkTransitive: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), + (exists n, ssmkInner fs r n = (fs', r')) -> + (exists n, ssmkInner fs' r' n = (fs'', r'')) -> + (exists n, ssmkInner fs r n = (fs'', r'')). +Proof. + setoid_rewrite kStepMaxkStep. setoid_rewrite <- kStepEquiv. intros. + destruct H. destruct H0. exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +Theorem fact_eval_example_rec0': + forall (z : nat), (*(0 <= z) -> *) + exists (y : Z), + (exists (n : nat), ssmk [] (fact_frameStack (˝VLit (Z.of_nat z))) n = ([], RValSeq [VLit y])) + /\ ((Z.of_nat z) <= y)%Z. +Proof. + intros. + setoid_rewrite <- help;[|constructor]. + toPotentialRec. + induction z. + * simpl. eexists. split;[exists 0;reflexivity|nia]. + * setoid_rewrite asd. simpl. setoid_rewrite <- ssmkInnerSimplEquiv. + toPotentialRec. setoid_rewrite ssmkInnerSimplEquiv. unfold eval_arith_NEW. simpl. + remember (IApp _). + setoid_rewrite <- ssmkInnerSimplEquiv. + setoid_rewrite ssmkInnerOuter;[|constructor]. + setoid_rewrite ssmkOuterIsInner;[|constructor]. + setoid_rewrite ssmkInnerOuter in IHz;[|constructor]. + setoid_rewrite ssmkOuterIsInner in IHz;[|constructor]. + + destruct IHz. destruct H. + remember (FLet _ _) as l. + pose proof frame_indep_core_functional. + specialize (H1 _ _ _ _ H [l]). simpl in H1. + + assert ((Z.of_nat (S z) - 1)%Z = Z.of_nat z) by lia. rewrite H2. clear H2. + + eexists. split. + eapply ssmkTransitive. eauto. + subst l. + setoid_rewrite <- ssmkOuterIsInner;[|constructor]. + setoid_rewrite <- help;[|constructor]. simpl. + exists 0. simpl. reflexivity. + + (* we actually also need the info, that 0! > 0, which is surprising... *) + setoid_rewrite <- ssmkOuterIsInner in H;[|constructor]. + setoid_rewrite <- help in H;[|constructor]. + destruct z. + + subst f. simpl in H. destruct H. destruct x0. + - simpl in H. inv H. lia. + - simpl in H. inv H. lia. + + nia. +Qed. + +(* TODO + - look into: frame_indep_core for function + - look into: how do I use the old tactics for this method? + - look into: how can I use the new theorems for this method? + *) From a9d8724035f18ec7d97f08b46d6b112aa6110dd8 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Sun, 9 Nov 2025 17:59:41 +0100 Subject: [PATCH 07/20] New version of symbolic induction --- src/Symbolic/Symbolic.v | 362 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 357 insertions(+), 5 deletions(-) diff --git a/src/Symbolic/Symbolic.v b/src/Symbolic/Symbolic.v index bf59ee2a..b313c8e3 100644 --- a/src/Symbolic/Symbolic.v +++ b/src/Symbolic/Symbolic.v @@ -740,13 +740,365 @@ Proof. + nia. Qed. -(* TODO - - look into: frame_indep_core for function - - look into: how do I use the old tactics for this method? - - look into: how can I use the new theorems for this method? - *) +(* --------------------------------------------------------------- *) + +Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepMaxK fs' r' n' + end + end. + +Fixpoint sequentialStepMaxKNoSimpl (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepMaxKNoSimpl fs' r' n' + end + end. + +Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := + match n with + | 0 => Some (fs, r) + | S n' => + match sequentialStepFunc fs r with + | Some (fs', r') => sequentialStepK fs' r' n' + | None => None + end + end. + +Arguments sequentialStepMaxK !_ !_ !_ /. +Arguments sequentialStepMaxKNoSimpl : simpl never. +Arguments sequentialStepK !_ !_ !_ /. + +Definition canRec (fs : FrameStack) (r : Redex) : bool := + match fs with + | FParams (IApp (VClos (_ :: _) _ _ _)) _ _ :: _ => + match r with + | RValSeq _ => true + | _ => false + end + | _ => false + end. + +Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match canRec fs r with + | true => (fs, r) + | false => + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepCanRec fs' r' n' + end + end + end. + +Lemma maxKZeroRefl: + forall (fs : FrameStack) (r : Redex), + sequentialStepMaxK fs r 0 = (fs, r). +Proof. + intros. unfold sequentialStepMaxK. + destruct (sequentialStepFunc fs r). + 1:destruct p. all:reflexivity. +Qed. + +Lemma canRecRefl: + forall (fs : FrameStack) (r : Redex), + sequentialStepCanRec fs r 0 = (fs, r). +Proof. + intros. unfold sequentialStepCanRec. + destruct (canRec fs r). 2:destruct (sequentialStepFunc fs r). + 2:destruct p. all:reflexivity. +Qed. + +Lemma maxKForwardOne: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, sequentialStepMaxK fs r (S n) = ([], r')) <-> + exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (S x). auto. + * destruct H0. destruct x. + + exists 0. + rewrite maxKZeroRefl in H0. inv H0. + inv H. all:auto. + + exists x. auto. +Qed. + +Lemma maxKOverflow: + forall (fs : FrameStack) (r r' : Redex) (n m : nat), + is_result r' -> + n <= m -> + sequentialStepMaxK fs r n = ([], r') -> + sequentialStepMaxK fs r m = ([], r'). +Proof. + intros fs r r' n. revert fs r r'. + induction n; intros. + * destruct m. + + auto. + + rewrite maxKZeroRefl in H1. inv H1. + inv H. all:auto. + * destruct m. + + inv H0. + + unfold sequentialStepMaxK in H1|-*. + destruct (sequentialStepFunc fs r). + 1:destruct p; fold sequentialStepMaxK. + all:fold sequentialStepMaxK in H1. + - apply IHn; auto. lia. + - auto. +Qed. +Lemma maxKForwardThousand: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, sequentialStepMaxK fs r (1000 + n) = ([], r')) <-> + exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (1000 + x). auto. + * destruct H0. + exists x. + apply (maxKOverflow _ _ _ x); auto. lia. +Qed. +Lemma maxKEquivK: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, sequentialStepK fs r n = Some (fs', r')) <-> + (exists n, sequentialStepMaxK fs r n = (fs', r')). +Proof. + intros. split;intro. + * destruct H. exists x. + revert H. revert fs r. + induction x; intros. + + unfold sequentialStepK in *. inv H. + rewrite maxKZeroRefl. auto. + + unfold sequentialStepMaxK. + unfold sequentialStepK in H. + destruct (sequentialStepFunc fs r). + 1:destruct p. + all:fold sequentialStepMaxK. all:fold sequentialStepK in H. + all:auto. inv H. + * destruct H. revert H. revert fs r. + induction x; intros. + + rewrite maxKZeroRefl in H. inv H. exists 0. + unfold sequentialStepK. reflexivity. + + unfold sequentialStepMaxK in H. + destruct (sequentialStepFunc fs r) eqn:Hssf; fold sequentialStepMaxK in H. + - destruct p. + apply IHx in H. destruct H. exists (S x0). + unfold sequentialStepK. rewrite Hssf. fold sequentialStepK. + auto. + - inv H. exists 0. unfold sequentialStepK. reflexivity. +Qed. + +Lemma kEquiv: + forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), + ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> sequentialStepK fs r k = Some (fs', r'). +Proof. + intros. split;revert fs fs' r r'. + * induction k; intros. + + inv H. unfold sequentialStepK. auto. + + inv H. unfold sequentialStepK. + apply sequentialStepEquiv in H1. rewrite H1. + fold sequentialStepK. auto. + * induction k; intros. + + unfold sequentialStepK in H. inv H. constructor. + + unfold sequentialStepK in H. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepK in H. + apply sequentialStepEquiv in Hssf. + econstructor; eauto. + - inv H. +Qed. + +Theorem RTCEquiv: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + ⟨ fs, r ⟩ -->* r' <-> exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros fs r r' Hres. split; intros. + * inv H. destruct H0. + apply kEquiv in H0. + apply maxKEquivK. + exists x. auto. + * apply maxKEquivK in H. + destruct H. econstructor. split;[auto|]. + apply kEquiv. eauto. +Qed. + +Lemma maxKNoSimplEquiv: + forall (fs : FrameStack) (r : Redex) (n : nat), + sequentialStepMaxK fs r n = sequentialStepMaxKNoSimpl fs r n. +Proof. reflexivity. Qed. + +Lemma maxKTransCanRec: + forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), + is_result r'' -> + sequentialStepCanRec fs r k = (fs', r') -> + (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. + destruct H1. revert H0 H1. revert x fs fs' r r'. + induction k; intros. + + rewrite canRecRefl in H0. inv H0. exists x. auto. + + unfold sequentialStepCanRec in H0. + destruct (canRec fs r) eqn:HCanRec. + - inv H0. eapply IHk; eauto. + destruct k; unfold sequentialStepCanRec; rewrite HCanRec; auto. + - destruct (sequentialStepFunc fs r) eqn:Hssf. + fold sequentialStepCanRec in H0. + ** destruct p. + setoid_rewrite <- maxKForwardOne;[|auto]. + unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. + eapply IHk; eauto. + ** inv H0. exists x. auto. +Qed. + +Lemma maxKInsertCanRec: + forall (fs : FrameStack) (r r'' : Redex), + is_result r'' -> + (exists n, (let (fs', r') := sequentialStepCanRec fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. split; intros. + * destruct (sequentialStepCanRec fs r 1000) eqn:Hsscr. + eapply maxKTransCanRec; eauto. + * destruct H0. + destruct (sequentialStepCanRec fs r 1000) eqn:Hsscr. + remember 1000 as k. clear Heqk. + revert H0 Hsscr. revert fs r f r0 k. + induction x; intros. + + rewrite maxKZeroRefl in H0. inv H0. inv H. + all:simpl in Hsscr. all:destruct k. + all:inv Hsscr. all:exists 0; auto. + + unfold sequentialStepMaxK in H0. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepMaxK in H0. + destruct k. + ** rewrite canRecRefl in Hsscr. inv Hsscr. + exists (S x). unfold sequentialStepMaxK. rewrite Hssf. + fold sequentialStepMaxK. auto. + ** unfold sequentialStepCanRec in Hsscr. + destruct (canRec fs r) eqn:HCanRec. + ++ inv Hsscr. exists (S x). + unfold sequentialStepMaxK. rewrite Hssf. + fold sequentialStepMaxK. auto. + ++ rewrite Hssf in Hsscr. fold sequentialStepCanRec in Hsscr. + eapply IHx; eauto. + - inv H0. + destruct k. + ** rewrite canRecRefl in Hsscr. inv Hsscr. exists 0. inv H; auto. + ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. + all:exists 0; auto. +Qed. + +Theorem frame_indep_core_func: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + forall (fsapp : FrameStack), (exists n, sequentialStepMaxK (fs ++ fsapp) r n = (fs' ++ fsapp, r')). +Proof. + intros. + apply maxKEquivK. apply maxKEquivK in H. + destruct H. apply kEquiv in H. + exists x. apply kEquiv. apply frame_indep_core. auto. +Qed. + +Theorem maxKTransitive: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + (exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) -> + (exists n, sequentialStepMaxK fs r n = (fs'', r'')). +Proof. + setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. + destruct H, H0. exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +Ltac toRec := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKInsertCanRec;[|constructor]);simpl +| _ => idtac "nothing to do" +end. + +Ltac stepOne := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKForwardOne;[|constructor]);simpl +| _ => idtac "nothing to do" +end. + +Ltac stepThousand := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKForwardThousand;[|constructor]);simpl +| _ => idtac "nothing to do" +end. + +Ltac toNextRec := stepOne; toRec. + +Theorem fact_eval_ex: + forall (z : nat), + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y)%Z. +Proof. + intros. + setoid_rewrite RTCEquiv;[|constructor]. + + toRec. + + (* List of things to solve automatically: *) + + (* 1. We need to figure out what to do the induction on: the variable wrapped inside the Redex *) + induction z. + * repeat stepThousand. + (* 2. Is there a way to get "y" to be a "nat" as well? I was having problems with that... *) + repeat eexists. exact 0. nia. + * toNextRec. + + (* 3. Why is eval_arith in the redex not simplifying on it's own? Could be because of Arguments...? *) + simpl. + unfold eval_arith_NEW. simpl. + + (* 4. We actually might have multiple arguments in the postcondition, so repeat the destructs until + we run out of exists. Innermost destruct should always be [IHExp IHPostcond] *) + destruct IHz as [y [IHExp IHPostcond]]. + + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. + + (* 5. This clears ++ from the FrameStack given back (good, should always work), and, in this case it + converts the ++ in the FrameStack input into ::, because there is only 1 frame. But will we need + to deal with cases with multiple frames as the input? *) + simpl in IHExp_fic. + + (* 6. The framestack in the goal needs to match the framestack in IHExp_fic. *) + assert ((Z.of_nat (S z) - 1)%Z = Z.of_nat z) by lia. rewrite H. clear H. + + eexists. split. + + eapply maxKTransitive. auto. (* comes from IHExp_fic *) + repeat stepThousand. + repeat eexists. (* solves something else also? Unusual... *) + exact 0. + + (* 7. This particular postcondition is interesting, because the induction hypothesis IHPostcond + is not enough on its own: we need to know that we can not get 0 as a factorial value! + That could only happen in the 0 case, because of IHPostcond, so IHExp needs to be calculated + with it. *) + Fail nia. + setoid_rewrite <- maxKForwardThousand in IHExp;[|constructor]. + simpl in IHExp. + case_innermost IHExp. + - simpl in IHExp. destruct IHExp as [n IHExp]. inv IHExp. nia. + - nia. +Qed. From f1fc24dbedbf6b3ca9e787daa37dd7574688f344 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Thu, 13 Nov 2025 14:58:01 +0100 Subject: [PATCH 08/20] Continuing with induction --- src/Symbolic/Symbolic.v | 131 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 126 insertions(+), 5 deletions(-) diff --git a/src/Symbolic/Symbolic.v b/src/Symbolic/Symbolic.v index b313c8e3..aeb5fe2e 100644 --- a/src/Symbolic/Symbolic.v +++ b/src/Symbolic/Symbolic.v @@ -548,7 +548,7 @@ Proof. induction z. * simpl. eexists. split;[exists 0;reflexivity|nia]. * setoid_rewrite asd. simpl. setoid_rewrite <- ssmkInnerSimplEquiv. - toPotentialRec. setoid_rewrite ssmkInnerSimplEquiv. unfold eval_arith_NEW. simpl. + toPotentialRec. setoid_rewrite ssmkInnerSimplEquiv. cbn. remember (IApp _). clear Heqf. Abort. @@ -1059,6 +1059,7 @@ Proof. (* List of things to solve automatically: *) (* 1. We need to figure out what to do the induction on: the variable wrapped inside the Redex *) + induction z. * repeat stepThousand. (* 2. Is there a way to get "y" to be a "nat" as well? I was having problems with that... *) @@ -1066,18 +1067,17 @@ Proof. * toNextRec. (* 3. Why is eval_arith in the redex not simplifying on it's own? Could be because of Arguments...? *) - simpl. - unfold eval_arith_NEW. simpl. + cbn. (* 4. We actually might have multiple arguments in the postcondition, so repeat the destructs until we run out of exists. Innermost destruct should always be [IHExp IHPostcond] *) destruct IHz as [y [IHExp IHPostcond]]. - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. - (* 5. This clears ++ from the FrameStack given back (good, should always work), and, in this case it converts the ++ in the FrameStack input into ::, because there is only 1 frame. But will we need to deal with cases with multiple frames as the input? *) + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. + simpl in IHExp_fic. (* 6. The framestack in the goal needs to match the framestack in IHExp_fic. *) @@ -1100,6 +1100,127 @@ Proof. - nia. Qed. +Lemma NatZSuccPred: + forall (n : nat), (Z.of_nat (S n) - 1)%Z = Z.of_nat n. +Proof. lia. Qed. + +Theorem maxKTransitive': + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (P : Prop), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + ((exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) /\ P) -> + ((exists n, sequentialStepMaxK fs r n = (fs'', r'')) /\ P). +Proof. + setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. + destruct H, H0, H0. + split;auto. + exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +Ltac solve_final_state := + eexists; + [auto| (* This is for the step number, which is always irrelevant (|- nat) when this tactic is called *) + first [ auto (* The program indeed terminated at ([], r) where is_result r *) + | idtac "Unexpected end state + (can be due to an exception in the Erlang program, + a result when an exception was expected, + non-termination in the given depth or + an impossible input that was not ruled out)" + ]]. + +Ltac solve_final_postcond := + first [ nia + | idtac "Could not solve postcondition" + ]. + +Ltac solve_terminated := + lazymatch goal with + | |- context[sequentialStepMaxK] => fail + | |- _ => + lazymatch goal with + | |- ex _ => eexists;solve_terminated + | |- _ /\ _ => split;[solve_final_state|solve_final_postcond] + | |- _ => idtac + end + end. + +Ltac give_steps_if_needed_using steptac := + first [ progress simpl + | steptac + ]. + +Ltac match_with_backfall backfall steptac := + lazymatch goal with + | |- context[match ?x with _ => _ end] => + case_innermost; + try nia; + backfall + | |- _ => fail "Match expression not found" + end. + + + +Theorem fact_eval_ex': + forall (z : nat), + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y /\ y >= 1)%Z. +Proof. + intros. + setoid_rewrite RTCEquiv;[|constructor]. + + toRec. + + induction z using lt_wf_ind. + + destruct z eqn:Hz. + + repeat stepThousand. + solve_terminated. + + toNextRec. cbn. + try rewrite NatZSuccPred. + specialize (H n (Nat.lt_succ_diag_r _)). + destruct H as [y [IHExp IHPostcond]]. + + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. simpl in IHExp_fic. + eexists. eapply maxKTransitive'. auto. + repeat stepThousand. + solve_terminated. +Qed. + +Theorem fact_eval_ex'': + forall (z : nat), + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z))%Z. +Proof. + intros. + setoid_rewrite RTCEquiv;[|constructor]. + + toRec. + + induction z using lt_wf_ind. + + destruct z eqn:Hz. + + repeat stepThousand. + solve_terminated. + + toNextRec. cbn. + try rewrite NatZSuccPred. + specialize (H n (Nat.lt_succ_diag_r _)). + destruct H as [y [IHExp IHPostcond]]. + + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. simpl in IHExp_fic. + eexists. eapply maxKTransitive'. auto. + repeat stepThousand. + solve_terminated. +Qed. + + + + + + + + + + From f98ffbbb24b482f479944fb7de344847e7653cd7 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Mon, 1 Dec 2025 15:47:59 +0100 Subject: [PATCH 09/20] Moved useful stuff into Symb.v --- src/Symbolic/Symb.v | 1366 +++++++++++++++++++++++++++++++++++++++ src/Symbolic/Symbolic.v | 200 ++++-- 2 files changed, 1525 insertions(+), 41 deletions(-) create mode 100644 src/Symbolic/Symb.v diff --git a/src/Symbolic/Symb.v b/src/Symbolic/Symb.v new file mode 100644 index 00000000..db5ebbc3 --- /dev/null +++ b/src/Symbolic/Symb.v @@ -0,0 +1,1366 @@ +From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. +From CoreErlang.Interpreter Require Import StepFunctions Equivalences. + +Import ListNotations. + +Fixpoint Exp_list_eqb (le1 le2 : list Exp) : bool := + match le1, le2 with + | [], [] => true + | [], _ :: _ => false + | _ :: _, [] => false + | e1 :: le1', e2 :: le2' => andb (Exp_eqb_strict e1 e2) (Exp_list_eqb le1' le2') + end. + +Fixpoint Val_list_eqb (lv1 lv2 : list Val) : bool := + match lv1, lv2 with + | [], [] => true + | [], _ :: _ => false + | _ :: _, [] => false + | v1 :: lv1', v2 :: lv2' => andb (Val_eqb_strict v1 v2) (Val_list_eqb lv1' lv2') + end. + +Fixpoint Pat_list_eqb (lp1 lp2 : list Pat) : bool := + match lp1, lp2 with + | [], [] => true + | [], _ :: _ => false + | _ :: _, [] => false + | p1 :: lp1', p2 :: lp2' => andb (Pat_eqb p1 p2) (Pat_list_eqb lp1' lp2') + end. + +Fixpoint FCase1_eqb (l1 l2 : list (list Pat * Exp * Exp)) : bool := + match l1, l2 with + | [], [] => true + | [], _ :: _ => false + | _ :: _, [] => false + | (lp1, e1, e1') :: l1', (lp2, e2, e2') :: l2' => + andb (Pat_list_eqb lp1 lp2) (andb (Exp_eqb_strict e1 e2) (andb (Exp_eqb_strict e1' e2') (FCase1_eqb l1' l2'))) + end. + +Print FrameIdent. +Definition FrameIdent_eqb (fi1 fi2 : FrameIdent) : bool := + match fi1, fi2 with + | IValues, IValues => true + | ITuple, ITuple => true + | IMap, IMap => true + | ICall v1 v1', ICall v2 v2' => andb (Val_eqb_strict v1 v2) (Val_eqb_strict v1' v2') + | IPrimOp s1, IPrimOp s2 => String.eqb s1 s2 + | IApp v1, IApp v2 => Val_eqb_strict v1 v2 + | _, _ => false + end. + +Definition Frame_eqb (f1 f2 : Frame) : bool := + match f1, f2 with + | FCons1 e1, FCons1 e2 => Exp_eqb_strict e1 e2 + | FCons2 v1, FCons2 v2 => Val_eqb_strict v1 v2 + | FParams fi1 vl1 el1, FParams fi2 vl2 el2 => + andb (FrameIdent_eqb fi1 fi2) (andb (Val_list_eqb vl1 vl2) (Exp_list_eqb el1 el2)) + | FApp1 el1, FApp1 el2 => Exp_list_eqb el1 el2 + | FCallMod e1 el1, FCallMod e2 el2 => andb (Exp_eqb_strict e1 e2) (Exp_list_eqb el1 el2) + | FCallFun v1 el1, FCallFun v2 el2 => andb (Val_eqb_strict v1 v2) (Exp_list_eqb el1 el2) + | FCase1 l1, FCase1 l2 => FCase1_eqb l1 l2 + | FCase2 vl1 e1 l1, FCase2 vl2 e2 l2 => + andb (Val_list_eqb vl1 vl2) (andb (Exp_eqb_strict e1 e2) (FCase1_eqb l1 l2)) + | FLet n1 e1, FLet n2 e2 => andb (Nat.eqb n1 n2) (Exp_eqb_strict e1 e2) + | FSeq e1, FSeq e2 => Exp_eqb_strict e1 e2 + | FTry n1 e1 n1' e1', FTry n2 e2 n2' e2' => + andb (Nat.eqb n1 n2) (andb (Exp_eqb_strict e1 e2) (andb (Nat.eqb n1' n2') (Exp_eqb_strict e1' e2'))) + | _, _ => false + end. + +Fixpoint FrameStack_prefix (fs1 fs2 : FrameStack) : bool := + match fs1, fs2 with + | [], _ => true + | f1 :: fs1', f2 :: fs2' => andb (Frame_eqb f1 f2) (FrameStack_prefix fs1' fs2') + | _, _ => false + end. + +Definition fact_frameStack (e : Exp) : Exp := + ELetRec + [(1, °ECase (˝VVar 1) [ + ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); + ([PVar], ˝ttrue, + °ELet 1 (EApp (˝VFunId (1, 1)) + [°ECall (˝VLit "erlang"%string) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]]) + (°ECall (˝VLit "erlang"%string) (˝VLit "*"%string) [˝VVar 1; ˝VVar 0]) + ) + ])] + (EApp (˝VFunId (0, 1)) [e]) + (* Write the definition here *) +. + +Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepMaxK fs' r' n' + end + end. + +Fixpoint sequentialStepMaxKNoSimpl (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepMaxKNoSimpl fs' r' n' + end + end. + +Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := + match n with + | 0 => Some (fs, r) + | S n' => + match sequentialStepFunc fs r with + | Some (fs', r') => sequentialStepK fs' r' n' + | None => None + end + end. + +Arguments sequentialStepMaxK !_ !_ !_ /. +Arguments sequentialStepMaxKNoSimpl : simpl never. +Arguments sequentialStepK !_ !_ !_ /. + +Definition canRec (fs : FrameStack) (r : Redex) : bool := + match fs with + | FParams (IApp (VClos (_ :: _) _ _ _)) _ _ :: _ => + match r with + | RValSeq _ => true + | _ => false + end + | _ => false + end. + +Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match canRec fs r with + | true => (fs, r) + | false => + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepCanRec fs' r' n' + end + end + end. + +Lemma maxKZeroRefl: + forall (fs : FrameStack) (r : Redex), + sequentialStepMaxK fs r 0 = (fs, r). +Proof. + intros. unfold sequentialStepMaxK. + destruct (sequentialStepFunc fs r). + 1:destruct p. all:reflexivity. +Qed. + +Lemma canRecRefl: + forall (fs : FrameStack) (r : Redex), + sequentialStepCanRec fs r 0 = (fs, r). +Proof. + intros. unfold sequentialStepCanRec. + destruct (canRec fs r). 2:destruct (sequentialStepFunc fs r). + 2:destruct p. all:reflexivity. +Qed. + +Lemma maxKForwardOne: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, sequentialStepMaxK fs r (S n) = ([], r')) <-> + exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (S x). auto. + * destruct H0. destruct x. + + exists 0. + rewrite maxKZeroRefl in H0. inv H0. + inv H. all:auto. + + exists x. auto. +Qed. + +Lemma maxKOverflow: + forall (fs : FrameStack) (r r' : Redex) (n m : nat), + is_result r' -> + n <= m -> + sequentialStepMaxK fs r n = ([], r') -> + sequentialStepMaxK fs r m = ([], r'). +Proof. + intros fs r r' n. revert fs r r'. + induction n; intros. + * destruct m. + + auto. + + rewrite maxKZeroRefl in H1. inv H1. + inv H. all:auto. + * destruct m. + + inv H0. + + unfold sequentialStepMaxK in H1|-*. + destruct (sequentialStepFunc fs r). + 1:destruct p; fold sequentialStepMaxK. + all:fold sequentialStepMaxK in H1. + - apply IHn; auto. lia. + - auto. +Qed. + +Lemma maxKForwardThousand: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, sequentialStepMaxK fs r (1000 + n) = ([], r')) <-> + exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (1000 + x). auto. + * destruct H0. + exists x. + apply (maxKOverflow _ _ _ x); auto. lia. +Qed. + +Lemma maxKEquivK: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, sequentialStepK fs r n = Some (fs', r')) <-> + (exists n, sequentialStepMaxK fs r n = (fs', r')). +Proof. + intros. split;intro. + * destruct H. exists x. + revert H. revert fs r. + induction x; intros. + + unfold sequentialStepK in *. inv H. + rewrite maxKZeroRefl. auto. + + unfold sequentialStepMaxK. + unfold sequentialStepK in H. + destruct (sequentialStepFunc fs r). + 1:destruct p. + all:fold sequentialStepMaxK. all:fold sequentialStepK in H. + all:auto. inv H. + * destruct H. revert H. revert fs r. + induction x; intros. + + rewrite maxKZeroRefl in H. inv H. exists 0. + unfold sequentialStepK. reflexivity. + + unfold sequentialStepMaxK in H. + destruct (sequentialStepFunc fs r) eqn:Hssf; fold sequentialStepMaxK in H. + - destruct p. + apply IHx in H. destruct H. exists (S x0). + unfold sequentialStepK. rewrite Hssf. fold sequentialStepK. + auto. + - inv H. exists 0. unfold sequentialStepK. reflexivity. +Qed. + +Lemma kEquiv: + forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), + ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> sequentialStepK fs r k = Some (fs', r'). +Proof. + intros. split;revert fs fs' r r'. + * induction k; intros. + + inv H. unfold sequentialStepK. auto. + + inv H. unfold sequentialStepK. + apply sequentialStepEquiv in H1. rewrite H1. + fold sequentialStepK. auto. + * induction k; intros. + + unfold sequentialStepK in H. inv H. constructor. + + unfold sequentialStepK in H. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepK in H. + apply sequentialStepEquiv in Hssf. + econstructor; eauto. + - inv H. +Qed. + +Theorem RTCEquiv: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + ⟨ fs, r ⟩ -->* r' <-> exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros fs r r' Hres. split; intros. + * inv H. destruct H0. + apply kEquiv in H0. + apply maxKEquivK. + exists x. auto. + * apply maxKEquivK in H. + destruct H. econstructor. split;[auto|]. + apply kEquiv. eauto. +Qed. + +Lemma maxKNoSimplEquiv: + forall (fs : FrameStack) (r : Redex) (n : nat), + sequentialStepMaxK fs r n = sequentialStepMaxKNoSimpl fs r n. +Proof. reflexivity. Qed. + +Lemma maxKTransCanRec: + forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), + is_result r'' -> + sequentialStepCanRec fs r k = (fs', r') -> + (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. + destruct H1. revert H0 H1. revert x fs fs' r r'. + induction k; intros. + + rewrite canRecRefl in H0. inv H0. exists x. auto. + + unfold sequentialStepCanRec in H0. + destruct (canRec fs r) eqn:HCanRec. + - inv H0. eapply IHk; eauto. + destruct k; unfold sequentialStepCanRec; rewrite HCanRec; auto. + - destruct (sequentialStepFunc fs r) eqn:Hssf. + fold sequentialStepCanRec in H0. + ** destruct p. + setoid_rewrite <- maxKForwardOne;[|auto]. + unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. + eapply IHk; eauto. + ** inv H0. exists x. auto. +Qed. + +Lemma maxKInsertCanRec: + forall (fs : FrameStack) (r r'' : Redex), + is_result r'' -> + (exists n, (let (fs', r') := sequentialStepCanRec fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. split; intros. + * destruct (sequentialStepCanRec fs r 1000) eqn:Hsscr. + eapply maxKTransCanRec; eauto. + * destruct H0. + destruct (sequentialStepCanRec fs r 1000) eqn:Hsscr. + remember 1000 as k. clear Heqk. + revert H0 Hsscr. revert fs r f r0 k. + induction x; intros. + + rewrite maxKZeroRefl in H0. inv H0. inv H. + all:simpl in Hsscr. all:destruct k. + all:inv Hsscr. all:exists 0; auto. + + unfold sequentialStepMaxK in H0. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepMaxK in H0. + destruct k. + ** rewrite canRecRefl in Hsscr. inv Hsscr. + exists (S x). unfold sequentialStepMaxK. rewrite Hssf. + fold sequentialStepMaxK. auto. + ** unfold sequentialStepCanRec in Hsscr. + destruct (canRec fs r) eqn:HCanRec. + ++ inv Hsscr. exists (S x). + unfold sequentialStepMaxK. rewrite Hssf. + fold sequentialStepMaxK. auto. + ++ rewrite Hssf in Hsscr. fold sequentialStepCanRec in Hsscr. + eapply IHx; eauto. + - inv H0. + destruct k. + ** rewrite canRecRefl in Hsscr. inv Hsscr. exists 0. inv H; auto. + ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. + all:exists 0; auto. +Qed. + +Theorem frame_indep_core_func: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + forall (fsapp : FrameStack), (exists n, sequentialStepMaxK (fs ++ fsapp) r n = (fs' ++ fsapp, r')). +Proof. + intros. + apply maxKEquivK. apply maxKEquivK in H. + destruct H. apply kEquiv in H. + exists x. apply kEquiv. apply frame_indep_core. auto. +Qed. + +Theorem maxKTransitive: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + (exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) -> + (exists n, sequentialStepMaxK fs r n = (fs'', r'')). +Proof. + setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. + destruct H, H0. exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +Lemma maxKDone: + forall (r r' : Redex), + is_result r' -> + (exists n : nat, ([] : FrameStack, r') = ([], r)) <-> + (exists n, sequentialStepMaxK [] r' n = ([], r)). +Proof. + intros. split;intro. + * destruct H0. inv H0. setoid_rewrite <- RTCEquiv;[|auto]. + econstructor. split. auto. constructor. + * destruct H0. destruct x. + + rewrite maxKZeroRefl in H0. exists 0. auto. + + inv H; simpl in H0; exists 0; auto. +Qed. + +Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. +Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. + +Ltac case_innermost_term t := + lazymatch t with + | context[match ?x with _ => _ end] => + first [ case_innermost_term x + | let H := fresh "Heq" in + destruct x eqn:H; + first [apply Z_eqb_eq_corr in H + |apply Z_eqb_neq_corr in H + | idtac]] + | _ => fail "No match subterm found" + end. + +Ltac case_innermost := + match goal with + | |- ?g => case_innermost_term g + end. + +Ltac case_innermost_in H := + let T := type of H in + case_innermost_term T. + +Tactic Notation "case_innermost" := + case_innermost. + +Tactic Notation "case_innermost" ident(H) := + case_innermost_in H. + + +Ltac toRec := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKInsertCanRec;[|constructor]);simpl; + try (setoid_rewrite <- maxKDone;[|constructor]) +| _ => idtac "nothing to do" +end. + +Ltac stepOne := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKForwardOne;[|constructor]);simpl +| _ => idtac "nothing to do" +end. + +Ltac stepThousand := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKForwardThousand;[|constructor]);simpl +| _ => idtac "nothing to do" +end. + +Ltac toNextRec := stepOne; toRec. + +Lemma NatZSuccPred: + forall (n : nat), (Z.of_nat (S n) - 1)%Z = Z.of_nat n. +Proof. lia. Qed. + +Theorem maxKTransitive': + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (P : Prop), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + ((exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) /\ P) -> + ((exists n, sequentialStepMaxK fs r n = (fs'', r'')) /\ P). +Proof. + setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. + destruct H, H0, H0. + split;auto. + exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +Ltac solve_final_state := + eexists; + [auto| (* This is for the step number, which is always irrelevant (|- nat) when this tactic is called *) + first [ auto (* The program indeed terminated at ([], r) where is_result r *) + | idtac "Unexpected end state + (can be due to an exception in the Erlang program, + a result when an exception was expected, + non-termination in the given depth or + an impossible input that was not ruled out)" + ]]. + +Ltac solve_final_postcond := + first [ nia + | idtac "Could not solve postcondition" + ]. + +Ltac solve_terminated := + lazymatch goal with + | |- context[sequentialStepMaxK] => fail "The program has not yet terminated" + | |- _ => + lazymatch goal with + | |- ex _ => eexists;solve_terminated + | |- _ /\ _ => split;[solve_final_state|solve_final_postcond] + | |- _ => idtac + end + end. + +Ltac give_steps_if_needed_using steptac := + first [ progress simpl + | steptac + ]. + +Ltac match_with_backfall backfall := + lazymatch goal with + | |- context[match ?x with _ => _ end] => + case_innermost; + try nia; + backfall + | |- _ => fail "Match expression not found" + end. + +Ltac able_to_ind := + lazymatch goal with + | |- context[sequentialStepMaxK ?fs ?r] => + let b := eval compute in (canRec fs r) in + lazymatch b with + | true => idtac + | false => fail + end + | |- _ => fail + end. + +Ltac base_case := + stepThousand; + first [ solve_terminated + | match_with_backfall base_case + | base_case]. + +Ltac solve_IH_precond IH:= + lazymatch (type of IH) with + | ?A -> _ => + let proof := fresh "IHPrec" in + assert A as proof by lia; + specialize (IH proof); + clear proof + | _ => idtac + end. + +Ltac framestack_is_prefix IH := + lazymatch goal with + | |- context[sequentialStepMaxK ?fs _] => + lazymatch (type of IH) with + | context[sequentialStepMaxK ?fsIH _] => + let b := eval compute in (FrameStack_prefix fsIH fs) in + lazymatch b with + | true => idtac + | false => fail "Framestack in induction hypothesis is not a prefix" + end + | _ => fail "No step left in induction hypothesis, or symbolic variable inside framestack" + end + | |- _ => fail "No steps left in goal" + end. + +Ltac redex_matches IH := + lazymatch goal with + | |- context[sequentialStepMaxK _ ?r] => + lazymatch (type of IH) with + | context[sequentialStepMaxK _ ?rIH] => constr_eq r rIH + | _ => fail "No step left in induction hypothesis" + end + | |- _ => fail "No steps left in goal" + end. + +Ltac destruct_until_conj IH := + lazymatch (type of IH) with + | _ /\ _ => idtac + | ex _ => + let x := fresh "x" in + destruct IH as [x IH]; destruct_until_conj IH + | _ => idtac + end. + +Ltac eexists_until_conj := + lazymatch goal with + | |- _ /\ _ => idtac + | |- ex _ => eexists; eexists_until_conj + | |- _ => idtac + end. + +Ltac try_rectify_IH_redex IH kval := + specialize (IH kval); + setoid_rewrite Z2Nat.id in IH; try lia; + solve_IH_precond IH; + + framestack_is_prefix IH; + redex_matches IH. + +Ltac try_rectify_induction IH := + framestack_is_prefix IH; + lazymatch goal with + | |- context[sequentialStepMaxK _ ?r] => + lazymatch r with + | context[VLit (Integer ?k)] => try_rectify_IH_redex IH (Z.to_nat k) + | _ => idtac "did not find k" + end + | |- _ => idtac "Redex value not found" (* we need to continue... *) + end. + +Ltac solve_by_induction IH := + (* This tactic only gets called, if the framestack in IH is the prefix of the one in the goal, + and the redexes are syntactically the same. So these should always work... *) + destruct_until_conj IH; + let IHExp := fresh "IHExp" in + let IHPostcond := fresh "IHPostcond" in + destruct IH as [IHExp IHPostcond]; + let IHExp_fic := fresh "IHExp_fic" in + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic; simpl in IHExp_fic; + eexists_until_conj; + eapply maxKTransitive';[apply IHExp_fic|]; + base_case. + +Ltac ind_case IH := + let back_call := stepOne;ind_case IH in + toRec;cbn; + first [ solve_terminated + | match_with_backfall ind_case + | try_rectify_induction IH; solve_by_induction IH + | back_call]. + +Ltac induction_head symb := + let n := fresh "n" in + let IH := fresh "IH" in + induction symb as [n IH] using lt_wf_ind; + let Hn := fresh "Hn" in + destruct n eqn:Hn; + [base_case|stepOne;ind_case IH]. + +Ltac solve_to_rec symb := + toRec; + first [ solve_terminated + | able_to_ind; induction_head symb + | match_with_backfall solve_to_rec + | solve_to_rec]. + +Ltac solve_symbolically symb := + first [ intros; setoid_rewrite RTCEquiv;[|constructor]; solve_to_rec symb + | fail "Could not solve goal symbolically" + ]. + +Theorem fact_eval_ex: + forall (z : nat), + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y /\ y >= 1)%Z. +Proof. + intros. + setoid_rewrite RTCEquiv;[|constructor]. + + toRec. + + induction z using lt_wf_ind. + destruct z. + * repeat stepThousand. + + solve_terminated. exact 0. + * toNextRec. + + cbn. + + specialize (H (Z.to_nat (Z.of_nat (S z) - 1)%Z)). + setoid_rewrite Z2Nat.id in H; try lia. + assert (Z.to_nat (Z.of_nat (S z) - 1) < S z) by lia. + specialize (H H0). clear H0. + + destruct H as [y [IHExp IHPostcond]]. + + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. + simpl in IHExp_fic. + + eexists. + eapply maxKTransitive'. auto. + repeat stepThousand. solve_terminated. +Qed. + +(* Require Import SMTCoq.Tactics. + +Lemma Z_of_nat_O : Z.of_nat 0 = 0%Z. Proof. reflexivity. Qed. +Lemma Z_of_nat_S n : Z.of_nat (S n) = (Z.of_nat n + 1)%Z. Proof. lia. Qed. + +Add_lemmas Z_of_nat_0 Z_of_nat_S. *) + +Theorem fact_eval_ex': + forall (z : nat), + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y /\ y >= 1)%Z. +Proof. + solve_symbolically z. +Qed. + +Theorem fact_eval_ex'': + forall (z : nat), + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z))%Z. +Proof. + solve_symbolically z. + + subst x. + rewrite <- Nat2Z.inj_mul. f_equal. + assert (1%Z = Z.of_nat (Z.to_nat 1)) by lia. rewrite H. clear H. + rewrite <- Nat2Z.inj_sub;[|lia]. + rewrite Nat2Z.id. simpl. rewrite Nat.sub_0_r. reflexivity. +Qed. + +Theorem fact_eval : forall n, + ⟨[], fact_frameStack (˝VLit (Z.of_nat n))⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. +Proof. + intros. + pose proof fact_eval_ex'' n. + destruct H. destruct H. subst x. auto. +Qed. + +(* + Let "e" and "d" be parameter expressions. + + letrec 'fact'/2 = + fun(X, A) -> + case of + <0> when 'true' -> A + when 'true' -> apply 'fact'/2(call 'erlang':'-'(Z, 1), call 'erlang':'*'(Z, A)) + in + apply 'fact'/2(e, d) + + Define the above expression! + *) +Definition tailrec_fact (e d : Exp) : Exp := + ELetRec [ + (2, °ECase (˝VVar 1) [ + ([PLit (Integer 0%Z)], ˝ttrue, ˝VVar 2); + ([PVar], ˝ttrue, + (°EApp (˝VFunId (1, 2)) + [°ECall (˝erlang) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]; + °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 0; ˝VVar 3] + ])) + ] + ) + ] (EApp (˝VFunId (0, 2)) [e; d]) +. + +Theorem tailrec_fact_eval : forall n, + ⟨[], tailrec_fact (˝VLit (Z.of_nat n)) (˝VLit 1%Z)⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. +Proof. Abort. + + +Theorem tailrec_fact_eval_ex: + forall (z : nat) (z' : Z), (0 <= z')%Z -> + exists (y : Z), + ⟨ [], (tailrec_fact (˝VLit (Z.of_nat z)) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z) * z')%Z. +Proof. + intros z. + setoid_rewrite RTCEquiv;[|constructor]. + do 8 stepOne. stepOne. + + induction z using lt_wf_ind; intros. + destruct z. + * repeat stepThousand. + + solve_terminated. exact 0. + * do 32 stepOne. cbn. + + specialize (H (Z.to_nat (Z.of_nat (S z) - 1)%Z)). + setoid_rewrite Z2Nat.id in H; try lia. + assert (Z.to_nat (Z.of_nat (S z) - 1) < S z) by lia. + specialize (H H1). clear H1. + specialize (H (Z.of_nat (S z) * z')%Z). + assert (0 ≤ Z.of_nat (S z) * z')%Z by lia. + specialize (H H1). clear H1. + + destruct H as [y [IHExp IHPostcond]]. + + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. + simpl in IHExp_fic. + + eexists. + eapply maxKTransitive'. auto. + repeat stepThousand. solve_terminated. + subst y. + Search Z.of_nat "_ * _". + Search Z.of_nat Z.to_nat. + rewrite <- (Z2Nat.id z' H0). + repeat rewrite <- Nat2Z.inj_mul. f_equal. + rewrite <- (Z2Nat.id 1);[|lia]. + rewrite <- Nat2Z.inj_sub. rewrite Nat2Z.id. 2:lia. + simpl. rewrite Nat.sub_0_r. lia. +Qed. + +Theorem tailrec_fact_eval_ex': + forall (z : nat), + exists (y : Z), + ⟨ [], (tailrec_fact (˝VLit (Z.of_nat z)) (˝VLit 1%Z)) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z))%Z. +Proof. + intros z. + setoid_rewrite RTCEquiv;[|constructor]. + toRec. toNextRec. + + induction z using lt_wf_ind; intros. + destruct z; intros. + * repeat stepThousand. + + solve_terminated. exact 0. + * toNextRec. toNextRec. cbn. + (* This can not be solved with simple induction, because even with just intoint z, + the hypothesis H is still not general enough. It wants the accumulator to be 1. *) +Abort. + +Theorem tailrec_fact_eval_ex'': + forall (z : nat) (z' : Z), (0 <= z')%Z -> + exists (y : Z), + ⟨ [], (tailrec_fact (˝VLit (Z.of_nat z)) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z) * z')%Z. +Proof. + intros z. + setoid_rewrite RTCEquiv;[|constructor]. + + unfold tailrec_fact. + do 8 stepOne. +Abort. + +Lemma jesus_christ: + forall xs res ident v vl, + (⟨FParams ident (vl ++ [v]) [] :: xs, RBox⟩ -->* res) -> + ⟨FParams ident vl [] :: xs, RValSeq [v]⟩ -->* res. +Proof. + intros. inv H. destruct H0. inv H0. inv H1. + econstructor. split;auto. + econstructor. econstructor. eauto. eauto. +Qed. + +Lemma jesus_christ_backwards: + forall xs res ident v vl, + ident <> IMap -> + ⟨FParams ident vl [] :: xs, RValSeq [v]⟩ -->* res -> + (⟨FParams ident (vl ++ [v]) [] :: xs, RBox⟩ -->* res). +Proof. + intros. inv H0. destruct H1. inv H1. inv H2. + econstructor. split;auto. + econstructor. econstructor. auto. eauto. eauto. +Qed. + +Lemma jesus_christ': + forall xs res ident v vl, + ident <> IMap -> is_result res -> + (exists n, sequentialStepMaxK (FParams ident (vl ++ [v]) [] :: xs) RBox n = ([], res)) <-> + (exists n, sequentialStepMaxK (FParams ident vl [] :: xs) (RValSeq [v]) n = ([], res)). +Proof. + intros. + setoid_rewrite <- RTCEquiv; auto. + split. apply jesus_christ. apply jesus_christ_backwards. auto. +Qed. + +Ltac test IH := + lazymatch (type of IH) with + | context[sequentialStepMaxK ?fs _] => idtac "found it!" + | _ => idtac "did not find it" + end. + +Theorem tailrec_fact_eval_ex''': + forall (z : nat) (z' : Z), (*(0 <= z')%Z ->*) + exists (y : Z), + ⟨ [], (tailrec_fact (˝VLit (Z.of_nat z)) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z) * z')%Z. +Proof. + intros z. + setoid_rewrite RTCEquiv;[|constructor]. + + unfold tailrec_fact. + do 8 stepOne. setoid_rewrite <- jesus_christ';auto. simpl. + + induction z using lt_wf_ind; intros. + destruct z. + * repeat stepThousand. solve_terminated. exact 0. + * toNextRec. toNextRec. cbn. + test H. + Print frame_indep_core_func. + + setoid_rewrite <- jesus_christ';auto. simpl. + specialize (H (Z.to_nat ((Z.of_nat (S z) - 1)%Z))). + assert (Z.to_nat ((Z.of_nat (S z) - 1)%Z) < S z) by lia. + specialize (H H0). clear H0. + setoid_rewrite Z2Nat.id in H;[|lia]. + specialize (H (Z.of_nat (S z) * z')%Z). + + destruct H as [y [IHExp IHPostcond]]. + Print frame_indep_core_func. + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. + simpl in IHExp_fic. + + eexists. Print maxKTransitive'. + eapply maxKTransitive'. auto. + shelve. + repeat stepThousand. solve_terminated. + subst y. + Search Z.of_nat "_ * _". + Search Z.of_nat Z.to_nat. + rewrite Z.mul_assoc. f_equal. + rewrite <- Nat2Z.inj_mul. f_equal. + rewrite <- (Z2Nat.id 1);[|lia]. + rewrite <- Nat2Z.inj_sub. rewrite Nat2Z.id. 2:lia. + simpl. rewrite Nat.sub_0_r. lia. +Qed. + +Definition canRecNew (fs : FrameStack) (r : Redex) : bool := + match fs with + | FParams (IApp (VClos (_ :: _) _ _ _)) _ [] :: _ => + match r with + | RValSeq _ => true + | RBox => true + | _ => false + end + | _ => false + end. + +Definition lastParamRBox (fs : FrameStack) (r : Redex) : (FrameStack * Redex) := + match fs, r with + | FParams ident vl ex :: fs', RValSeq [v] => (FParams ident (vl ++ [v]) ex :: fs', RBox) + | FParams ident vl ex :: fs', RBox => (FParams ident vl ex :: fs', RBox) + | fs', r => (fs', r) + end. + +Fixpoint sequentialStepCanRecNew (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match canRecNew fs r with + | true => lastParamRBox fs r + | false => + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepCanRecNew fs' r' n' + end + end + end. + +Lemma last_param_box_equiv: + forall xs ident v vl fs' r', + ident <> IMap -> + (exists k, ⟨FParams ident (vl ++ [v]) [] :: xs, RBox⟩ -[S k]-> ⟨ fs', r' ⟩) <-> + exists k, ⟨FParams ident vl [] :: xs, RValSeq [v]⟩ -[S k]-> ⟨ fs', r' ⟩. +Proof. + intros. + split;intro. + * destruct H0. inv H0. inv H2. + exists x. econstructor. econstructor. eauto. auto. + * destruct H0. inv H0. inv H2. + exists x. econstructor. econstructor. auto. eauto. auto. +Qed. + +Lemma maxKTransCanRecNew: + forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), + is_result r'' -> + sequentialStepCanRecNew fs r k = (fs', r') -> + (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. + destruct H1. revert H0 H1. revert x fs fs' r r'. + induction k; intros. + + unfold sequentialStepCanRecNew in H0. + destruct (canRecNew fs r) eqn:HCanRec. + - unfold canRecNew in HCanRec. + destruct fs; try discriminate. + destruct f; try discriminate. + destruct ident; try discriminate. + destruct v; try discriminate. + destruct ext; try discriminate. + destruct el; try discriminate. + destruct r; try discriminate. + ** simpl in H0. destruct vs. + ++ inv H0. exists x. auto. + ++ destruct vs. + -- inv H0. destruct x. + *** rewrite maxKZeroRefl in H1. inv H1. + *** exists (S x). + simpl in H1. simpl. + destruct (params =? length (vl ++ [v]));auto. + -- inv H0. exists x. auto. + ** simpl in H0. inv H0. exists x. auto. + - destruct (sequentialStepFunc fs r) eqn:Hssf. 1:destruct p. all:inv H0. all:eexists;eauto. + + simpl in H0. + destruct (canRecNew fs r) eqn:HCanRec. + - unfold canRecNew in HCanRec. + destruct fs; try discriminate. + destruct f; try discriminate. + destruct ident; try discriminate. + destruct v; try discriminate. + destruct ext; try discriminate. + destruct el; try discriminate. + destruct r; try discriminate. + ** simpl in H0. destruct vs. + ++ inv H0. exists x. auto. + ++ destruct vs. + -- inv H0. destruct x. + *** rewrite maxKZeroRefl in H1. inv H1. + *** exists (S x). + simpl in H1. simpl. + destruct (params =? length (vl ++ [v]));auto. + -- inv H0. exists x. auto. + ** simpl in H0. inv H0. + exists x. auto. + - destruct (sequentialStepFunc fs r) eqn:Hssf. + ** destruct p. specialize (IHk _ _ _ _ _ H0 H1). + destruct IHk. exists (S x0). unfold sequentialStepMaxK. rewrite Hssf. + fold sequentialStepMaxK. auto. + ** inv H0. + destruct x. + ++ rewrite maxKZeroRefl in H1. inv H1. exists 0. apply maxKZeroRefl. + ++ unfold sequentialStepMaxK in H1. rewrite Hssf in H1. inv H1. + exists 0. apply maxKZeroRefl. +Qed. + +Goal forall o, o = "true"%string -> o = "true"%string \/ o = "false"%string. Proof. auto. Qed. + +Lemma maxKInsertCanRecNew: + forall (fs : FrameStack) (r r'' : Redex), + is_result r'' -> + (exists n, (let (fs', r') := sequentialStepCanRecNew fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. split; intros. + * destruct (sequentialStepCanRecNew fs r 1000) eqn:Hsscr. + eapply maxKTransCanRecNew; eauto. + * destruct H0. + destruct (sequentialStepCanRecNew fs r 1000) eqn:Hsscr. + remember 1000 as k. clear Heqk. + revert H0 Hsscr. revert fs r f r0 k. + induction x; intros. + + rewrite maxKZeroRefl in H0. inv H0. inv H. + all:destruct k. + all:inv Hsscr. all:exists 0; auto. + + unfold sequentialStepMaxK in H0. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepMaxK in H0. + destruct k. + ** simpl in Hsscr. + destruct (canRecNew fs r) eqn:HCanRec. + ++ unfold canRecNew in HCanRec. + destruct fs; try discriminate. + destruct f1; try discriminate. + destruct ident; try discriminate. + destruct v; try discriminate. + destruct ext; try discriminate. + destruct el; try discriminate. destruct r; try discriminate. + -- simpl in Hsscr. destruct vs. + *** inv Hsscr. + *** destruct vs. + +++ inv Hsscr. + exists (S x). simpl. + simpl in Hssf. + destruct (params =? length (vl ++ [v])); inv Hssf; auto. + +++ inv Hsscr. + -- simpl in Hsscr. inv Hsscr. + exists (S x). unfold sequentialStepMaxK. + rewrite Hssf. fold sequentialStepMaxK. auto. + ++ rewrite Hssf in Hsscr. inv Hsscr. exists (S x). + unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. + ** simpl in Hsscr. + destruct (canRecNew fs r) eqn:HCanRec. + ++ unfold canRecNew in HCanRec. + destruct fs; try discriminate. + destruct f1; try discriminate. + destruct ident; try discriminate. + destruct v; try discriminate. + destruct ext; try discriminate. + destruct el; try discriminate. + destruct r; try discriminate. + -- simpl in Hsscr. destruct vs. + *** inv Hsscr. + *** destruct vs. + +++ inv Hsscr. + exists (S x). unfold sequentialStepMaxK. simpl. simpl in Hssf. + rewrite Hssf. fold sequentialStepMaxK. auto. + +++ inv Hsscr. + -- simpl in Hsscr. inv Hsscr. exists (S x). + unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. + ++ rewrite Hssf in Hsscr. + specialize (IHx _ _ _ _ _ H0 Hsscr). auto. + - inv H0. + destruct k. + ** unfold sequentialStepCanRecNew in Hsscr. + destruct (canRecNew [] r'') eqn:HCanRec. + ++ simpl in HCanRec. discriminate. + ++ rewrite Hssf in Hsscr. inv Hsscr. exists 0. apply maxKZeroRefl. + ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. + all:exists 0; auto. +Qed. + +Definition timestwo (e : Exp) : Exp := + ELetRec [ + (1, °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 1; ˝VLit 2%Z] + + ) + ] (EApp (˝VFunId (0, 1)) [e]). + +Definition timestwo' (e : Exp) : Exp := + °ECall (˝erlang) (˝VLit "*"%string) [e; ˝VLit 2%Z]. + +Theorem timestwo_ex: + forall (z : nat), + exists (y : Z), + ⟨ [], (timestwo (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Theorem timestwo'_ex: + forall (z : nat), + exists (y : Z), + ⟨ [], (timestwo' (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition times_two_simple (e : Exp) : Exp := + (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "*"%string))) [e;(VVal (VLit (Integer (2))))])). + +Theorem times_two_simple_ex: + forall (z : nat), + exists (y : Z), + ⟨ [], (times_two_simple (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition times_two_rec (e : Exp) : Exp := ELetRec [ +(1, (EExp (ECase (VVal (VVar 1)) +[ + ([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0))))); + ([PVar], (VVal (VLit (Atom "true"%string))), + (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) + (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VVar 0))]));(VVal (VLit (Integer (2))))])))))])))] + +(EApp (VVal (VFunId (0, 1))) [e]). + +Theorem times_two_rec_ex: + forall (z : nat), + exists (y : Z), + ⟨ [], (times_two_rec (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition plus_nums_simple (e f : Exp) : Exp := +(EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [e;f])). + +Theorem plus_nums_simple_ex: + forall (z : nat) (z' : nat), + exists (y : Z), + ⟨ [], (plus_nums_simple (˝VLit (Z.of_nat z)) (˝VLit (Z.of_nat z'))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z + Z.of_nat z')%Z. +Proof. + solve_symbolically z. +Qed. + +Definition plus_nums_rec (e f : Exp) : Exp := +ELetRec [ +(2, (EExp (ECase (VVal (VVar 1)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VVar 2)));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VVar 0));(VVal (VVar 8))]));(VVal (VLit (Integer (1))))])))))]))) +] (EApp (VVal (VFunId (0, 2))) [e;f]). + +Theorem plus_nums_rec_ex: + forall (z : nat) (z' : nat), + exists (y : Z), + ⟨ [], (plus_nums_rec (˝VLit (Z.of_nat z)) (˝VLit (Z.of_nat z'))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z + Z.of_nat z')%Z. +Proof. + setoid_rewrite RTCEquiv;[|constructor]. + toRec. + + induction z using lt_wf_ind; intros. + destruct z. + * repeat stepThousand. solve_terminated. + * admit. +Admitted. + +Definition isitzero_atom (e : Exp) : Exp := +(EExp (ECase (e) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "true"%string))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "false"%string))))])). + +Theorem isitzero_atom_ex: + forall (z : nat), + exists (y : string), + ⟨ [], (isitzero_atom (˝VLit (Z.of_nat (S z)))) ⟩ -->* RValSeq [VLit y] /\ (y = "false"%string)%Z. +Proof. + solve_symbolically z. auto. +Qed. + +Definition isitzero_num (e : Exp) : Exp := +(EExp (ECase (e) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (1)))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0)))))])). + +Theorem isitzero_num_ex: + forall (z : nat), + exists (y : Z), + ⟨ [], (isitzero_num (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((y = 0)%Z \/ (y = 1)%Z). +Proof. + setoid_rewrite RTCEquiv;[|constructor]. + intros z. + stepOne. stepOne. stepOne. + case_innermost. + * stepThousand. solve_terminated. + * stepThousand. solve_terminated. + + (*solve_symbolically z.*) +Qed. + +Definition isitzero_num_app (e : Exp) : Exp := +EExp ( EApp ( EFun 1 (EExp (ECase (VVal (VVar 0)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (1)))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0)))))]))) [e]). + +Theorem isitzero_num_app_ex: + forall (z : Z), + exists (y : Z), + ⟨ [], (isitzero_num_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ ((y = 0)%Z \/ (y = 1)%Z). +Proof. + setoid_rewrite RTCEquiv;[|constructor]. + intros z. + stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. + case_innermost. + * stepOne. stepOne. stepOne. stepOne. solve_terminated. exact 0. + * stepOne. stepOne. stepOne. stepOne. stepOne. solve_terminated. exact 0. + + (*solve_symbolically z.*) +Qed. + +Definition isitzero_atom_app (e : Exp) : Exp := +EExp ( EApp ( EFun 1(EExp (ECase (VVal (VVar 0)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "true"%string))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "false"%string))))]))) [e]). + +Theorem isitzero_atom_app_ex: + forall (z : Z), (z > 0)%Z -> + exists (y : string), + ⟨ [], (isitzero_atom_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = "false"%string). +Proof. + setoid_rewrite RTCEquiv;[|constructor]. + intros. unfold isitzero_atom_app. + stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. + case_innermost. + * lia. + * stepOne. stepOne. stepOne. stepOne. stepOne. solve_terminated. exact 0. auto. +Qed. + +Theorem timestwo_ex': + forall (z : Z), + exists (y : Z), + ⟨ [], (times_two_simple (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + setoid_rewrite RTCEquiv;[|constructor]. unfold times_two_simple. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + intros. solve_terminated. exact 0. +Qed. + +Print EFun. + +Definition times_two_simple_app (e : Exp) : Exp := + EExp (EApp (EExp (EFun 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "*"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (2))))])))) [e]). + +Theorem timestwo_ex'': + forall (z : Z), + exists (y : Z), + ⟨ [], (times_two_simple_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + setoid_rewrite RTCEquiv;[|constructor]. unfold times_two_simple_app. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. cbn. + stepOne. + intros. solve_terminated. exact 0. +Qed. + +Theorem timestwo_ex''': + forall (z : nat), + exists (y : Z), + ⟨ [], (times_two_rec (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = (Z.of_nat z) * 2)%Z. +Proof. + setoid_rewrite RTCEquiv;[|constructor]. unfold times_two_rec. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. setoid_rewrite <- jesus_christ';auto. simpl. + induction z using lt_wf_ind. + destruct z. + * do 7 stepOne. do 1 stepOne. solve_terminated. exact 0. + * do 30 stepOne. setoid_rewrite <- jesus_christ';auto. simpl. + specialize (H z). assert (z < S z) by lia. apply H in H0. clear H. + destruct H0. destruct H. + eapply frame_indep_core_func with (fsapp := [FParams (ICall (VLit "erlang"%string) (VLit "+"%string)) [] [˝ VLit 2%Z]]) in H. simpl in H. + eexists. eapply maxKTransitive'. assert (Z.of_nat (S z) - 1 = Z.of_nat z)%Z by lia. rewrite H1. eauto. + + do 3 stepOne. cbn. admit. + +(* stepOne. + stepOne. + stepOne. + stepOne. intros z. case_innermost. repeat stepThousand. solve_terminated. exact 0. + do 29 stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + stepOne. + *) +Abort. + +Ltac my_tac args := + lazymatch args with + | (?a, ?rest) => + (* first argument is a *) + (* rest is the remaining arguments *) + (* do something with a ... *) + revert rest; + my_tac a + | (?only) => revert only + end. + +Theorem asd: forall (a s d f : nat), (a = a) /\ (s = s) /\ (d = d) /\ (f = f) /\ True. +Proof. +intros. +Compute (a,s,d,f). +my_tac (a,s,d,f). auto. Qed. + +Theorem timestwo_ex''': + forall (z : nat), + exists (y : Z), + ⟨ [], (plus_nums_rec (˝VLit (Z.of_nat z)) (˝VLit 0%Z)) ⟩ -->* RValSeq [VLit y] /\ (y = (Z.of_nat z))%Z. +Proof. + setoid_rewrite RTCEquiv;[|constructor]. + do 8 stepOne. +Admitted. + + +Definition plus_nums_rec' (e f : Exp) := ELetRec [(2, (EExp (ECase (VVal (VVar 1)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VVar 2)));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 4));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (3, 2))) [(VVal (VVar 1));(VVal (VVar 0))])))))))])))] (EApp (VVal (VFunId (0, 2))) [e;f]). + +Theorem plus_nums_rec_ex': + forall (z : nat), + exists (y : Z), + ⟨ [], (plus_nums_rec' (˝VLit (Z.of_nat z)) (˝VLit 0%Z)) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z)%Z. +Proof. +setoid_rewrite RTCEquiv;[|constructor]. +do 8 stepOne. setoid_rewrite <- jesus_christ'; auto. simpl. +induction z using lt_wf_ind. +destruct z. stepThousand. solve_terminated. exact 0. +do 38 stepOne. setoid_rewrite <- jesus_christ'; auto. simpl. +Admitted. + +Theorem helper: + forall fs fs' + + + + + + + + + + + + diff --git a/src/Symbolic/Symbolic.v b/src/Symbolic/Symbolic.v index aeb5fe2e..b2e11789 100644 --- a/src/Symbolic/Symbolic.v +++ b/src/Symbolic/Symbolic.v @@ -708,7 +708,7 @@ Proof. induction z. * simpl. eexists. split;[exists 0;reflexivity|nia]. * setoid_rewrite asd. simpl. setoid_rewrite <- ssmkInnerSimplEquiv. - toPotentialRec. setoid_rewrite ssmkInnerSimplEquiv. unfold eval_arith_NEW. simpl. + toPotentialRec. setoid_rewrite ssmkInnerSimplEquiv. cbn. remember (IApp _). setoid_rewrite <- ssmkInnerSimplEquiv. setoid_rewrite ssmkInnerOuter;[|constructor]. @@ -1023,10 +1023,25 @@ Proof. eapply transitive_eval; eauto. Qed. +Lemma maxKDone: + forall (r r' : Redex), + is_result r' -> + (exists n : nat, ([] : FrameStack, r') = ([], r)) <-> + (exists n, sequentialStepMaxK [] r' n = ([], r)). +Proof. + intros. split;intro. + * destruct H0. inv H0. setoid_rewrite <- RTCEquiv;[|auto]. + econstructor. split. auto. constructor. + * destruct H0. destruct x. + + rewrite maxKZeroRefl in H0. exists 0. auto. + + inv H; simpl in H0; exists 0; auto. +Qed. + Ltac toRec := match goal with | |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => - try (setoid_rewrite <- maxKInsertCanRec;[|constructor]);simpl + try (setoid_rewrite <- maxKInsertCanRec;[|constructor]);simpl; + try (setoid_rewrite <- maxKDone;[|constructor]) | _ => idtac "nothing to do" end. @@ -1061,7 +1076,7 @@ Proof. (* 1. We need to figure out what to do the induction on: the variable wrapped inside the Redex *) induction z. - * repeat stepThousand. + * repeat stepThousand. (* 2. Is there a way to get "y" to be a "nat" as well? I was having problems with that... *) repeat eexists. exact 0. nia. * toNextRec. @@ -1135,7 +1150,7 @@ Ltac solve_final_postcond := Ltac solve_terminated := lazymatch goal with - | |- context[sequentialStepMaxK] => fail + | |- context[sequentialStepMaxK] => fail "The program has not yet terminated" | |- _ => lazymatch goal with | |- ex _ => eexists;solve_terminated @@ -1149,7 +1164,7 @@ Ltac give_steps_if_needed_using steptac := | steptac ]. -Ltac match_with_backfall backfall steptac := +Ltac match_with_backfall backfall := lazymatch goal with | |- context[match ?x with _ => _ end] => case_innermost; @@ -1158,32 +1173,134 @@ Ltac match_with_backfall backfall steptac := | |- _ => fail "Match expression not found" end. +Ltac able_to_ind := + lazymatch goal with + | |- context[sequentialStepMaxK ?fs ?r] => + let b := eval compute in (canRec fs r) in + lazymatch b with + | true => idtac + | false => fail + end + | |- _ => fail + end. + +(* +Fixpoint Exp_list_eqb (le1 le2 : list Exp) : bool := + match le1, le2 with + | [], [] => true + | [], _ :: _ => false + | _ :: _, [] => false + | e1 :: le1', e2 :: le2' => andb (Exp_eqb_strict e1 e2) (Exp_list_eqb le1' le2') + end. + +Fixpoint Val_list_eqb (lv1 lv2 : list Val) : bool := + match lv1, lv2 with + | [], [] => true + | [], _ :: _ => false + | _ :: _, [] => false + | v1 :: lv1', v2 :: lv2' => andb (Val_eqb_strict v1 v2) (Val_list_eqb lv1' lv2') + end. + +Fixpoint Pat_list_eqb (lp1 lp2 : list Pat) : bool := + match lp1, lp2 with + | [], [] => true + | [], _ :: _ => false + | _ :: _, [] => false + | p1 :: lp1', p2 :: lp2' => andb (Pat_eqb p1 p2) (Pat_list_eqb lp1' lp2') + end. + +Fixpoint FCase1_eqb (l1 l2 : list (list Pat * Exp * Exp)) : bool := + match l1, l2 with + | [], [] => true + | [], _ :: _ => false + | _ :: _, [] => false + | (lp1, e1, e1') :: l1', (lp2, e2, e2') :: l2' => + andb (Pat_list_eqb lp1 lp2) (andb (Exp_eqb_strict e1 e2) (andb (Exp_eqb_strict e1' e2') (FCase1_eqb l1' l2'))) + end. + +Print FrameIdent. +Definition FrameIdent_eqb (fi1 fi2 : FrameIdent) : bool := + match fi1, fi2 with + | IValues, IValues => true + | ITuple, ITuple => true + | IMap, IMap => true + | ICall v1 v1', ICall v2 v2' => andb (Val_eqb_strict v1 v2) (Val_eqb_strict v1' v2') + | IPrimOp s1, IPrimOp s2 => String.eqb s1 s2 + | IApp v1, IApp v2 => Val_eqb_strict v1 v2 + | _, _ => false + end. + +Print Frame. +Definition Frame_eqb (f1 f2 : Frame) : bool := + match f1, f2 with + | FCons1 e1, FCons1 e2 => Exp_eqb_strict e1 e2 + | FCons2 v1, FCons2 v2 => Val_eqb_strict v1 v2 + | FParams fi1 vl1 el1, FParams fi2 vl2 el2 => + andb (FrameIdent_eqb fi1 fi2) (andb (Val_list_eqb vl1 vl2) (Exp_list_eqb el1 el2)) + | FApp1 el1, FApp1 el2 => Exp_list_eqb el1 el2 + | FCallMod e1 el1, FCallMod e2 el2 => andb (Exp_eqb_strict e1 e2) (Exp_list_eqb el1 el2) + | FCallFun v1 el1, FCallFun v2 el2 => andb (Val_eqb_strict v1 v2) (Exp_list_eqb el1 el2) + | FCase1 l1, FCase1 l2 => FCase1_eqb l1 l2 + | FCase2 vl1 e1 l1, FCase2 vl2 e2 l2 => + andb (Val_list_eqb vl1 vl2) (andb (Exp_eqb_strict e1 e2) (FCase1_eqb l1 l2)) + | FLet n1 e1, FLet n2 e2 => andb (Nat.eqb n1 n2) (Exp_eqb_strict e1 e2) + | FSeq e1, FSeq e2 => Exp_eqb_strict e1 e2 + | FTry n1 e1 n1' e1', FTry n2 e2 n2' e2' => + andb (Nat.eqb n1 n2) (andb (Exp_eqb_strict e1 e2) (andb (Nat.eqb n1' n2') (Exp_eqb_strict e1' e2'))) + | _, _ => false + end. +Fixpoint FrameStack_prefix (fs1 fs2 : FrameStack) : bool := + match fs1, fs2 with + | [], _ => true + | f1 :: fs1', f2 :: fs2' => andb (Frame_eqb f1 f2) (FrameStack_prefix fs1' fs2') + | _, _ => false + end.*) + +Ltac base_case := + stepThousand; + first [ solve_terminated + | match_with_backfall base_case + | base_case]. + +Ltac ind_case := idtac. + +Ltac induction_head symb := + let n := fresh "n" in + let IH := fresh "IH" in + induction symb as [n IH] using lt_wf_ind; + let Hn := fresh "Hn" in + destruct n eqn:Hn; + [base_case|ind_case]. + +Ltac solve_to_rec symb := + toRec; + first [ solve_terminated + | able_to_ind; induction_head symb + | match_with_backfall solve_to_rec + | solve_to_rec]. + +Ltac solve_symbolically symb := + first [ intros; setoid_rewrite RTCEquiv;[|constructor]; solve_to_rec symb + | fail "Could not solve goal symbolically" + ]. Theorem fact_eval_ex': forall (z : nat), exists (y : Z), ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y /\ y >= 1)%Z. Proof. - intros. - setoid_rewrite RTCEquiv;[|constructor]. - - toRec. - - induction z using lt_wf_ind. + solve_symbolically z. + + toNextRec. cbn. + try rewrite NatZSuccPred. + specialize (IH n0 (Nat.lt_succ_diag_r _)). + destruct IH as [y [IHExp IHPostcond]]. - destruct z eqn:Hz. - + repeat stepThousand. - solve_terminated. - + toNextRec. cbn. - try rewrite NatZSuccPred. - specialize (H n (Nat.lt_succ_diag_r _)). - destruct H as [y [IHExp IHPostcond]]. - - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. simpl in IHExp_fic. - eexists. eapply maxKTransitive'. auto. - repeat stepThousand. - solve_terminated. + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. simpl in IHExp_fic. + eexists. eapply maxKTransitive'. auto. + repeat stepThousand. + solve_terminated. Qed. Theorem fact_eval_ex'': @@ -1191,27 +1308,28 @@ Theorem fact_eval_ex'': exists (y : Z), ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z))%Z. Proof. - intros. - setoid_rewrite RTCEquiv;[|constructor]. - - toRec. - - induction z using lt_wf_ind. + solve_symbolically z. + + toNextRec. cbn. + try rewrite NatZSuccPred. + specialize (IH n0 (Nat.lt_succ_diag_r _)). + destruct IH as [y [IHExp IHPostcond]]. - destruct z eqn:Hz. - + repeat stepThousand. - solve_terminated. - + toNextRec. cbn. - try rewrite NatZSuccPred. - specialize (H n (Nat.lt_succ_diag_r _)). - destruct H as [y [IHExp IHPostcond]]. - - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. simpl in IHExp_fic. - eexists. eapply maxKTransitive'. auto. - repeat stepThousand. - solve_terminated. + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. simpl in IHExp_fic. + eexists. eapply maxKTransitive'. auto. + repeat stepThousand. + solve_terminated. Qed. +Theorem fact_eval : forall n, + ⟨[], fact_frameStack (˝VLit (Z.of_nat n))⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. +Proof. + intros. + pose proof fact_eval_ex'' n. + destruct H. destruct H. subst x. auto. +Qed. + + From 574971fe2cd67772a9ac535ef47f55d844eba844 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Fri, 12 Dec 2025 01:01:16 +0100 Subject: [PATCH 10/20] The tactics are finalized, but the directory structure is not yet. --- src/Symbolic/Symb.v | 89 +++- src/Symbolic/SymbFinal.v | 1004 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 1092 insertions(+), 1 deletion(-) create mode 100644 src/Symbolic/SymbFinal.v diff --git a/src/Symbolic/Symb.v b/src/Symbolic/Symb.v index db5ebbc3..75ebc1cb 100644 --- a/src/Symbolic/Symb.v +++ b/src/Symbolic/Symb.v @@ -870,7 +870,6 @@ Proof. eexists. Print maxKTransitive'. eapply maxKTransitive'. auto. - shelve. repeat stepThousand. solve_terminated. subst y. Search Z.of_nat "_ * _". @@ -1067,6 +1066,94 @@ Proof. all:exists 0; auto. Qed. +Theorem tailrec_fact_eval_ex'''': + forall (z : Z) (z' : Z), (0 <= z)%Z -> + exists (y : Z), + ⟨ [], (tailrec_fact (˝VLit z) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z)) * z')%Z. +Proof. + setoid_rewrite RTCEquiv;[|constructor]. + toRec. do 2 stepOne. setoid_rewrite <- jesus_christ';auto. simpl. + intros z z' IHPreCond. + assert (0 <= z)%Z by lia. revert z'. revert IHPreCond. + apply Zlt_0_ind with (x := z);auto. clear H z. intros z. intros IH. intros a. intros. + destruct z;try nia. + * repeat stepThousand. solve_terminated. exact 0. + * stepOne. toRec. cbn. do 11 stepOne. cbn. setoid_rewrite <- jesus_christ';auto. simpl. + specialize (IH (Z.pos p - 1)%Z). + assert (0 <= Z.pos p - 1 < Z.pos p)%Z by lia. + specialize (IH H). clear H. + assert (0 <= Z.pos p - 1)%Z by lia. + specialize (IH H). clear H. + + destruct H as [y [IHExp IHPostcond]]. + + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. + simpl in IHExp_fic. + + eexists. + eapply maxKTransitive'. auto. + repeat stepThousand. solve_terminated. exact 0. + + + + subst y. + rewrite Z.mul_assoc. f_equal. + rewrite <- positive_nat_Z at 2. + rewrite <- Nat2Z.inj_mul. + f_equal. + rewrite Z2Nat.inj_sub;try nia. + assert (Z.to_nat 1%Z = 1) by lia. rewrite H. clear H. + rewrite Z2Nat.inj_pos. + Search Pos.to_nat "_ - _". + assert (1 = Pos.to_nat (Pos.of_nat 1)) by lia. + rewrite H. clear H. + destruct p. + + rewrite <- Pos2Nat.inj_sub; try lia. + assert (Pos.of_nat 1 = 1%positive) by lia. rewrite H. clear H. + rewrite Pos.sub_1_r. + assert (Pos.pred p~1 = p~0)%positive by lia. rewrite H. clear H. + remember (Pos.to_nat p~0) as k. + assert (Pos.to_nat p~1 = S k) by lia. rewrite H. clear H. clear Heqk. + unfold fact at 2. fold fact. rewrite Nat.mul_comm. reflexivity. + + rewrite <- Pos2Nat.inj_sub; try lia. + assert (Pos.of_nat 1 = 1%positive) by lia. rewrite H. clear H. + rewrite Pos.sub_1_r. + remember (Pos.to_nat (Pos.pred p~0)) as k. + assert (Pos.to_nat p~0 = S k) by lia. rewrite H. clear H. + unfold fact at 2. fold fact. rewrite Nat.mul_comm. reflexivity. + + simpl. nia. +Qed. + +Theorem fact_eval_ex''': + forall (z : Z), (0 <= z)%Z -> + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (z <= y /\ y >= 1)%Z. +Proof. + setoid_rewrite RTCEquiv;[|auto]. + toRec. setoid_rewrite <- jesus_christ';auto. simpl. + intros z HPreCond. + assert (0 <= z)%Z by lia. revert HPreCond. + Print Zlt_0_ind. + apply Zlt_0_ind with (x := z);try nia. + intros. + destruct x; try nia. + * repeat stepThousand. solve_terminated. exact 0. + * stepOne. toRec. setoid_rewrite <- jesus_christ';auto. simpl. + specialize (H0 (Z.pos p - 1)%Z). + assert (0 ≤ Z.pos p - 1 < Z.pos p)%Z by lia. specialize (H0 H2). clear H2. + (* specialize H0 by the rest of the symb vars... *) + assert (0 ≤ Z.pos p - 1)%Z by lia. specialize (H0 H2). clear H2. + + destruct H0 as [y [IHExp IHPostcond]]. + + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. + simpl in IHExp_fic. + + eexists. + eapply maxKTransitive'. auto. + repeat stepThousand. solve_terminated. exact 0. +Qed. + Definition timestwo (e : Exp) : Exp := ELetRec [ (1, °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 1; ˝VLit 2%Z] diff --git a/src/Symbolic/SymbFinal.v b/src/Symbolic/SymbFinal.v new file mode 100644 index 00000000..5066296d --- /dev/null +++ b/src/Symbolic/SymbFinal.v @@ -0,0 +1,1004 @@ +From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. +From CoreErlang.Interpreter Require Import StepFunctions Equivalences. + +Import ListNotations. + +(* ----- DEFINITIONS ----- *) + +Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepMaxK fs' r' n' + end + end. + +Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := + match n with + | 0 => Some (fs, r) + | S n' => + match sequentialStepFunc fs r with + | Some (fs', r') => sequentialStepK fs' r' n' + | None => None + end + end. + +Definition canRec (fs : FrameStack) (r : Redex) : bool := + match fs with + | FParams (IApp (VClos (_ :: _) _ _ _)) _ [] :: _ => + match r with + | RValSeq _ => true + | RBox => true + | _ => false + end + | _ => false + end. + +Definition lastParamRBox (fs : FrameStack) (r : Redex) : (FrameStack * Redex) := + match fs, r with + | FParams ident vl ex :: fs', RValSeq [v] => (FParams ident (vl ++ [v]) ex :: fs', RBox) + | FParams ident vl ex :: fs', RBox => (FParams ident vl ex :: fs', RBox) + | fs', r => (fs', r) + end. + +Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match canRec fs r with + | true => lastParamRBox fs r + | false => + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepCanRec fs' r' n' + end + end + end. + +Arguments sequentialStepMaxK !_ !_ !_ /. +Arguments sequentialStepK !_ !_ !_ /. +Arguments sequentialStepCanRec !_ !_ !_ /. + +(* ----- LEMMAS ----- *) + +Lemma maxKZeroRefl: + forall (fs : FrameStack) (r : Redex), + sequentialStepMaxK fs r 0 = (fs, r). +Proof. + intros. unfold sequentialStepMaxK. + destruct (sequentialStepFunc fs r). + 1:destruct p. all:reflexivity. +Qed. + +Lemma maxKForwardOne: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, sequentialStepMaxK fs r (S n) = ([], r')) <-> + exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (S x). auto. + * destruct H0. destruct x. + + exists 0. + rewrite maxKZeroRefl in H0. inv H0. + inv H. all:auto. + + exists x. auto. +Qed. + +Lemma maxKOverflow: + forall (fs : FrameStack) (r r' : Redex) (n m : nat), + is_result r' -> + n <= m -> + sequentialStepMaxK fs r n = ([], r') -> + sequentialStepMaxK fs r m = ([], r'). +Proof. + intros fs r r' n. revert fs r r'. + induction n; intros. + * destruct m. + + auto. + + rewrite maxKZeroRefl in H1. inv H1. + inv H. all:auto. + * destruct m. + + inv H0. + + unfold sequentialStepMaxK in H1|-*. + destruct (sequentialStepFunc fs r). + 1:destruct p; fold sequentialStepMaxK. + all:fold sequentialStepMaxK in H1. + - apply IHn; auto. lia. + - auto. +Qed. + +Lemma maxKForwardThousand: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, sequentialStepMaxK fs r (1000 + n) = ([], r')) <-> + exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (1000 + x). auto. + * destruct H0. + exists x. + apply (maxKOverflow _ _ _ x); auto. lia. +Qed. + +Lemma maxKEquivK: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, sequentialStepK fs r n = Some (fs', r')) <-> + (exists n, sequentialStepMaxK fs r n = (fs', r')). +Proof. + intros. split;intro. + * destruct H. exists x. + revert H. revert fs r. + induction x; intros. + + unfold sequentialStepK in *. inv H. + rewrite maxKZeroRefl. auto. + + unfold sequentialStepMaxK. + unfold sequentialStepK in H. + destruct (sequentialStepFunc fs r). + 1:destruct p. + all:fold sequentialStepMaxK. all:fold sequentialStepK in H. + all:auto. inv H. + * destruct H. revert H. revert fs r. + induction x; intros. + + rewrite maxKZeroRefl in H. inv H. exists 0. + unfold sequentialStepK. reflexivity. + + unfold sequentialStepMaxK in H. + destruct (sequentialStepFunc fs r) eqn:Hssf; fold sequentialStepMaxK in H. + - destruct p. + apply IHx in H. destruct H. exists (S x0). + unfold sequentialStepK. rewrite Hssf. fold sequentialStepK. + auto. + - inv H. exists 0. unfold sequentialStepK. reflexivity. +Qed. + +Lemma kEquiv: + forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), + ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> sequentialStepK fs r k = Some (fs', r'). +Proof. + intros. split;revert fs fs' r r'. + * induction k; intros. + + inv H. unfold sequentialStepK. auto. + + inv H. unfold sequentialStepK. + apply sequentialStepEquiv in H1. rewrite H1. + fold sequentialStepK. auto. + * induction k; intros. + + unfold sequentialStepK in H. inv H. constructor. + + unfold sequentialStepK in H. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepK in H. + apply sequentialStepEquiv in Hssf. + econstructor; eauto. + - inv H. +Qed. + +Theorem RTCEquiv: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + ⟨ fs, r ⟩ -->* r' <-> exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros fs r r' Hres. split; intros. + * inv H. destruct H0. + apply kEquiv in H0. + apply maxKEquivK. + exists x. auto. + * apply maxKEquivK in H. + destruct H. econstructor. split;[auto|]. + apply kEquiv. eauto. +Qed. + +Lemma canRecUnfold: + forall (fs : FrameStack) (r : Redex), + canRec fs r = true -> + exists ext_top ext' id params e vl fs', + (fs = FParams (IApp (VClos (ext_top :: ext') id params e)) vl [] :: fs') /\ + ((exists vseq, r = RValSeq vseq) \/ (r = RBox)). +Proof. + intros. unfold canRec in H. + destruct fs; try discriminate. destruct f; try discriminate. destruct ident; try discriminate. + destruct v; try discriminate. destruct ext; try discriminate. destruct el; try discriminate. + destruct r; try discriminate. + * do 8 eexists. 1:reflexivity. left. eexists. reflexivity. + * do 8 eexists. 1:reflexivity. right. reflexivity. +Qed. + +Lemma maxKTransCanRec: + forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), + is_result r'' -> + sequentialStepCanRec fs r k = (fs', r') -> + (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. + destruct H1. revert H0 H1. revert x fs fs' r r'. + induction k; intros. + + unfold sequentialStepCanRec in H0. + destruct (canRec fs r) eqn:HCanRec. + - apply canRecUnfold in HCanRec. + destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. + * subst. simpl in H0. destruct vs. + ++ inv H0. exists x. auto. + ++ destruct vs. + -- inv H0. destruct x. + ** rewrite maxKZeroRefl in H1. inv H1. + ** exists (S x). + simpl in H1. simpl. + destruct (params =? length (vl ++ [v]));auto. + -- inv H0. exists x. auto. + * subst. simpl in H0. inv H0. exists x. auto. + - destruct (sequentialStepFunc fs r) eqn:Hssf. 1:destruct p. all:inv H0. all:eexists;eauto. + + simpl in H0. + destruct (canRec fs r) eqn:HCanRec. + - apply canRecUnfold in HCanRec. + destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. + * subst. simpl in H0. destruct vs. + ++ inv H0. exists x. auto. + ++ destruct vs. + -- inv H0. destruct x. + ** rewrite maxKZeroRefl in H1. inv H1. + ** exists (S x). + simpl in H1. simpl. + destruct (params =? length (vl ++ [v]));auto. + -- inv H0. exists x. auto. + * subst. simpl in H0. inv H0. exists x. auto. + - destruct (sequentialStepFunc fs r) eqn:Hssf. + ** destruct p. + unfold sequentialStepCanRec in H0. rewrite HCanRec in H0. rewrite Hssf in H0. + fold sequentialStepCanRec in H0. + specialize (IHk _ _ _ _ _ H0 H1). + destruct IHk. exists (S x0). unfold sequentialStepMaxK. rewrite Hssf. + fold sequentialStepMaxK. auto. + ** inv H0. + destruct x. + ++ rewrite maxKZeroRefl in H1. inv H1. exists 0. + unfold sequentialStepCanRec in H3. rewrite HCanRec in H3. rewrite Hssf in H3. inv H3. + apply maxKZeroRefl. + ++ unfold sequentialStepMaxK in H1. + unfold sequentialStepCanRec in H3. + rewrite HCanRec in H3. rewrite Hssf in H3. inv H3. + rewrite Hssf in H1. inv H1. + exists 0. apply maxKZeroRefl. +Qed. + +Lemma maxKInsertCanRecGeneral: + forall (fs : FrameStack) (r r'' : Redex) (k : nat), + is_result r'' -> + (exists n, (let (fs', r') := sequentialStepCanRec fs r k in sequentialStepMaxK fs' r' n) = ([], r'')) <-> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. split; intros. + * destruct (sequentialStepCanRec fs r k) eqn:Hsscr. + eapply maxKTransCanRec; eauto. + * destruct H0. + destruct (sequentialStepCanRec fs r k) eqn:Hsscr. + revert H0 Hsscr. revert fs r f r0 k. + induction x; intros. + + rewrite maxKZeroRefl in H0. inv H0. inv H. + all:destruct k. + all:inv Hsscr. all:exists 0; auto. + + unfold sequentialStepMaxK in H0. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepMaxK in H0. + destruct k. + ** simpl in Hsscr. + destruct (canRec fs r) eqn:HCanRec. + ++ apply canRecUnfold in HCanRec. + destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. + -- subst. simpl in Hsscr. destruct vs. + *** inv Hsscr. + *** destruct vs. + +++ inv Hsscr. + exists (S x). simpl. + simpl in Hssf. + destruct (params =? length (vl ++ [v])); inv Hssf; auto. + +++ inv Hsscr. + -- subst. simpl in Hsscr. inv Hsscr. + exists (S x). unfold sequentialStepMaxK. + rewrite Hssf. fold sequentialStepMaxK. auto. + ++ unfold sequentialStepCanRec in Hsscr. rewrite HCanRec in Hsscr. + rewrite Hssf in Hsscr. inv Hsscr. exists (S x). + unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. + ** simpl in Hsscr. + destruct (canRec fs r) eqn:HCanRec. + ++ apply canRecUnfold in HCanRec. + destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. + -- subst. simpl in Hsscr. destruct vs. + *** inv Hsscr. + *** destruct vs. + +++ inv Hsscr. + exists (S x). unfold sequentialStepMaxK. simpl. simpl in Hssf. + rewrite Hssf. fold sequentialStepMaxK. auto. + +++ inv Hsscr. + -- subst. simpl in Hsscr. inv Hsscr. exists (S x). + unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. + ++ unfold sequentialStepCanRec in Hsscr. rewrite HCanRec in Hsscr. + rewrite Hssf in Hsscr. + specialize (IHx _ _ _ _ _ H0 Hsscr). auto. + - inv H0. + destruct k. + ** unfold sequentialStepCanRec in Hsscr. + destruct (canRec [] r'') eqn:HCanRec. + ++ simpl in HCanRec. discriminate. + ++ rewrite Hssf in Hsscr. inv Hsscr. exists 0. apply maxKZeroRefl. + ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. + all:exists 0; auto. +Qed. + +Lemma maxKInsertCanRec: + forall (fs : FrameStack) (r r'' : Redex), + is_result r'' -> + (exists n, (let (fs', r') := sequentialStepCanRec fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros fs r r''. + exact (maxKInsertCanRecGeneral fs r r'' 1000). +Qed. + +Theorem frame_indep_core_func: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + forall (fsapp : FrameStack), (exists n, sequentialStepMaxK (fs ++ fsapp) r n = (fs' ++ fsapp, r')). +Proof. + intros. + apply maxKEquivK. apply maxKEquivK in H. + destruct H. apply kEquiv in H. + exists x. apply kEquiv. apply frame_indep_core. auto. +Qed. + +Theorem maxKTransitive: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + (exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) -> + (exists n, sequentialStepMaxK fs r n = (fs'', r'')). +Proof. + setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. + destruct H, H0. exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +Lemma maxKDone: + forall (r r' : Redex), + is_result r' -> + (exists n : nat, ([] : FrameStack, r') = ([], r)) <-> + (exists n, sequentialStepMaxK [] r' n = ([], r)). +Proof. + intros. split;intro. + * destruct H0. inv H0. setoid_rewrite <- RTCEquiv;[|auto]. + econstructor. split. auto. constructor. + * destruct H0. destruct x. + + rewrite maxKZeroRefl in H0. exists 0. auto. + + inv H; simpl in H0; exists 0; auto. +Qed. + +Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. +Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. + +Theorem maxKTransitive': + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (P : Prop), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + ((exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) /\ P) -> + ((exists n, sequentialStepMaxK fs r n = (fs'', r'')) /\ P). +Proof. + setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. + destruct H, H0, H0. + split;auto. + exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +(* ----- TACTICS ----- *) + +Ltac contains_match := + lazymatch goal with + | |- context[match _ with _ => _ end] => idtac + | |- _ => fail + end. + +Ltac possibly_recursive := + lazymatch goal with + | |- context[FParams (IApp (VClos (_ :: _) _ _ _)) _ [] :: _] => idtac + | |- _ => fail + end. + +Ltac case_innermost_term t Heq := + lazymatch t with + | context[match ?x with _ => _ end] => + first [ case_innermost_term x Heq + | destruct x eqn:Heq; + first [apply Z_eqb_eq_corr in Heq + |apply Z_eqb_neq_corr in Heq + | idtac]] + | _ => fail "No match subterm found" + end. + +Ltac case_innermost Heq := + match goal with + | |- ?g => case_innermost_term g Heq + end. + +Ltac case_innermost_in H Heq := + let T := type of H in + case_innermost_term T Heq. + +Tactic Notation "case_innermost" ident(Heq) := + case_innermost Heq. + +Tactic Notation "case_innermost" ident(H) ident(Heq) := + case_innermost_in H Heq. + +Ltac toRec := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKInsertCanRec;[|constructor]);simpl; + try (setoid_rewrite <- maxKDone;[|constructor]) +| _ => idtac "nothing to do" +end. + +Ltac stepOne := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKForwardOne;[|constructor]);simpl +| _ => idtac "nothing to do" +end. + +Ltac stepThousand := +match goal with +| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => + try (setoid_rewrite <- maxKForwardThousand;[|constructor]);simpl +| _ => idtac "nothing to do" +end. + +Ltac toNextRec := stepOne; toRec. + +Ltac able_to_ind := + lazymatch goal with + | |- context[sequentialStepMaxK ?fs ?r] => + let b := eval compute in (canRec fs r) in + lazymatch b with + | true => idtac + | false => fail + end + | |- _ => fail + end. + +Ltac is_not_terminated := + lazymatch goal with + | |- context[sequentialStepMaxK _ _ _] => idtac + | |- _ => fail + end. + +Ltac solve_final_state := + exists 0; (* This is for the step number, which is always irrelevant (|- nat) when this tactic is called *) + first [ auto (* The program indeed terminated at ([], r) where is_result r *) + | idtac "Unexpected end state + (can be due to an exception in the Erlang program, + a result when an exception was expected, + non-termination in the given depth or + an impossible input that was not ruled out)" + ]. + +Ltac solve_final_postcond := + first [ nia + | idtac "Could not solve postcondition" + ]. + +Ltac solve_terminated := + lazymatch goal with + | |- context[sequentialStepMaxK] => fail "The program has not yet terminated" + | |- _ => + lazymatch goal with + | |- ex _ => eexists;solve_terminated + | |- _ /\ _ => split;[solve_final_state|solve_final_postcond] + | |- _ => idtac + end + end. + +Tactic Notation "intros_tail" := + idtac. + +Tactic Notation "intros_tail" ident_list(t) := + intros t. + +Ltac strip_IH_precond IH := + (* By this point, the induction hypothesis is an implication list. Note that this tactic + terminates at hitting a forall, even if implication is just syntactic sugar for a forall + in Coq. + + P -> Q is equivalent to forall _ : P, Q + + When hitting a forall, lia cannot go further, because it is a declaration of a symbolic + variable. In that case 'P' is not solvable. So this is a trick, but it is intended behaviour. *) + let TIH := type of IH in + lazymatch TIH with + | ?p -> _ => + let H := fresh "Heq" in + try ( + assert p as H by lia; specialize (IH H); clear H; + strip_IH_precond IH) + | _ => idtac + end. + +Ltac destruct_until_conj IH := + lazymatch (type of IH) with + | _ /\ _ => idtac + | ex _ => + let x := fresh "x" in + destruct IH as [x IH]; destruct_until_conj IH + | _ => idtac + end. + +Ltac eexists_until_conj := + lazymatch goal with + | |- _ /\ _ => idtac + | |- ex _ => eexists; eexists_until_conj + | |- _ => idtac + end. + +Ltac separate_cases_mult h t := + (* If we find a match expression, then introduce the variable h, along with the precondition. *) + let precond := fresh "PreCond" in + let heq := fresh "Heq" in + intros h; intros t; intros precond; + (* Separate the cases, using the hypothesis name Heq... *) + case_innermost heq; simpl; + (* ...and eliminate sequentialStepCanRec from all branches, if it exists. *) + try (setoid_rewrite maxKInsertCanRecGeneral;try auto); + (* A branch might not be reachable based on PreCond and Heq, try solving using nia *) + try nia; + (* The branch condition is merged with the precondition. *) + let Tp := type of precond in + let Th := type of heq in + let precond' := fresh "PreCond" in + assert (Tp /\ Th) as precond' by lia; + clear heq; clear precond; + (* Finally, we get back to the standard goal on both branches. *) + revert h t precond'. + +(* Tactic Notation "separate_cases_mult" ident(h) ident_list(t) := + separate_cases_mult h t. *) + +Ltac base_case_mult_inner h t := + (* Do a thousand reduction steps. *) + stepThousand; + first [ (* If we run into a match expression, separate the cases. *) + contains_match; + separate_cases_mult h t; + base_case_mult_inner h t + | (* If we do not have a match expression but we have not terminated, continue the loop. *) + is_not_terminated; + base_case_mult_inner h t + | (* If we have terminated, solve the terminated state. *) + intros; solve_terminated + | idtac "Unexpected error: could not solve terminated goal" + ]. + +Ltac base_case_mult precond heq' h t := + (* We need to return h and the precondition to the goal, before the loop begins. *) + let precond' := fresh "PreCond" in + let Tp := type of precond in + let Th := type of heq' in + assert (Tp /\ Th) as precond' by lia; clear precond; clear heq'; + revert precond'; revert t; revert h; + base_case_mult_inner h t. + +Ltac spec_rest_of_terms IH vl := + match vl with + | [] => idtac + | VLit ?lit :: ?vl' => + match lit with + | Integer ?i => specialize (IH i) + | Atom ?a => specialize (IH a) + end; + spec_rest_of_terms IH vl' + | _ => fail "Unexpected error during induction: unsupported argument type" + end. + +Ltac rec_case_mult_inner IH h t := + toRec; + first [ (* If case separation is found while getting to the next recursive step, + continue on all branches *) + contains_match; + separate_cases_mult h t; + rec_case_mult_inner IH h t + | (* If the function is possibly recursive, we can assume that we have reached the + next point of recursion. *) + possibly_recursive; + intros h; intros t; + let precond := fresh "PreCond" in + intros precond; + (* The list of computed parameters needs to be extracted from the goal. In this + tactic, the parameters are either integers or atoms. *) + lazymatch goal with + | |- context[FParams (IApp (VClos (_ :: _) _ _ _)) ?vl [] :: _] => + match vl with + (* TODO: currently only integers and atoms are supported, extend this to + other types, e.g. lists *) + | VLit ?lit :: ?vl => + (* IH is specialized by the variable the function is doing recursion on + (the first argument) *) + match lit with + | Integer ?i => specialize (IH i) + | Atom ?a => specialize (IH a) + end; + (* IH is specialized by the condition introduced by the induction itself. *) + strip_IH_precond IH; + (* IH is specialized by the rest of the symbolic variables. *) + spec_rest_of_terms IH vl + | _ => fail "Unexpected error during induction: unsupported argument type" + end; + (* IH is specialzed by the precondition. *) + strip_IH_precond IH; + (* Terminal subterms are existential, they can be separated from IH by destruct. IH is + then separated to the termination of the recursion, and the postcondition of said + recursion termination. *) + destruct_until_conj IH; + let IHExp := fresh "IHExp" in + let IHPostcond := fresh "IHPostcond" in + destruct IH as [IHExp IHPostcond]; + (* The functional version of the frame_indep_core lemma is applied. *) + let IHExp_fic := fresh "IHExp_fic" in + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic; simpl in IHExp_fic; + (* Existential variables are created using eexists. *) + eexists_until_conj; + (* The transitivity property of the frame stack semantics is used. *) + eapply maxKTransitive';[apply IHExp_fic|]; + clear IHExp IHExp_fic; + (* The postcondition from the recursive step can be seen as a precondition + for the rest of the evaluation. Thus, they are merged together. *) + let precond' := fresh "PreCond" in + let Tp := type of precond in + let Th := type of IHPostcond in + assert (Tp /\ Th) as precond' by nia; + clear precond IHPostcond; + (* All the variables are reverted, along with the precondition. This is because the rest + of the goal is not recursive, thus it can be solved with the same algorithm as the + base case. *) + revert precond'; revert t; revert h; + base_case_mult_inner h t + | |- _ => fail "Could not get parameter list." + end + | (* If we did not reach a pattern match, or a point of recursion, but the function has + not terminated yet, then toRec (1000 steps) was not enought, so we continue. *) + is_not_terminated; + rec_case_mult_inner IH h t + | (* However, if we did terminate, then solve_terminated can solve the goal. *) + intros; solve_terminated + ]. + + +Ltac rec_case_mult precond heq' IH h t := + (* Heq' is merged with the precondition, to get a new precondition. *) + let precond' := fresh "PreCond" in + let Tp := type of precond in + let Th := type of heq' in + assert (Tp /\ Th) as precond' by lia; clear precond; clear heq'; + (* To get to the next recursive step, a single step needs to be made first, since the + goal is already potentially recursive. *) + revert precond'; revert t; revert h; + stepOne; + rec_case_mult_inner IH h t. + +Ltac solve_induction_mult h t := + (* To solve using induction, first introduce the variables and the precondition. *) + intro h; intros t; + let precond := fresh "PreCond" in + intros precond; + (* IH needs to be as general as possible, but we need to know that 0 <= h, which is in the + precondition. So we need to assert it with lia, before reverting the precondition. *) + let heq := fresh "Heq" in + assert (0 <= h)%Z as heq by lia; + revert precond; revert t; + (* Induction is performed. In the new goal, the symbolic variable h is universally quantified + again, the introduced version is irrelevant along with Heq, thus they can be deleted when + they are not needed anymore. *) + apply Zlt_0_ind with (x := h);[clear heq; clear h|exact heq]; + (* Since the old h was cleared, the name can be reused for its new universally quantified + instance. The induction hypothesis is introduced as IH. We also know that 0 <= h, this is + given by Zlt_0_ind itself. Heq can be reused, since it was cleared. It can be cleared + again, since it directly comes from PreCond. PreCond is introduced after Heq. *) + intros h; + let IH := fresh "IH" in + intros IH; intros heq; intros t; clear heq; intros precond; + (* Destructing h gives 3 cases, the first is a base case with 0, the second is positive, + and the third is negative. Since we assume that the recursive function decreases on h, + the first case will terminate (IH not needed), the second will recurse, and the third + is impossible, because h cannot be negative. *) + let heq' := fresh "Heq" in + destruct h eqn:heq'; + [clear IH;base_case_mult precond heq' h t| rec_case_mult precond heq' IH h t|nia]. + +Ltac take_to_rec_loop_mult h t := + toRec; + first [ (* If the goal might be recursive... *) + possibly_recursive; + idtac "trying induction..."; + solve_induction_mult h t + | (* If we can find a match expression... *) + contains_match; + separate_cases_mult h t; + solve_symbolically_internal_mult h t + | (* If we did not hit a point of recursion, or a case separation, + the loop needs to be continued. *) + solve_symbolically_internal_mult h t + ] +with +solve_symbolically_internal_mult h t := + first [ (* If sequentialStepMaxK is still in the goal, and we did not hit recursion yet, + then try moving forward to a point of recursion. *) + is_not_terminated; take_to_rec_loop_mult h t + (* If sequentialStepMaxK is not in the goal, we have terminated. *) + | intros; solve_terminated + | idtac "Unexpected error: could not solve terminated program" + ]. + +(* HACK: it is way easier, to handle cases with 1 and more than 1 symbolic variables separately. + Ltac is very peculiar with empty parameter lists, which is annoying. *) +Tactic Notation "solve_symbolically" ident(h) ne_ident_list(t) := + (* To start, rewrite the goal from inductive to functional *) + setoid_rewrite RTCEquiv;[|auto]; + (* This is separate, because the loop does not need to rewrite with RTCEquiv *) + solve_symbolically_internal_mult h t. + +Ltac separate_cases_0 h := + (* If we find a match expression, then introduce the variable h, along with the precondition. *) + let precond := fresh "PreCond" in + let heq := fresh "Heq" in + intros h; intros precond; + (* Separate the cases, using the hypothesis name Heq... *) + case_innermost heq; simpl; + (* ...and eliminate sequentialStepCanRec from all branches, if it exists. *) + try (setoid_rewrite maxKInsertCanRecGeneral;try auto); + (* A branch might not be reachable based on PreCond and Heq, try solving using nia *) + try nia; + (* The branch condition is merged with the precondition. *) + let Tp := type of precond in + let Th := type of heq in + let precond' := fresh "PreCond" in + assert (Tp /\ Th) as precond' by lia; + clear heq; clear precond; + (* Finally, we get back to the standard goal on both branches. *) + revert h precond'. + +Ltac base_case_0_inner h := + (* Do a thousand reduction steps. *) + stepThousand; + first [ (* If we run into a match expression, separate the cases. *) + contains_match; + separate_cases_0 h; + base_case_0_inner h + | (* If we do not have a match expression but we have not terminated, continue the loop. *) + is_not_terminated; + base_case_0_inner h + | (* If we have terminated, solve the terminated state. *) + intros; solve_terminated + | idtac "Unexpected error: could not solve terminated goal" + ]. + +Ltac base_case_0 precond heq' h := + (* We need to return h and the precondition to the goal, before the loop begins. *) + let precond' := fresh "PreCond" in + let Tp := type of precond in + let Th := type of heq' in + assert (Tp /\ Th) as precond' by lia; clear precond; clear heq'; + revert h precond'; + base_case_0_inner h. + +Ltac rec_case_0_inner IH h := + toRec; + first [ (* If case separation is found while getting to the next recursive step, + continue on all branches *) + contains_match; + separate_cases_0 h; + rec_case_0_inner IH h + | (* If the function is possibly recursive, we can assume that we have reached the + next point of recursion. *) + possibly_recursive; + intros h; + let precond := fresh "PreCond" in + intros precond; + (* The list of computed parameters needs to be extracted from the goal. In this + tactic, the function has only 1 parameter, which is either an integer or an atom. *) + lazymatch goal with + | |- context[FParams (IApp (VClos (_ :: _) _ _ _)) ?vl [] :: _] => + match vl with + | [] => fail "Too few function parameters" + (* TODO: currently only integers and atoms are supported, extend this to + other types, e.g. lists *) + | [VLit (Integer ?i)] => specialize (IH i) + | [VLit (Atom ?a)] => specialize (IH a) + | _ :: _ => fail "Too many function parameters" + | _ => fail "Unexpected error during induction" + end; + (* IH is specialzed by the condition introduced by the induction itself, and the + precondition. Since this version of the tactic only takes a single symbolic variable, no + more specialization is needed. *) + strip_IH_precond IH; + (* Terminal subterms are existential, they can be separated from IH by destruct. IH is + then separated to the termination of the recursion, and the postcondition of said + recursion termination. *) + destruct_until_conj IH; + let IHExp := fresh "IHExp" in + let IHPostcond := fresh "IHPostcond" in + destruct IH as [IHExp IHPostcond]; + (* The functional version of the frame_indep_core lemma is applied. *) + let IHExp_fic := fresh "IHExp_fic" in + pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic; simpl in IHExp_fic; + (* Existential variables are created using eexists. *) + eexists_until_conj; + (* The transitivity property of the frame stack semantics is used. *) + eapply maxKTransitive';[apply IHExp_fic|]; + clear IHExp IHExp_fic; + (* The postcondition from the recursive step can be seen as a precondition + for the rest of the evaluation. Thus, they are merged together. *) + let precond' := fresh "PreCond" in + let Tp := type of precond in + let Th := type of IHPostcond in + assert (Tp /\ Th) as precond' by nia; + clear precond IHPostcond; + (* The variable h is reverted, along with the precondition. This is because the rest + of the goal is not recursive, thus it can be solved with the same algorithm as the + base case. *) + revert h precond'; + base_case_0_inner h + | |- _ => fail "Could not get parameter list." + end + | (* If we did not reach a pattern match, or a point of recursion, but the function has + not terminated yet, then toRec (1000 steps) was not enought, so we continue. *) + is_not_terminated; + rec_case_0_inner IH h + | (* However, if we did terminate, then solve_terminated can solve the goal. *) + intros; solve_terminated + ]. + +Ltac rec_case_0 precond heq' IH h := + (* Heq' is merged with the precondition, to get a new precondition. *) + let precond' := fresh "PreCond" in + let Tp := type of precond in + let Th := type of heq' in + assert (Tp /\ Th) as precond' by lia; clear precond; clear heq'; + (* To get to the next recursive step, a single step needs to be made first, since the + goal is already potentially recursive. *) + revert h precond'; + stepOne; + rec_case_0_inner IH h. + +Ltac solve_induction_0 h := + (* To solve using induction, first introduce the variable and the precondition. *) + intro h; + let precond := fresh "PreCond" in + intros precond; + (* IH needs to be as general as possible, but we need to know that 0 <= h, which is in the + precondition. So we need to assert it with lia, before reverting the precondition. *) + let heq := fresh "Heq" in + assert (0 <= h)%Z as heq by lia; + revert precond; + (* Induction is performed. In the new goal, the symbolic variable h is universally quantified + again, the introduced version is irrelevant along with Heq, thus they can be deleted when + they are not needed anymore. *) + apply Zlt_0_ind with (x := h);[clear heq; clear h|exact heq]; + (* Since the old h was cleared, the name can be reused for its new universally quantified + instance. The induction hypothesis is introduced as IH. We also know that 0 <= h, this is + given by Zlt_0_ind itself. Heq can be reused, since it was cleared. It can be cleared + again, since it directly comes from PreCond. PreCond is introduced after Heq. *) + intros h; + let IH := fresh "IH" in + intros IH; intros heq; clear heq; intros precond; + (* Destructing h gives 3 cases, the first is a base case with 0, the second is positive, + and the third is negative. Since we assume that the recursive function decreases on h, + the first case will terminate (IH not needed), the second will recurse, and the third + is impossible, because h cannot be negative. *) + let heq' := fresh "Heq" in + destruct h eqn:heq'; + [clear IH;base_case_0 precond heq' h| rec_case_0 precond heq' IH h|nia]. + +Ltac take_to_rec_loop_0 h := + toRec; + first [ (* If the goal might be recursive... *) + possibly_recursive; + idtac "trying induction..."; + solve_induction_0 h + | (* If we can find a match expression... *) + contains_match; + separate_cases_0 h; + solve_symbolically_internal_0 h + | (* If we did not hit a point of recursion, or a case separation, + the loop needs to be continued. *) + solve_symbolically_internal_0 h + ] +with +solve_symbolically_internal_0 h := + first [ (* If sequentialStepMaxK is still in the goal, and we did not hit recursion yet, + then try moving forward to a point of recursion. *) + is_not_terminated; take_to_rec_loop_0 h + (* If sequentialStepMaxK is not in the goal, we have terminated. *) + | intros; solve_terminated + | idtac "Unexpected error: could not solve terminated program" + ]. + +Tactic Notation "solve_symbolically" ident(h) := + setoid_rewrite RTCEquiv; [|auto]; + solve_symbolically_internal_0 h. + +(* TODO + - technically, symbolic evaluation without any symbolic variables (i.e. just evaluating) + is not yet supported, because the solve_symbolically tactic needs at least one variable. + - check this on the other functions + - look at the difference of z and x in the tactics: am I possibly messing something up? + + THINK/ASK ABOUT IT: + Am I right, is it only possible to have a function application with an empty list of + parameters left to evaluate on the *top* of the frame stack? +*) + +(* ----- EXAMPLES ----- *) + +Definition fact_frameStack (e : Exp) : Exp := + ELetRec + [(1, °ECase (˝VVar 1) [ + ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); + ([PVar], ˝ttrue, + °ELet 1 (EApp (˝VFunId (1, 1)) + [°ECall (˝VLit "erlang"%string) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]]) + (°ECall (˝VLit "erlang"%string) (˝VLit "*"%string) [˝VVar 1; ˝VVar 0]) + ) + ])] + (EApp (˝VFunId (0, 1)) [e]) + (* Write the definition here *) +. + +Theorem fact_eval_ex: + forall (z : Z), (0 <= z)%Z -> + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (z <= y /\ y >= 1)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition tailrec_fact (e d : Exp) : Exp := + ELetRec [ + (2, °ECase (˝VVar 1) [ + ([PLit (Integer 0%Z)], ˝ttrue, ˝VVar 2); + ([PVar], ˝ttrue, + (°EApp (˝VFunId (1, 2)) + [°ECall (˝erlang) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]; + °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 0; ˝VVar 3] + ])) + ] + ) + ] (EApp (˝VFunId (0, 2)) [e; d]) +. + +Theorem fact_tailrec_eval_ex: + forall (z : Z) (z' : Z), (0 <= z)%Z -> + exists (y : Z), + ⟨ [], (tailrec_fact (˝VLit z) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z)) * z')%Z. +Proof. + solve_symbolically z z'. + + +Qed. + + + + + + + + + + + + + + + + + + + + + + + + From 312aa835685ab242f6bd7d5f0b7494dce2d2a517 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Fri, 12 Dec 2025 12:35:19 +0100 Subject: [PATCH 11/20] Organized symbolic evaluation into 3 new files, old files deleted. --- src/Symbolic/Assignments.v | 1112 -------------- src/Symbolic/Symb.v | 1453 ------------------- src/Symbolic/SymbExamples.v | 229 +++ src/Symbolic/{SymbFinal.v => SymbTactics.v} | 479 +----- src/Symbolic/SymbTheorems.v | 387 +++++ src/Symbolic/Symbolic.v | 1353 ----------------- 6 files changed, 636 insertions(+), 4377 deletions(-) delete mode 100644 src/Symbolic/Assignments.v delete mode 100644 src/Symbolic/Symb.v create mode 100644 src/Symbolic/SymbExamples.v rename src/Symbolic/{SymbFinal.v => SymbTactics.v} (60%) create mode 100644 src/Symbolic/SymbTheorems.v delete mode 100644 src/Symbolic/Symbolic.v diff --git a/src/Symbolic/Assignments.v b/src/Symbolic/Assignments.v deleted file mode 100644 index 7140c674..00000000 --- a/src/Symbolic/Assignments.v +++ /dev/null @@ -1,1112 +0,0 @@ -(* From CoreErlang.BigStep Require Import FunctionalBigStep. *) -From CoreErlang.FrameStack Require SubstSemantics SubstSemanticsLemmas. - -Open Scope string_scope. - -Module FrameStack. - -Import FrameStack.SubstSemantics. - -Import ListNotations. -(* - Let "e" be a parameter expression. - - letrec 'fact'/1 = - fun(X) -> - case X of - <0> -> 1 - -> let = apply 'fact'/1(call 'erlang':'-'(Z, 1)) - in call 'erlang':'*'(Z,Y); - in - apply 'fact'/1(e) - - Define the above expression! - *) - -Definition fact_frameStack (e : Exp) : Exp := - ELetRec - [(1, °ECase (˝VVar 1) [ - ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); - ([PVar], ˝ttrue, - °ELet 1 (EApp (˝VFunId (1, 1)) - [°ECall (˝VLit "erlang") (˝VLit "-") [˝VVar 0; ˝VLit 1%Z]]) - (°ECall (˝VLit "erlang") (˝VLit "*") [˝VVar 1; ˝VVar 0]) - ) - ])] - (EApp (˝VFunId (0, 1)) [e]) - (* Write the definition here *) -. - - -(* Hint: to solve statements about scopes (e.g., VALCLOSED), use "scope_solver"! - Also using "(e)constructor" could help you determine which rule of the semantics - can be used. Beware, not all semantic rules are syntax-driven, there are rules - about ECase expressions that can applied to the same configuration. - - Since you prove the evaluation of a factorial function, thus expect repetition - of proof steps in the script you write. This proof should not be short (>120 LOC), - if you write out each step. - - Tactics you should use: apply, (e)constructor, simpl, relfexivity, auto, congruence - *) -(* Prove the following theorem *) -Theorem fact_eval_3 : - ⟨[], fact_frameStack (˝VLit 3%Z)⟩ -->* RValSeq [VLit 6%Z]. -Proof. - -Admitted. - -From CoreErlang.Interpreter Require Import StepFunctions Equivalences. - -Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. -Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. - -Ltac case_innermost_term t := - lazymatch t with - | context[match ?x with _ => _ end] => - first [ case_innermost_term x - | let H := fresh "Heq" in - destruct x eqn:H; - first [apply Z_eqb_eq_corr in H - |apply Z_eqb_neq_corr in H - | idtac]] - | _ => fail "No match subterm found" - end. - -Ltac case_innermost := - match goal with - | |- ?g => case_innermost_term g - end. - -Fixpoint sequentialStepMaxK0 (fs : FrameStack) (r : Redex) (k : nat) : option (FrameStack * Redex) := - match fs, r with - | [], RValSeq _ => Some (fs, r) - | _, _ => - match k with - | 0 => Some (fs, r) - | S k' => match sequentialStepFunc fs r with - | Some (fs', r') => sequentialStepMaxK0 fs' r' k' - | None => None - end - end - end. - -Arguments sequentialStepFunc !_ !_ /. -Arguments sequentialStepMaxK0 !_ !_ !_ /. - -Theorem fact_eval_example0: - forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK0 [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. unfold fact_frameStack. - all:simpl. all:try lia. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. -Admitted. - -Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (k : nat) : option (FrameStack * Redex) := - match k with - | 0 => Some (fs, r) - | S k' => match sequentialStepFunc fs r with - | Some (fs', r') => sequentialStepMaxK fs' r' k' - | None => match fs, r with - | [], RValSeq _ => Some (fs, r) - | _, _ => None - end - end - end. - -Arguments sequentialStepMaxK !_ !_ !_ /. - -Theorem fact_eval_example: - forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. unfold fact_frameStack. - all:simpl. all:try lia. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. -Qed. - -Fixpoint sequentialStepMaxK' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := - match p with - | xH => - match sequentialStepFunc fs r with - | Some (fs', r') => Some (fs', r') - | None => - match fs, r with - | [], RValSeq _ => Some (fs, r) - | _, _ => None - end - end - | xO p' => - let res := sequentialStepMaxK' fs r p' in - match res with - | Some (fs', r') => sequentialStepMaxK' fs' r' p' - | None => None - end - | xI p' => - let res := sequentialStepMaxK' fs r p' in - match res with - | Some (fs', r') => - let res' := sequentialStepMaxK' fs' r' p' in - match res' with - | Some (fs'', r'') => - match sequentialStepFunc fs'' r'' with - | Some (fs''', r''') => Some (fs''', r''') - | None => - match fs'', r'' with - | [], RValSeq _ => Some (fs'', r'') - | _, _ => None - end - end - | None => None - end - | None => None - end - end. - -Arguments sequentialStepMaxK' !_ !_ !_ /. -(* Arguments Z.leb : simpl never. *) -Opaque Z.leb. - -Theorem fact_eval_example': - forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. unfold fact_frameStack. - all:simpl. all:try lia. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. -Qed. - -Fixpoint sequentialStepMaxK'' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := - match fs, r with - | [], RValSeq _ => Some (fs, r) - | _, _ => - match p with - | xH => sequentialStepFunc fs r - | xO p' => - match sequentialStepMaxK'' fs r p' with - | Some (fs', r') => sequentialStepMaxK'' fs' r' p' - | None => None - end - | xI p' => - match sequentialStepFunc fs r with - | Some (fs', r') => - match sequentialStepMaxK'' fs' r' p' with - | Some (fs'', r'') => sequentialStepMaxK'' fs'' r'' p' - | None => None - end - | None => None - end - end - end. - -Arguments sequentialStepMaxK'' !_ !_ !_ /. - -Theorem fact_eval_example'': - forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), sequentialStepMaxK'' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. unfold fact_frameStack. - all:simpl. all:try lia. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|lia]. -Admitted. - -Fixpoint sequentialStepMaxK''' (fs : FrameStack) (r : Redex) (p : positive) : option (FrameStack * Redex) := - match sequentialStepFunc fs r with - | None => - match fs, r with - | [], RValSeq _ => Some (fs, r) - | _, _ => None - end - | Some (fs', r') => - match p with - | xH => Some (fs', r') - | xO p' => - match sequentialStepMaxK''' fs r p' with - | Some (fs'', r'') => sequentialStepMaxK''' fs'' r'' p' - | None => None - end - | xI p' => - match sequentialStepMaxK''' fs' r' p' with - | Some (fs'', r'') => sequentialStepMaxK''' fs'' r'' p' - | None => None - end - end - end. - -Print positive. -Print positive_ind. -Print Pos.peano_ind. -Print Pos.lt_ind. - -Definition sequentialStepMaxK'''0 (fs : FrameStack) (r : Redex) (n : N) : option (FrameStack * Redex) := - match n with - | N0 => Some (fs, r) - | Npos p => sequentialStepMaxK''' fs r p - end. - -Print N. - -Arguments sequentialStepMaxK''' !_ !_ !_ /. - -Require Import SMTCoq.Tactics. - -Theorem fact_eval_example''': - forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), sequentialStepMaxK''' [] (fact_frameStack (˝VLit z)) 100000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. -intros. unfold fact_frameStack. - all:simpl. all:try lia. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. admit. cvc4. all:try lia. - eexists. split;[reflexivity|nia]. -Qed. - -Fixpoint ssmk (fs : FrameStack) (r : Redex) (p : positive) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match p with - | xH => (fs', r') - | xO p' => - let (fs'', r'') := ssmk fs r p' in ssmk fs'' r'' p' - | xI p' => - let (fs'', r'') := ssmk fs' r' p' in ssmk fs'' r'' p' - end - end. - -Arguments ssmk !_ !_ !_ /. - -(* - -Ltac case_innermost_term t := - lazymatch t with - | context[match ?x with _ => _ end] => - first [ case_innermost_term x - | destruct x eqn:?H ] - | _ => fail "No match subterm found" - end. - -Ltac case_innermost := - match goal with - | |- ?g => case_innermost_term g - end. - -*) - -Require Import Psatz. - -Theorem fact_eval_example'''': - forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk [] (fact_frameStack (˝VLit z)) 10000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. unfold fact_frameStack. - all:simpl. all:try lia. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. - case_innermost. - all:simpl. all:try lia. - eexists. split;[reflexivity|nia]. -Qed. - -Fixpoint ssmkInner (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs', r') - | S n' => ssmkInner fs' r' n' - end - end. - -Definition isEnd (fs : FrameStack) (r : Redex) : bool := - match fs, r with - | [], RValSeq _ => true - | _, _ => false - end. - -Fixpoint ssmk2 (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := -match isEnd fs r with -| true => (fs, r) -| false => - match n with - | 0 => (fs, r) - | S n' => - let (fs', r') := ssmkInner fs r 1000 in - ssmk2 fs' r' n' - end -end. - -Arguments ssmkInner !_ !_ !_ /. -Arguments ssmk2 !_ !_ !_ /. - -Ltac simpl_and_try_solve := - simpl; (* simplify the goal *) - lazymatch goal with - | [ |- context[ssmk2] ] => try lia (* eval not done: is the case impossible? *) - | _ => try (eexists; split;[reflexivity|nia]) (* eval done: the result exists & postcond holds *) - end. - -Theorem fact_eval_example''''': - forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk2 [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. unfold fact_frameStack. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. -Qed. - -Lemma ssmaxk_can_step: - forall (k : positive) (fs fs' : FrameStack) (r r' : Redex) (v : Val), - fs <> [] -> r <> RValSeq [v] -> - sequentialStepMaxK''' fs r k = Some (fs', r') -> sequentialStepFunc fs r <> None. -Proof. - intros. - destruct k. - all:unfold sequentialStepMaxK''' in H1. - all:destruct (sequentialStepFunc fs r) eqn:Hssf; auto. - all:destruct fs; auto. -Qed. - -Lemma minusplus: forall (x y : Z), (x - 1 =? y)%Z = true -> (x =? y + 1)%Z = true. -Proof. smt. Qed. - -CoInductive StateStream : Type := -| Cons : FrameStack * Redex -> StateStream -> StateStream. - -CoFixpoint costep (fs : FrameStack) (r : Redex) : StateStream := - match sequentialStepFunc fs r with - | Some (fs', r') => Cons (fs', r') (costep fs' r') - | None => Cons (fs, r) (costep fs r) - end. - -Fixpoint coeval (s : StateStream) (n : nat) : FrameStack * Redex := - match n, s with - | 0, Cons (fs, r) _ => (fs, r) - | S n', Cons _ s' => coeval s' n' - end. - -Theorem fact_eval_example''''': - forall (z : Z), (0 <= z < 5)%Z -> exists (y : Z), coeval (costep [] (fact_frameStack (˝VLit z))) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. -Qed. - -Theorem fact_eval_example'''': - forall (z : Z), (0 <= z)%Z -> exists (y : Z), sequentialStepMaxK''' [] (fact_frameStack (˝VLit z)) 1000 = Some ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|lia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|nia]. - all:simpl. all:try lia. - case_innermost. - eexists. split. reflexivity. (* clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11. *) -(* assert (z = 12%Z) by smt. *) - clear -H12. - assert (forall z, ((z - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 =? 0)%Z = true) -> (z = 12%Z)) by smt. - apply H in H12. subst. lia. - - apply H13 in H12. subst. auto. - clear H0 H1 H12. - assert (((z =? 0 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1)%Z = true) -> (z = 12%Z)) by smt. - - assert ((z =? 0 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1)%Z = true). lia. - assert ((z =? 12)%Z = true) by smt. - - eexists. split;[reflexivity|nia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|nia]. - all:simpl. all:try lia. - case_innermost. - eexists. split;[reflexivity|nia]. - all:simpl. all:try lia. - case_innermost. - clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14. - eexists. split. reflexivity. - Search "_ * _"%Z "<="%Z. - assert (z = 15%Z). admit. - assert (z = (15 - 1 + 1)%Z). easy. - -Admitted. - -Lemma ssmaxk_steppy_steppy: - forall (k : positive) (fs fs' fs'' : FrameStack) (r r' r'' : Redex), - sequentialStepMaxK''' fs r k = Some (fs', r') -> - sequentialStepFunc fs' r' = Some (fs'', r'') -> - sequentialStepMaxK''' fs r (k + 1) = Some (fs'', r''). -Proof. - intros k. - Print Pos.lt_ind. -Admitted. - -Theorem ssmaxk_trans: - forall (k l: positive) (fs fs' fs'' : FrameStack) (r r' r'' : Redex), - sequentialStepMaxK''' fs r k = Some (fs', r' ) -> - sequentialStepMaxK''' fs' r' l = Some (fs'', r'') -> - sequentialStepMaxK''' fs r (k + l)%positive = Some (fs'', r''). -Proof. - induction k using Pos.peano_ind. - * induction l using Pos.peano_ind; intros. - + assert ((1+1)%positive = 2%positive). lia. rewrite H1. clear H1. - unfold sequentialStepMaxK'''. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. - unfold sequentialStepMaxK''' in H. rewrite Hssf in H. inv H. - destruct (sequentialStepFunc fs' r') eqn:Hssf0. - ** destruct p. unfold sequentialStepMaxK''' in H0. - rewrite Hssf0 in H0. auto. - ** unfold sequentialStepMaxK''' in H0. rewrite Hssf0 in H0. auto. - - unfold sequentialStepMaxK''' in H. rewrite Hssf in H. - destruct fs eqn:Hfs; try discriminate. destruct r eqn:Hr; try discriminate. - inv H. simpl in H0. exact H0. - + - * -Qed. - - -(* symbolic execution plans TODO: - These plans come "outside in", starting with the big picture. - Although the actual implementation is likely to be "inside out". - - - Start out with an Erlang module file - - Add comments to it in a standard format, containing preconditions and postconditions about a function - - Preconditions should be about the input of the function (be mindful about arity) - - Postconditions should be about the output of the function (termination in RValSeq) - - Search depth: the "k" steps required for the execution. This should also be a parameter, since - Coq can not handle divergence. - - Utilize and change the pretty-printer, so it prints a theorem, where the function to be - tested is given the arguments specified in the precondition comments. The postcondition is given by the - value the program leads to and the condition after. The standard format should look like - fact_eval_example' above. - - with this approach, we don't need to develop as much metatheory. - - however, "k" steps is still an issue. even with the arguments + bang pattern thingy. It gets slower - as k increases. "simpl" still causes stack overflow for big enough values. - - Make a custom tactic that tries to solve the goal. Utilize smt solvers (this is when the lack of - metatheory is a big advantage). - - Possibly more than 1 SMT solvers should be utilized, with a heuristic? - - SMT solvers are utilized in 2 cases. Either finding out if the termination satisfies the goal - (end of config execution), or finding out that a configuration is impossible (moving along with - config execution). - - if termination does not satisfy a goal: FAIL: the message should provide the configuration of the - symbolic variables under which the fail (list of hypotheses). INVESTIGATE: can 'a' (or 'the') - concrete value be given for symbolic variables under the hypotheses? - - if termination satisfies the goal, but SMT solvers can not solve the goal: POTENTIAL FAIL: the - message should provide the hypotheses. Maybe the goal is actually solvable, just not by the SMT - solver. Unfortunately, because of the laws of the universe as we know it in 2025, not all goals - are trivially solvable by SMT solvers. It's probably impossible to tell this point and the - previous one apart (at least I think). - - if moving along with a configuration can not happen, and the SMT solver find that it can not happen: - HAPPINESS: goal should be solved automatically. - - if moving along with a configuration can not happen, and the SMT solver does not find out: - UNHAPPINESS, TRY MOVING ALONG: this stinks, but as I've stated not all goals are solvable by SMT - solvers. Maybe we get to configurations that can be solvable? Unfortunately I don't - think we can do induction automatically (if we can, I think it's a big big hassle). - - if moving along with the configuration can happen: HAPPINESS, TRY MOVING ALONG: this is a standard - case. Again, I do not think that we can differentiate between this point and the previous one. - - The output of the tactic should be a list of goals that could not be solved automatically. - - Have a way to try to prove everything without even opening the Coq file. So generate the file with the - new pretty printer from the Erlang source code, and have a 'running' file that tries compiling the - coq file. If the custom tactic can solve everything, inform the user. If it can not solve everything, - display the unsolved goals. The user should only have to open Coq for unsolved goals if absolutely - necessary. - - PROS for this approach: - - The tool should easily integrate with the Erlang code - - Writing preconditions and postconditions in a standardized way should make goal generation standard - - If goal generation is standard, metatheory in Coq should not be needed to be developed - - If metatheory is not needed, integrating SMT solvers should be more straightforward - CONS (or more precisely, THINGS TO SOLVE): - - developing the standard way of writing pre- and postconditions in the Erlang file is not - as easy as it first seems. Preconditions are the trickier part: Arity and symbolic variable order - might need to be defined by hand (since the precond is just a conjunction of conditions). - Postconditions need a special symbol for the value produced. This might also need to be hand defined. - - SMT solvers can not solve everything. We just have to live with this fact. - - The "k" step problem. A step count needs to be defined, or else the multi-step function is not - descending. Defining "k" with "nat"-s causes stack overflow, even with the tactics having - bang pattern arguments. "k" can not be existential, because that would mean that we need to be able - to calculate it beforehand (impossible). A good solution needs to be devised. I suspect choosing - "nat"-s for a step count also causes the proofs to be slow. - - running out of "k" steps should be explicitly stated somehow, somewhere. - - what about concurrency? I suspect that, since steps are not deterministic, a new way of doing - multiple steps in a row is required. Like with the pmap example, have a list of actions taken - along the way (at least I think that's how that works?). This would be very complicated, and honestly, - it might go beyond the scope of the thesis. Somebody in the future will have the unfortunate task - of figuring all that out. - - installing SMT solvers might be a bit complex since the change from Coq to Rocq - - what about other data types? Integers are one thing, lists, strings and maps are a whole problem - in their own right. Especially because of bounds (if they are needed). - - Bounds: I don't think there is a general way to have unbounded expressions. Limiting the step count - to "k" should solve this issue somewhat. Programs without recursion should be fine, and for recursive - programs the step limit should suffice. - - PLANS for the thesis: - [x] investigate solutions for the "k" problem < - [x] install SMT solvers (not trivial unfortunately). | do most of this before the trip to - Actually, just "lia" can be used until it's done. | Singapore, and before lab work - [ ] Have a few nice example programs | kicks into high gear - [ ] implement the solver tactic | - [ ] figure out the pretty printer part < - [ ] equivalence proofs - [ ] if I have time (hopefully): look into concurrency - [ ] write the text of the thesis - *) - -Theorem fact_eval_example: - forall (x y : Z), (x >= 0)%Z /\ (x < 3)%Z -> ⟨[], fact_frameStack (˝VLit x)⟩ -->* RValSeq [VLit y] -> (x <= y)%Z. -Proof. - intros. unfold step_any in H0. destruct H0. destruct H0. unfold fact_frameStack in H1. - inv H1; apply sequentialStepEquiv in H2;[|scope_solver]; simpl in H2; inv H2. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - destruct x eqn:Hx; inv H4. - * inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3. Search "<="%Z 0. apply Z2Nat.neq_0_nonneg. auto. inv H1. - * inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H2; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - inv H3; apply sequentialStepEquiv in H1;[|scope_solver]; simpl in H1; inv H1. - destruct (if (Z.pos p - 1 =? 0)%Z then Some [] else None) eqn:Hp. - + inv H4. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. - inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. - inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. - inv H3. inv H1. inv H17. inv H2. - - Search "*"%Z. rewrite Z.mul_1_r. apply Z.le_refl. - - inv H1. - + inv H4. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. - inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. - inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. - inv H3. inv H1. inv H2. inv H1. inv H3. inv H1. inv H2. inv H1. inv H3. - inv H1. inv H2. admit. - * lia. (* H is impossible *) -Admitted. - -(* Define the following function in Core Erlang! To compile a Core Erlang file - use the "from_core" option of the standard compiler/interpreter. - For examples, we refer to the language specification: - https://www.it.uu.se/research/group/hipe/cerl/doc/core_erlang-1.0.3.pdf - You can also check example codes in the Erl_codes folder. - Instead of the letrec expression, define it as a top level function *) -Definition collatz (e : Exp) : Exp := - ELetRec [ - (1, °ECase (˝VVar 1) - [ - ([PLit 1%Z], ˝ttrue, ˝VNil); - ([PVar], - °ECall (˝erlang) (˝VLit "and") [ - °ECall (˝erlang) (˝VLit "<") [˝VLit 0%Z; ˝VVar 0]; - °ECall (˝erlang) (˝VLit "=") [ - ˝VLit 0%Z; - °ECall (˝erlang) (˝VLit "rem") [˝VVar 0; ˝VLit 2%Z] - ] - ], - °ECons (˝VVar 0) (EApp (˝VFunId (1,1)) [ - °ECall (˝erlang) (˝VLit "div") [˝VVar 0; ˝VLit 2%Z] - ]) - ); - ([PVar], °ECall (˝erlang) (˝VLit "<") [˝VLit 0%Z; ˝VVar 0], - °ECons (˝VVar 0) (EApp (˝VFunId (1,1)) [ - °ECall (˝erlang) (˝VLit "+") - [°ECall (˝erlang) (˝VLit "*") [˝VLit 3%Z; ˝VVar 0]; - ˝VLit 1%Z] - ]) - ) - ]) - ] - (EApp (˝VFunId (0, 1)) [e]). - -(* - module 'exercise' ['fun_func'/1, - 'module_info'/0, - 'module_info'/1] - attributes [] - 'collatz'/1 = - (fun (_0) -> - (case <_0> of - <1> when 'true' -> [] - when - call 'erlang':'and'( - call 'erlang':'<'(0, _0), - call 'erlang':'=='(0, call 'erlang':'rem'(_0, 2)) - ) -> - [X|apply 'collatz'/1(call 'erlang':'div'(X,2))] - when - call 'erlang':'<'(0, _0) -> - [X|apply 'collatz'/1(call 'erlang':'+' - (call 'erlang':'*'(3, X), 1))] - end - -| [{'function',{'fun_func',1}}] ) - -| [{'function',{'fun_func',1}}] ) - -%% Needed by erlc - - 'module_info'/0 = - ( fun () -> - call 'erlang':'get_module_info' - ('exercise') - -| [{'function',{'module_info',0}}] ) - 'module_info'/1 = - ( fun (_0) -> - call 'erlang':'get_module_info' - ('exercise', ( _0 - -| [{'function',{'module_info',1}}] )) - -| [{'function',{'module_info',1}}] ) -end -*) - -(* Erlang def - - collatz(1) -> []; - collatz(X) when ((0 == (X rem 2)) band (0 < X)) -> - [X | collatz(X div 2)]; - collatz(X) when 0 < X -> - [X | collatz(3 * X + 1)]. - -*) - - -(* - Hard task: - Prove the following theorem about the correctness of fact! - - Use induction over n! Follow the scheme described in fact_eval_3. Check what - theorems are available about transitive evaluation. -*) - -Ltac do_step := econstructor; [constructor;auto|simpl]. - -Theorem fact_eval : forall n, - ⟨[], fact_frameStack (˝VLit (Z.of_nat n))⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. -Proof. - (* - induction n; intros. - - unfold step_any. eexists. split. - + apply valseq_is_result. apply Forall_cons. - scope_solver. - apply Forall_nil. - + do 3 do_step. scope_solver. - do 2 do_step. discriminate. - do 1 do_step. scope_solver. - econstructor. eapply eval_cool_params. reflexivity. simpl. - do 2 do_step. scope_solver. - econstructor. apply eval_step_case_match. reflexivity. simpl. - econstructor. apply cool_value. scope_solver. - econstructor. apply eval_step_case_true. - econstructor. apply cool_value. scope_solver. - econstructor. - - - unfold step_any. - inv IHn. inv H. unfold fact_frameStack in H1. - inv H1. inv H. simpl in H2. inv H2. inv H. inv H1. inv H. - inv H2. inv H. inv H1. inv H. clear H10 H4 H0. inv H2. inv H. - inv H0. inv H. simpl in H8. inv H8. cbn in H1. - - eexists. split. - - + apply valseq_is_result. apply Forall_cons. - scope_solver. - apply Forall_nil. - + do 3 do_step. scope_solver. - do 2 do_step. discriminate. - econstructor. apply cool_value. scope_solver. - econstructor. eapply eval_cool_params. reflexivity. simpl. - - do 2 do_step. scope_solver. - econstructor. apply eval_step_case_not_match. reflexivity. - econstructor. apply eval_step_case_match. reflexivity. simpl. (* Ask about it *) - econstructor. apply cool_value. scope_solver. - do 4 do_step. scope_solver. - do 2 do_step. discriminate. - do 2 do_step. scope_solver. - do 2 do_step. scope_solver. - do 2 do_step. discriminate. - econstructor. apply cool_value. scope_solver. - do 2 do_step. scope_solver. - econstructor. eapply eval_cool_params. reflexivity. - Search Pos.of_succ_nat Z.of_nat. rewrite Znat.Zpos_P_of_succ_nat. simpl. - econstructor. eapply eval_cool_params. reflexivity. simpl. - - replace (Z.succ (Z.of_nat n) - 1)%Z with (Z.of_nat n)%Z by lia. - eapply FrameStack.SubstSemanticsLemmas.transitive_eval. - - ++ eapply (FrameStack.SubstSemanticsLemmas.frame_indep_nil _ _ _ _ H1). - - ++ clear H1 H3. do 7 do_step. congruence. - do 3 do_step. econstructor. econstructor. econstructor. simpl. - unfold eval_arith. simpl. - rewrite Znat.Nat2Z.inj_add. rewrite Z.add_comm. - rewrite <- Znat.Nat2Z.inj_succ. - rewrite Znat.Nat2Z.inj_mul. - replace ((Z.of_nat n) * (Z.of_nat (Factorial.fact n)))%Z with ((Z.of_nat (Factorial.fact n)) * Z.of_nat n)%Z by lia. - Search Zmult. rewrite Zmult_succ_r_reverse. rewrite Z.mul_comm. rewrite <- Znat.Nat2Z.inj_succ. econstructor. - *) -Admitted. - - -End FrameStack. - -Module BigStep. - - - -End BigStep. - - - diff --git a/src/Symbolic/Symb.v b/src/Symbolic/Symb.v deleted file mode 100644 index 75ebc1cb..00000000 --- a/src/Symbolic/Symb.v +++ /dev/null @@ -1,1453 +0,0 @@ -From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. -From CoreErlang.Interpreter Require Import StepFunctions Equivalences. - -Import ListNotations. - -Fixpoint Exp_list_eqb (le1 le2 : list Exp) : bool := - match le1, le2 with - | [], [] => true - | [], _ :: _ => false - | _ :: _, [] => false - | e1 :: le1', e2 :: le2' => andb (Exp_eqb_strict e1 e2) (Exp_list_eqb le1' le2') - end. - -Fixpoint Val_list_eqb (lv1 lv2 : list Val) : bool := - match lv1, lv2 with - | [], [] => true - | [], _ :: _ => false - | _ :: _, [] => false - | v1 :: lv1', v2 :: lv2' => andb (Val_eqb_strict v1 v2) (Val_list_eqb lv1' lv2') - end. - -Fixpoint Pat_list_eqb (lp1 lp2 : list Pat) : bool := - match lp1, lp2 with - | [], [] => true - | [], _ :: _ => false - | _ :: _, [] => false - | p1 :: lp1', p2 :: lp2' => andb (Pat_eqb p1 p2) (Pat_list_eqb lp1' lp2') - end. - -Fixpoint FCase1_eqb (l1 l2 : list (list Pat * Exp * Exp)) : bool := - match l1, l2 with - | [], [] => true - | [], _ :: _ => false - | _ :: _, [] => false - | (lp1, e1, e1') :: l1', (lp2, e2, e2') :: l2' => - andb (Pat_list_eqb lp1 lp2) (andb (Exp_eqb_strict e1 e2) (andb (Exp_eqb_strict e1' e2') (FCase1_eqb l1' l2'))) - end. - -Print FrameIdent. -Definition FrameIdent_eqb (fi1 fi2 : FrameIdent) : bool := - match fi1, fi2 with - | IValues, IValues => true - | ITuple, ITuple => true - | IMap, IMap => true - | ICall v1 v1', ICall v2 v2' => andb (Val_eqb_strict v1 v2) (Val_eqb_strict v1' v2') - | IPrimOp s1, IPrimOp s2 => String.eqb s1 s2 - | IApp v1, IApp v2 => Val_eqb_strict v1 v2 - | _, _ => false - end. - -Definition Frame_eqb (f1 f2 : Frame) : bool := - match f1, f2 with - | FCons1 e1, FCons1 e2 => Exp_eqb_strict e1 e2 - | FCons2 v1, FCons2 v2 => Val_eqb_strict v1 v2 - | FParams fi1 vl1 el1, FParams fi2 vl2 el2 => - andb (FrameIdent_eqb fi1 fi2) (andb (Val_list_eqb vl1 vl2) (Exp_list_eqb el1 el2)) - | FApp1 el1, FApp1 el2 => Exp_list_eqb el1 el2 - | FCallMod e1 el1, FCallMod e2 el2 => andb (Exp_eqb_strict e1 e2) (Exp_list_eqb el1 el2) - | FCallFun v1 el1, FCallFun v2 el2 => andb (Val_eqb_strict v1 v2) (Exp_list_eqb el1 el2) - | FCase1 l1, FCase1 l2 => FCase1_eqb l1 l2 - | FCase2 vl1 e1 l1, FCase2 vl2 e2 l2 => - andb (Val_list_eqb vl1 vl2) (andb (Exp_eqb_strict e1 e2) (FCase1_eqb l1 l2)) - | FLet n1 e1, FLet n2 e2 => andb (Nat.eqb n1 n2) (Exp_eqb_strict e1 e2) - | FSeq e1, FSeq e2 => Exp_eqb_strict e1 e2 - | FTry n1 e1 n1' e1', FTry n2 e2 n2' e2' => - andb (Nat.eqb n1 n2) (andb (Exp_eqb_strict e1 e2) (andb (Nat.eqb n1' n2') (Exp_eqb_strict e1' e2'))) - | _, _ => false - end. - -Fixpoint FrameStack_prefix (fs1 fs2 : FrameStack) : bool := - match fs1, fs2 with - | [], _ => true - | f1 :: fs1', f2 :: fs2' => andb (Frame_eqb f1 f2) (FrameStack_prefix fs1' fs2') - | _, _ => false - end. - -Definition fact_frameStack (e : Exp) : Exp := - ELetRec - [(1, °ECase (˝VVar 1) [ - ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); - ([PVar], ˝ttrue, - °ELet 1 (EApp (˝VFunId (1, 1)) - [°ECall (˝VLit "erlang"%string) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]]) - (°ECall (˝VLit "erlang"%string) (˝VLit "*"%string) [˝VVar 1; ˝VVar 0]) - ) - ])] - (EApp (˝VFunId (0, 1)) [e]) - (* Write the definition here *) -. - -Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepMaxK fs' r' n' - end - end. - -Fixpoint sequentialStepMaxKNoSimpl (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepMaxKNoSimpl fs' r' n' - end - end. - -Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := - match n with - | 0 => Some (fs, r) - | S n' => - match sequentialStepFunc fs r with - | Some (fs', r') => sequentialStepK fs' r' n' - | None => None - end - end. - -Arguments sequentialStepMaxK !_ !_ !_ /. -Arguments sequentialStepMaxKNoSimpl : simpl never. -Arguments sequentialStepK !_ !_ !_ /. - -Definition canRec (fs : FrameStack) (r : Redex) : bool := - match fs with - | FParams (IApp (VClos (_ :: _) _ _ _)) _ _ :: _ => - match r with - | RValSeq _ => true - | _ => false - end - | _ => false - end. - -Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match canRec fs r with - | true => (fs, r) - | false => - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepCanRec fs' r' n' - end - end - end. - -Lemma maxKZeroRefl: - forall (fs : FrameStack) (r : Redex), - sequentialStepMaxK fs r 0 = (fs, r). -Proof. - intros. unfold sequentialStepMaxK. - destruct (sequentialStepFunc fs r). - 1:destruct p. all:reflexivity. -Qed. - -Lemma canRecRefl: - forall (fs : FrameStack) (r : Redex), - sequentialStepCanRec fs r 0 = (fs, r). -Proof. - intros. unfold sequentialStepCanRec. - destruct (canRec fs r). 2:destruct (sequentialStepFunc fs r). - 2:destruct p. all:reflexivity. -Qed. - -Lemma maxKForwardOne: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - (exists n, sequentialStepMaxK fs r (S n) = ([], r')) <-> - exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros. split; intro. - * destruct H0. exists (S x). auto. - * destruct H0. destruct x. - + exists 0. - rewrite maxKZeroRefl in H0. inv H0. - inv H. all:auto. - + exists x. auto. -Qed. - -Lemma maxKOverflow: - forall (fs : FrameStack) (r r' : Redex) (n m : nat), - is_result r' -> - n <= m -> - sequentialStepMaxK fs r n = ([], r') -> - sequentialStepMaxK fs r m = ([], r'). -Proof. - intros fs r r' n. revert fs r r'. - induction n; intros. - * destruct m. - + auto. - + rewrite maxKZeroRefl in H1. inv H1. - inv H. all:auto. - * destruct m. - + inv H0. - + unfold sequentialStepMaxK in H1|-*. - destruct (sequentialStepFunc fs r). - 1:destruct p; fold sequentialStepMaxK. - all:fold sequentialStepMaxK in H1. - - apply IHn; auto. lia. - - auto. -Qed. - -Lemma maxKForwardThousand: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - (exists n, sequentialStepMaxK fs r (1000 + n) = ([], r')) <-> - exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros. split; intro. - * destruct H0. exists (1000 + x). auto. - * destruct H0. - exists x. - apply (maxKOverflow _ _ _ x); auto. lia. -Qed. - -Lemma maxKEquivK: - forall (fs fs' : FrameStack) (r r' : Redex), - (exists n, sequentialStepK fs r n = Some (fs', r')) <-> - (exists n, sequentialStepMaxK fs r n = (fs', r')). -Proof. - intros. split;intro. - * destruct H. exists x. - revert H. revert fs r. - induction x; intros. - + unfold sequentialStepK in *. inv H. - rewrite maxKZeroRefl. auto. - + unfold sequentialStepMaxK. - unfold sequentialStepK in H. - destruct (sequentialStepFunc fs r). - 1:destruct p. - all:fold sequentialStepMaxK. all:fold sequentialStepK in H. - all:auto. inv H. - * destruct H. revert H. revert fs r. - induction x; intros. - + rewrite maxKZeroRefl in H. inv H. exists 0. - unfold sequentialStepK. reflexivity. - + unfold sequentialStepMaxK in H. - destruct (sequentialStepFunc fs r) eqn:Hssf; fold sequentialStepMaxK in H. - - destruct p. - apply IHx in H. destruct H. exists (S x0). - unfold sequentialStepK. rewrite Hssf. fold sequentialStepK. - auto. - - inv H. exists 0. unfold sequentialStepK. reflexivity. -Qed. - -Lemma kEquiv: - forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), - ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> sequentialStepK fs r k = Some (fs', r'). -Proof. - intros. split;revert fs fs' r r'. - * induction k; intros. - + inv H. unfold sequentialStepK. auto. - + inv H. unfold sequentialStepK. - apply sequentialStepEquiv in H1. rewrite H1. - fold sequentialStepK. auto. - * induction k; intros. - + unfold sequentialStepK in H. inv H. constructor. - + unfold sequentialStepK in H. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold sequentialStepK in H. - apply sequentialStepEquiv in Hssf. - econstructor; eauto. - - inv H. -Qed. - -Theorem RTCEquiv: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - ⟨ fs, r ⟩ -->* r' <-> exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros fs r r' Hres. split; intros. - * inv H. destruct H0. - apply kEquiv in H0. - apply maxKEquivK. - exists x. auto. - * apply maxKEquivK in H. - destruct H. econstructor. split;[auto|]. - apply kEquiv. eauto. -Qed. - -Lemma maxKNoSimplEquiv: - forall (fs : FrameStack) (r : Redex) (n : nat), - sequentialStepMaxK fs r n = sequentialStepMaxKNoSimpl fs r n. -Proof. reflexivity. Qed. - -Lemma maxKTransCanRec: - forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), - is_result r'' -> - sequentialStepCanRec fs r k = (fs', r') -> - (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros. - destruct H1. revert H0 H1. revert x fs fs' r r'. - induction k; intros. - + rewrite canRecRefl in H0. inv H0. exists x. auto. - + unfold sequentialStepCanRec in H0. - destruct (canRec fs r) eqn:HCanRec. - - inv H0. eapply IHk; eauto. - destruct k; unfold sequentialStepCanRec; rewrite HCanRec; auto. - - destruct (sequentialStepFunc fs r) eqn:Hssf. - fold sequentialStepCanRec in H0. - ** destruct p. - setoid_rewrite <- maxKForwardOne;[|auto]. - unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. - eapply IHk; eauto. - ** inv H0. exists x. auto. -Qed. - -Lemma maxKInsertCanRec: - forall (fs : FrameStack) (r r'' : Redex), - is_result r'' -> - (exists n, (let (fs', r') := sequentialStepCanRec fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros. split; intros. - * destruct (sequentialStepCanRec fs r 1000) eqn:Hsscr. - eapply maxKTransCanRec; eauto. - * destruct H0. - destruct (sequentialStepCanRec fs r 1000) eqn:Hsscr. - remember 1000 as k. clear Heqk. - revert H0 Hsscr. revert fs r f r0 k. - induction x; intros. - + rewrite maxKZeroRefl in H0. inv H0. inv H. - all:simpl in Hsscr. all:destruct k. - all:inv Hsscr. all:exists 0; auto. - + unfold sequentialStepMaxK in H0. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold sequentialStepMaxK in H0. - destruct k. - ** rewrite canRecRefl in Hsscr. inv Hsscr. - exists (S x). unfold sequentialStepMaxK. rewrite Hssf. - fold sequentialStepMaxK. auto. - ** unfold sequentialStepCanRec in Hsscr. - destruct (canRec fs r) eqn:HCanRec. - ++ inv Hsscr. exists (S x). - unfold sequentialStepMaxK. rewrite Hssf. - fold sequentialStepMaxK. auto. - ++ rewrite Hssf in Hsscr. fold sequentialStepCanRec in Hsscr. - eapply IHx; eauto. - - inv H0. - destruct k. - ** rewrite canRecRefl in Hsscr. inv Hsscr. exists 0. inv H; auto. - ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. - all:exists 0; auto. -Qed. - -Theorem frame_indep_core_func: - forall (fs fs' : FrameStack) (r r' : Redex), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - forall (fsapp : FrameStack), (exists n, sequentialStepMaxK (fs ++ fsapp) r n = (fs' ++ fsapp, r')). -Proof. - intros. - apply maxKEquivK. apply maxKEquivK in H. - destruct H. apply kEquiv in H. - exists x. apply kEquiv. apply frame_indep_core. auto. -Qed. - -Theorem maxKTransitive: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - (exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) -> - (exists n, sequentialStepMaxK fs r n = (fs'', r'')). -Proof. - setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. - destruct H, H0. exists (x + x0). - eapply transitive_eval; eauto. -Qed. - -Lemma maxKDone: - forall (r r' : Redex), - is_result r' -> - (exists n : nat, ([] : FrameStack, r') = ([], r)) <-> - (exists n, sequentialStepMaxK [] r' n = ([], r)). -Proof. - intros. split;intro. - * destruct H0. inv H0. setoid_rewrite <- RTCEquiv;[|auto]. - econstructor. split. auto. constructor. - * destruct H0. destruct x. - + rewrite maxKZeroRefl in H0. exists 0. auto. - + inv H; simpl in H0; exists 0; auto. -Qed. - -Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. -Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. - -Ltac case_innermost_term t := - lazymatch t with - | context[match ?x with _ => _ end] => - first [ case_innermost_term x - | let H := fresh "Heq" in - destruct x eqn:H; - first [apply Z_eqb_eq_corr in H - |apply Z_eqb_neq_corr in H - | idtac]] - | _ => fail "No match subterm found" - end. - -Ltac case_innermost := - match goal with - | |- ?g => case_innermost_term g - end. - -Ltac case_innermost_in H := - let T := type of H in - case_innermost_term T. - -Tactic Notation "case_innermost" := - case_innermost. - -Tactic Notation "case_innermost" ident(H) := - case_innermost_in H. - - -Ltac toRec := -match goal with -| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => - try (setoid_rewrite <- maxKInsertCanRec;[|constructor]);simpl; - try (setoid_rewrite <- maxKDone;[|constructor]) -| _ => idtac "nothing to do" -end. - -Ltac stepOne := -match goal with -| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => - try (setoid_rewrite <- maxKForwardOne;[|constructor]);simpl -| _ => idtac "nothing to do" -end. - -Ltac stepThousand := -match goal with -| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => - try (setoid_rewrite <- maxKForwardThousand;[|constructor]);simpl -| _ => idtac "nothing to do" -end. - -Ltac toNextRec := stepOne; toRec. - -Lemma NatZSuccPred: - forall (n : nat), (Z.of_nat (S n) - 1)%Z = Z.of_nat n. -Proof. lia. Qed. - -Theorem maxKTransitive': - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (P : Prop), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - ((exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) /\ P) -> - ((exists n, sequentialStepMaxK fs r n = (fs'', r'')) /\ P). -Proof. - setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. - destruct H, H0, H0. - split;auto. - exists (x + x0). - eapply transitive_eval; eauto. -Qed. - -Ltac solve_final_state := - eexists; - [auto| (* This is for the step number, which is always irrelevant (|- nat) when this tactic is called *) - first [ auto (* The program indeed terminated at ([], r) where is_result r *) - | idtac "Unexpected end state - (can be due to an exception in the Erlang program, - a result when an exception was expected, - non-termination in the given depth or - an impossible input that was not ruled out)" - ]]. - -Ltac solve_final_postcond := - first [ nia - | idtac "Could not solve postcondition" - ]. - -Ltac solve_terminated := - lazymatch goal with - | |- context[sequentialStepMaxK] => fail "The program has not yet terminated" - | |- _ => - lazymatch goal with - | |- ex _ => eexists;solve_terminated - | |- _ /\ _ => split;[solve_final_state|solve_final_postcond] - | |- _ => idtac - end - end. - -Ltac give_steps_if_needed_using steptac := - first [ progress simpl - | steptac - ]. - -Ltac match_with_backfall backfall := - lazymatch goal with - | |- context[match ?x with _ => _ end] => - case_innermost; - try nia; - backfall - | |- _ => fail "Match expression not found" - end. - -Ltac able_to_ind := - lazymatch goal with - | |- context[sequentialStepMaxK ?fs ?r] => - let b := eval compute in (canRec fs r) in - lazymatch b with - | true => idtac - | false => fail - end - | |- _ => fail - end. - -Ltac base_case := - stepThousand; - first [ solve_terminated - | match_with_backfall base_case - | base_case]. - -Ltac solve_IH_precond IH:= - lazymatch (type of IH) with - | ?A -> _ => - let proof := fresh "IHPrec" in - assert A as proof by lia; - specialize (IH proof); - clear proof - | _ => idtac - end. - -Ltac framestack_is_prefix IH := - lazymatch goal with - | |- context[sequentialStepMaxK ?fs _] => - lazymatch (type of IH) with - | context[sequentialStepMaxK ?fsIH _] => - let b := eval compute in (FrameStack_prefix fsIH fs) in - lazymatch b with - | true => idtac - | false => fail "Framestack in induction hypothesis is not a prefix" - end - | _ => fail "No step left in induction hypothesis, or symbolic variable inside framestack" - end - | |- _ => fail "No steps left in goal" - end. - -Ltac redex_matches IH := - lazymatch goal with - | |- context[sequentialStepMaxK _ ?r] => - lazymatch (type of IH) with - | context[sequentialStepMaxK _ ?rIH] => constr_eq r rIH - | _ => fail "No step left in induction hypothesis" - end - | |- _ => fail "No steps left in goal" - end. - -Ltac destruct_until_conj IH := - lazymatch (type of IH) with - | _ /\ _ => idtac - | ex _ => - let x := fresh "x" in - destruct IH as [x IH]; destruct_until_conj IH - | _ => idtac - end. - -Ltac eexists_until_conj := - lazymatch goal with - | |- _ /\ _ => idtac - | |- ex _ => eexists; eexists_until_conj - | |- _ => idtac - end. - -Ltac try_rectify_IH_redex IH kval := - specialize (IH kval); - setoid_rewrite Z2Nat.id in IH; try lia; - solve_IH_precond IH; - - framestack_is_prefix IH; - redex_matches IH. - -Ltac try_rectify_induction IH := - framestack_is_prefix IH; - lazymatch goal with - | |- context[sequentialStepMaxK _ ?r] => - lazymatch r with - | context[VLit (Integer ?k)] => try_rectify_IH_redex IH (Z.to_nat k) - | _ => idtac "did not find k" - end - | |- _ => idtac "Redex value not found" (* we need to continue... *) - end. - -Ltac solve_by_induction IH := - (* This tactic only gets called, if the framestack in IH is the prefix of the one in the goal, - and the redexes are syntactically the same. So these should always work... *) - destruct_until_conj IH; - let IHExp := fresh "IHExp" in - let IHPostcond := fresh "IHPostcond" in - destruct IH as [IHExp IHPostcond]; - let IHExp_fic := fresh "IHExp_fic" in - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic; simpl in IHExp_fic; - eexists_until_conj; - eapply maxKTransitive';[apply IHExp_fic|]; - base_case. - -Ltac ind_case IH := - let back_call := stepOne;ind_case IH in - toRec;cbn; - first [ solve_terminated - | match_with_backfall ind_case - | try_rectify_induction IH; solve_by_induction IH - | back_call]. - -Ltac induction_head symb := - let n := fresh "n" in - let IH := fresh "IH" in - induction symb as [n IH] using lt_wf_ind; - let Hn := fresh "Hn" in - destruct n eqn:Hn; - [base_case|stepOne;ind_case IH]. - -Ltac solve_to_rec symb := - toRec; - first [ solve_terminated - | able_to_ind; induction_head symb - | match_with_backfall solve_to_rec - | solve_to_rec]. - -Ltac solve_symbolically symb := - first [ intros; setoid_rewrite RTCEquiv;[|constructor]; solve_to_rec symb - | fail "Could not solve goal symbolically" - ]. - -Theorem fact_eval_ex: - forall (z : nat), - exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y /\ y >= 1)%Z. -Proof. - intros. - setoid_rewrite RTCEquiv;[|constructor]. - - toRec. - - induction z using lt_wf_ind. - destruct z. - * repeat stepThousand. - - solve_terminated. exact 0. - * toNextRec. - - cbn. - - specialize (H (Z.to_nat (Z.of_nat (S z) - 1)%Z)). - setoid_rewrite Z2Nat.id in H; try lia. - assert (Z.to_nat (Z.of_nat (S z) - 1) < S z) by lia. - specialize (H H0). clear H0. - - destruct H as [y [IHExp IHPostcond]]. - - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. - simpl in IHExp_fic. - - eexists. - eapply maxKTransitive'. auto. - repeat stepThousand. solve_terminated. -Qed. - -(* Require Import SMTCoq.Tactics. - -Lemma Z_of_nat_O : Z.of_nat 0 = 0%Z. Proof. reflexivity. Qed. -Lemma Z_of_nat_S n : Z.of_nat (S n) = (Z.of_nat n + 1)%Z. Proof. lia. Qed. - -Add_lemmas Z_of_nat_0 Z_of_nat_S. *) - -Theorem fact_eval_ex': - forall (z : nat), - exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y /\ y >= 1)%Z. -Proof. - solve_symbolically z. -Qed. - -Theorem fact_eval_ex'': - forall (z : nat), - exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z))%Z. -Proof. - solve_symbolically z. - - subst x. - rewrite <- Nat2Z.inj_mul. f_equal. - assert (1%Z = Z.of_nat (Z.to_nat 1)) by lia. rewrite H. clear H. - rewrite <- Nat2Z.inj_sub;[|lia]. - rewrite Nat2Z.id. simpl. rewrite Nat.sub_0_r. reflexivity. -Qed. - -Theorem fact_eval : forall n, - ⟨[], fact_frameStack (˝VLit (Z.of_nat n))⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. -Proof. - intros. - pose proof fact_eval_ex'' n. - destruct H. destruct H. subst x. auto. -Qed. - -(* - Let "e" and "d" be parameter expressions. - - letrec 'fact'/2 = - fun(X, A) -> - case of - <0> when 'true' -> A - when 'true' -> apply 'fact'/2(call 'erlang':'-'(Z, 1), call 'erlang':'*'(Z, A)) - in - apply 'fact'/2(e, d) - - Define the above expression! - *) -Definition tailrec_fact (e d : Exp) : Exp := - ELetRec [ - (2, °ECase (˝VVar 1) [ - ([PLit (Integer 0%Z)], ˝ttrue, ˝VVar 2); - ([PVar], ˝ttrue, - (°EApp (˝VFunId (1, 2)) - [°ECall (˝erlang) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]; - °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 0; ˝VVar 3] - ])) - ] - ) - ] (EApp (˝VFunId (0, 2)) [e; d]) -. - -Theorem tailrec_fact_eval : forall n, - ⟨[], tailrec_fact (˝VLit (Z.of_nat n)) (˝VLit 1%Z)⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. -Proof. Abort. - - -Theorem tailrec_fact_eval_ex: - forall (z : nat) (z' : Z), (0 <= z')%Z -> - exists (y : Z), - ⟨ [], (tailrec_fact (˝VLit (Z.of_nat z)) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z) * z')%Z. -Proof. - intros z. - setoid_rewrite RTCEquiv;[|constructor]. - do 8 stepOne. stepOne. - - induction z using lt_wf_ind; intros. - destruct z. - * repeat stepThousand. - - solve_terminated. exact 0. - * do 32 stepOne. cbn. - - specialize (H (Z.to_nat (Z.of_nat (S z) - 1)%Z)). - setoid_rewrite Z2Nat.id in H; try lia. - assert (Z.to_nat (Z.of_nat (S z) - 1) < S z) by lia. - specialize (H H1). clear H1. - specialize (H (Z.of_nat (S z) * z')%Z). - assert (0 ≤ Z.of_nat (S z) * z')%Z by lia. - specialize (H H1). clear H1. - - destruct H as [y [IHExp IHPostcond]]. - - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. - simpl in IHExp_fic. - - eexists. - eapply maxKTransitive'. auto. - repeat stepThousand. solve_terminated. - subst y. - Search Z.of_nat "_ * _". - Search Z.of_nat Z.to_nat. - rewrite <- (Z2Nat.id z' H0). - repeat rewrite <- Nat2Z.inj_mul. f_equal. - rewrite <- (Z2Nat.id 1);[|lia]. - rewrite <- Nat2Z.inj_sub. rewrite Nat2Z.id. 2:lia. - simpl. rewrite Nat.sub_0_r. lia. -Qed. - -Theorem tailrec_fact_eval_ex': - forall (z : nat), - exists (y : Z), - ⟨ [], (tailrec_fact (˝VLit (Z.of_nat z)) (˝VLit 1%Z)) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z))%Z. -Proof. - intros z. - setoid_rewrite RTCEquiv;[|constructor]. - toRec. toNextRec. - - induction z using lt_wf_ind; intros. - destruct z; intros. - * repeat stepThousand. - - solve_terminated. exact 0. - * toNextRec. toNextRec. cbn. - (* This can not be solved with simple induction, because even with just intoint z, - the hypothesis H is still not general enough. It wants the accumulator to be 1. *) -Abort. - -Theorem tailrec_fact_eval_ex'': - forall (z : nat) (z' : Z), (0 <= z')%Z -> - exists (y : Z), - ⟨ [], (tailrec_fact (˝VLit (Z.of_nat z)) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z) * z')%Z. -Proof. - intros z. - setoid_rewrite RTCEquiv;[|constructor]. - - unfold tailrec_fact. - do 8 stepOne. -Abort. - -Lemma jesus_christ: - forall xs res ident v vl, - (⟨FParams ident (vl ++ [v]) [] :: xs, RBox⟩ -->* res) -> - ⟨FParams ident vl [] :: xs, RValSeq [v]⟩ -->* res. -Proof. - intros. inv H. destruct H0. inv H0. inv H1. - econstructor. split;auto. - econstructor. econstructor. eauto. eauto. -Qed. - -Lemma jesus_christ_backwards: - forall xs res ident v vl, - ident <> IMap -> - ⟨FParams ident vl [] :: xs, RValSeq [v]⟩ -->* res -> - (⟨FParams ident (vl ++ [v]) [] :: xs, RBox⟩ -->* res). -Proof. - intros. inv H0. destruct H1. inv H1. inv H2. - econstructor. split;auto. - econstructor. econstructor. auto. eauto. eauto. -Qed. - -Lemma jesus_christ': - forall xs res ident v vl, - ident <> IMap -> is_result res -> - (exists n, sequentialStepMaxK (FParams ident (vl ++ [v]) [] :: xs) RBox n = ([], res)) <-> - (exists n, sequentialStepMaxK (FParams ident vl [] :: xs) (RValSeq [v]) n = ([], res)). -Proof. - intros. - setoid_rewrite <- RTCEquiv; auto. - split. apply jesus_christ. apply jesus_christ_backwards. auto. -Qed. - -Ltac test IH := - lazymatch (type of IH) with - | context[sequentialStepMaxK ?fs _] => idtac "found it!" - | _ => idtac "did not find it" - end. - -Theorem tailrec_fact_eval_ex''': - forall (z : nat) (z' : Z), (*(0 <= z')%Z ->*) - exists (y : Z), - ⟨ [], (tailrec_fact (˝VLit (Z.of_nat z)) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z) * z')%Z. -Proof. - intros z. - setoid_rewrite RTCEquiv;[|constructor]. - - unfold tailrec_fact. - do 8 stepOne. setoid_rewrite <- jesus_christ';auto. simpl. - - induction z using lt_wf_ind; intros. - destruct z. - * repeat stepThousand. solve_terminated. exact 0. - * toNextRec. toNextRec. cbn. - test H. - Print frame_indep_core_func. - - setoid_rewrite <- jesus_christ';auto. simpl. - specialize (H (Z.to_nat ((Z.of_nat (S z) - 1)%Z))). - assert (Z.to_nat ((Z.of_nat (S z) - 1)%Z) < S z) by lia. - specialize (H H0). clear H0. - setoid_rewrite Z2Nat.id in H;[|lia]. - specialize (H (Z.of_nat (S z) * z')%Z). - - destruct H as [y [IHExp IHPostcond]]. - Print frame_indep_core_func. - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. - simpl in IHExp_fic. - - eexists. Print maxKTransitive'. - eapply maxKTransitive'. auto. - repeat stepThousand. solve_terminated. - subst y. - Search Z.of_nat "_ * _". - Search Z.of_nat Z.to_nat. - rewrite Z.mul_assoc. f_equal. - rewrite <- Nat2Z.inj_mul. f_equal. - rewrite <- (Z2Nat.id 1);[|lia]. - rewrite <- Nat2Z.inj_sub. rewrite Nat2Z.id. 2:lia. - simpl. rewrite Nat.sub_0_r. lia. -Qed. - -Definition canRecNew (fs : FrameStack) (r : Redex) : bool := - match fs with - | FParams (IApp (VClos (_ :: _) _ _ _)) _ [] :: _ => - match r with - | RValSeq _ => true - | RBox => true - | _ => false - end - | _ => false - end. - -Definition lastParamRBox (fs : FrameStack) (r : Redex) : (FrameStack * Redex) := - match fs, r with - | FParams ident vl ex :: fs', RValSeq [v] => (FParams ident (vl ++ [v]) ex :: fs', RBox) - | FParams ident vl ex :: fs', RBox => (FParams ident vl ex :: fs', RBox) - | fs', r => (fs', r) - end. - -Fixpoint sequentialStepCanRecNew (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match canRecNew fs r with - | true => lastParamRBox fs r - | false => - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepCanRecNew fs' r' n' - end - end - end. - -Lemma last_param_box_equiv: - forall xs ident v vl fs' r', - ident <> IMap -> - (exists k, ⟨FParams ident (vl ++ [v]) [] :: xs, RBox⟩ -[S k]-> ⟨ fs', r' ⟩) <-> - exists k, ⟨FParams ident vl [] :: xs, RValSeq [v]⟩ -[S k]-> ⟨ fs', r' ⟩. -Proof. - intros. - split;intro. - * destruct H0. inv H0. inv H2. - exists x. econstructor. econstructor. eauto. auto. - * destruct H0. inv H0. inv H2. - exists x. econstructor. econstructor. auto. eauto. auto. -Qed. - -Lemma maxKTransCanRecNew: - forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), - is_result r'' -> - sequentialStepCanRecNew fs r k = (fs', r') -> - (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros. - destruct H1. revert H0 H1. revert x fs fs' r r'. - induction k; intros. - + unfold sequentialStepCanRecNew in H0. - destruct (canRecNew fs r) eqn:HCanRec. - - unfold canRecNew in HCanRec. - destruct fs; try discriminate. - destruct f; try discriminate. - destruct ident; try discriminate. - destruct v; try discriminate. - destruct ext; try discriminate. - destruct el; try discriminate. - destruct r; try discriminate. - ** simpl in H0. destruct vs. - ++ inv H0. exists x. auto. - ++ destruct vs. - -- inv H0. destruct x. - *** rewrite maxKZeroRefl in H1. inv H1. - *** exists (S x). - simpl in H1. simpl. - destruct (params =? length (vl ++ [v]));auto. - -- inv H0. exists x. auto. - ** simpl in H0. inv H0. exists x. auto. - - destruct (sequentialStepFunc fs r) eqn:Hssf. 1:destruct p. all:inv H0. all:eexists;eauto. - + simpl in H0. - destruct (canRecNew fs r) eqn:HCanRec. - - unfold canRecNew in HCanRec. - destruct fs; try discriminate. - destruct f; try discriminate. - destruct ident; try discriminate. - destruct v; try discriminate. - destruct ext; try discriminate. - destruct el; try discriminate. - destruct r; try discriminate. - ** simpl in H0. destruct vs. - ++ inv H0. exists x. auto. - ++ destruct vs. - -- inv H0. destruct x. - *** rewrite maxKZeroRefl in H1. inv H1. - *** exists (S x). - simpl in H1. simpl. - destruct (params =? length (vl ++ [v]));auto. - -- inv H0. exists x. auto. - ** simpl in H0. inv H0. - exists x. auto. - - destruct (sequentialStepFunc fs r) eqn:Hssf. - ** destruct p. specialize (IHk _ _ _ _ _ H0 H1). - destruct IHk. exists (S x0). unfold sequentialStepMaxK. rewrite Hssf. - fold sequentialStepMaxK. auto. - ** inv H0. - destruct x. - ++ rewrite maxKZeroRefl in H1. inv H1. exists 0. apply maxKZeroRefl. - ++ unfold sequentialStepMaxK in H1. rewrite Hssf in H1. inv H1. - exists 0. apply maxKZeroRefl. -Qed. - -Goal forall o, o = "true"%string -> o = "true"%string \/ o = "false"%string. Proof. auto. Qed. - -Lemma maxKInsertCanRecNew: - forall (fs : FrameStack) (r r'' : Redex), - is_result r'' -> - (exists n, (let (fs', r') := sequentialStepCanRecNew fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros. split; intros. - * destruct (sequentialStepCanRecNew fs r 1000) eqn:Hsscr. - eapply maxKTransCanRecNew; eauto. - * destruct H0. - destruct (sequentialStepCanRecNew fs r 1000) eqn:Hsscr. - remember 1000 as k. clear Heqk. - revert H0 Hsscr. revert fs r f r0 k. - induction x; intros. - + rewrite maxKZeroRefl in H0. inv H0. inv H. - all:destruct k. - all:inv Hsscr. all:exists 0; auto. - + unfold sequentialStepMaxK in H0. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold sequentialStepMaxK in H0. - destruct k. - ** simpl in Hsscr. - destruct (canRecNew fs r) eqn:HCanRec. - ++ unfold canRecNew in HCanRec. - destruct fs; try discriminate. - destruct f1; try discriminate. - destruct ident; try discriminate. - destruct v; try discriminate. - destruct ext; try discriminate. - destruct el; try discriminate. destruct r; try discriminate. - -- simpl in Hsscr. destruct vs. - *** inv Hsscr. - *** destruct vs. - +++ inv Hsscr. - exists (S x). simpl. - simpl in Hssf. - destruct (params =? length (vl ++ [v])); inv Hssf; auto. - +++ inv Hsscr. - -- simpl in Hsscr. inv Hsscr. - exists (S x). unfold sequentialStepMaxK. - rewrite Hssf. fold sequentialStepMaxK. auto. - ++ rewrite Hssf in Hsscr. inv Hsscr. exists (S x). - unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. - ** simpl in Hsscr. - destruct (canRecNew fs r) eqn:HCanRec. - ++ unfold canRecNew in HCanRec. - destruct fs; try discriminate. - destruct f1; try discriminate. - destruct ident; try discriminate. - destruct v; try discriminate. - destruct ext; try discriminate. - destruct el; try discriminate. - destruct r; try discriminate. - -- simpl in Hsscr. destruct vs. - *** inv Hsscr. - *** destruct vs. - +++ inv Hsscr. - exists (S x). unfold sequentialStepMaxK. simpl. simpl in Hssf. - rewrite Hssf. fold sequentialStepMaxK. auto. - +++ inv Hsscr. - -- simpl in Hsscr. inv Hsscr. exists (S x). - unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. - ++ rewrite Hssf in Hsscr. - specialize (IHx _ _ _ _ _ H0 Hsscr). auto. - - inv H0. - destruct k. - ** unfold sequentialStepCanRecNew in Hsscr. - destruct (canRecNew [] r'') eqn:HCanRec. - ++ simpl in HCanRec. discriminate. - ++ rewrite Hssf in Hsscr. inv Hsscr. exists 0. apply maxKZeroRefl. - ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. - all:exists 0; auto. -Qed. - -Theorem tailrec_fact_eval_ex'''': - forall (z : Z) (z' : Z), (0 <= z)%Z -> - exists (y : Z), - ⟨ [], (tailrec_fact (˝VLit z) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z)) * z')%Z. -Proof. - setoid_rewrite RTCEquiv;[|constructor]. - toRec. do 2 stepOne. setoid_rewrite <- jesus_christ';auto. simpl. - intros z z' IHPreCond. - assert (0 <= z)%Z by lia. revert z'. revert IHPreCond. - apply Zlt_0_ind with (x := z);auto. clear H z. intros z. intros IH. intros a. intros. - destruct z;try nia. - * repeat stepThousand. solve_terminated. exact 0. - * stepOne. toRec. cbn. do 11 stepOne. cbn. setoid_rewrite <- jesus_christ';auto. simpl. - specialize (IH (Z.pos p - 1)%Z). - assert (0 <= Z.pos p - 1 < Z.pos p)%Z by lia. - specialize (IH H). clear H. - assert (0 <= Z.pos p - 1)%Z by lia. - specialize (IH H). clear H. - - destruct H as [y [IHExp IHPostcond]]. - - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. - simpl in IHExp_fic. - - eexists. - eapply maxKTransitive'. auto. - repeat stepThousand. solve_terminated. exact 0. - - - - subst y. - rewrite Z.mul_assoc. f_equal. - rewrite <- positive_nat_Z at 2. - rewrite <- Nat2Z.inj_mul. - f_equal. - rewrite Z2Nat.inj_sub;try nia. - assert (Z.to_nat 1%Z = 1) by lia. rewrite H. clear H. - rewrite Z2Nat.inj_pos. - Search Pos.to_nat "_ - _". - assert (1 = Pos.to_nat (Pos.of_nat 1)) by lia. - rewrite H. clear H. - destruct p. - + rewrite <- Pos2Nat.inj_sub; try lia. - assert (Pos.of_nat 1 = 1%positive) by lia. rewrite H. clear H. - rewrite Pos.sub_1_r. - assert (Pos.pred p~1 = p~0)%positive by lia. rewrite H. clear H. - remember (Pos.to_nat p~0) as k. - assert (Pos.to_nat p~1 = S k) by lia. rewrite H. clear H. clear Heqk. - unfold fact at 2. fold fact. rewrite Nat.mul_comm. reflexivity. - + rewrite <- Pos2Nat.inj_sub; try lia. - assert (Pos.of_nat 1 = 1%positive) by lia. rewrite H. clear H. - rewrite Pos.sub_1_r. - remember (Pos.to_nat (Pos.pred p~0)) as k. - assert (Pos.to_nat p~0 = S k) by lia. rewrite H. clear H. - unfold fact at 2. fold fact. rewrite Nat.mul_comm. reflexivity. - + simpl. nia. -Qed. - -Theorem fact_eval_ex''': - forall (z : Z), (0 <= z)%Z -> - exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (z <= y /\ y >= 1)%Z. -Proof. - setoid_rewrite RTCEquiv;[|auto]. - toRec. setoid_rewrite <- jesus_christ';auto. simpl. - intros z HPreCond. - assert (0 <= z)%Z by lia. revert HPreCond. - Print Zlt_0_ind. - apply Zlt_0_ind with (x := z);try nia. - intros. - destruct x; try nia. - * repeat stepThousand. solve_terminated. exact 0. - * stepOne. toRec. setoid_rewrite <- jesus_christ';auto. simpl. - specialize (H0 (Z.pos p - 1)%Z). - assert (0 ≤ Z.pos p - 1 < Z.pos p)%Z by lia. specialize (H0 H2). clear H2. - (* specialize H0 by the rest of the symb vars... *) - assert (0 ≤ Z.pos p - 1)%Z by lia. specialize (H0 H2). clear H2. - - destruct H0 as [y [IHExp IHPostcond]]. - - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. - simpl in IHExp_fic. - - eexists. - eapply maxKTransitive'. auto. - repeat stepThousand. solve_terminated. exact 0. -Qed. - -Definition timestwo (e : Exp) : Exp := - ELetRec [ - (1, °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 1; ˝VLit 2%Z] - - ) - ] (EApp (˝VFunId (0, 1)) [e]). - -Definition timestwo' (e : Exp) : Exp := - °ECall (˝erlang) (˝VLit "*"%string) [e; ˝VLit 2%Z]. - -Theorem timestwo_ex: - forall (z : nat), - exists (y : Z), - ⟨ [], (timestwo (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z * 2)%Z. -Proof. - solve_symbolically z. -Qed. - -Theorem timestwo'_ex: - forall (z : nat), - exists (y : Z), - ⟨ [], (timestwo' (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z * 2)%Z. -Proof. - solve_symbolically z. -Qed. - -Definition times_two_simple (e : Exp) : Exp := - (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "*"%string))) [e;(VVal (VLit (Integer (2))))])). - -Theorem times_two_simple_ex: - forall (z : nat), - exists (y : Z), - ⟨ [], (times_two_simple (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z * 2)%Z. -Proof. - solve_symbolically z. -Qed. - -Definition times_two_rec (e : Exp) : Exp := ELetRec [ -(1, (EExp (ECase (VVal (VVar 1)) -[ - ([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0))))); - ([PVar], (VVal (VLit (Atom "true"%string))), - (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) - (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VVar 0))]));(VVal (VLit (Integer (2))))])))))])))] - -(EApp (VVal (VFunId (0, 1))) [e]). - -Theorem times_two_rec_ex: - forall (z : nat), - exists (y : Z), - ⟨ [], (times_two_rec (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z * 2)%Z. -Proof. - solve_symbolically z. -Qed. - -Definition plus_nums_simple (e f : Exp) : Exp := -(EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [e;f])). - -Theorem plus_nums_simple_ex: - forall (z : nat) (z' : nat), - exists (y : Z), - ⟨ [], (plus_nums_simple (˝VLit (Z.of_nat z)) (˝VLit (Z.of_nat z'))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z + Z.of_nat z')%Z. -Proof. - solve_symbolically z. -Qed. - -Definition plus_nums_rec (e f : Exp) : Exp := -ELetRec [ -(2, (EExp (ECase (VVal (VVar 1)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VVar 2)));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VVar 0));(VVal (VVar 8))]));(VVal (VLit (Integer (1))))])))))]))) -] (EApp (VVal (VFunId (0, 2))) [e;f]). - -Theorem plus_nums_rec_ex: - forall (z : nat) (z' : nat), - exists (y : Z), - ⟨ [], (plus_nums_rec (˝VLit (Z.of_nat z)) (˝VLit (Z.of_nat z'))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z + Z.of_nat z')%Z. -Proof. - setoid_rewrite RTCEquiv;[|constructor]. - toRec. - - induction z using lt_wf_ind; intros. - destruct z. - * repeat stepThousand. solve_terminated. - * admit. -Admitted. - -Definition isitzero_atom (e : Exp) : Exp := -(EExp (ECase (e) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "true"%string))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "false"%string))))])). - -Theorem isitzero_atom_ex: - forall (z : nat), - exists (y : string), - ⟨ [], (isitzero_atom (˝VLit (Z.of_nat (S z)))) ⟩ -->* RValSeq [VLit y] /\ (y = "false"%string)%Z. -Proof. - solve_symbolically z. auto. -Qed. - -Definition isitzero_num (e : Exp) : Exp := -(EExp (ECase (e) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (1)))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0)))))])). - -Theorem isitzero_num_ex: - forall (z : nat), - exists (y : Z), - ⟨ [], (isitzero_num (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((y = 0)%Z \/ (y = 1)%Z). -Proof. - setoid_rewrite RTCEquiv;[|constructor]. - intros z. - stepOne. stepOne. stepOne. - case_innermost. - * stepThousand. solve_terminated. - * stepThousand. solve_terminated. - - (*solve_symbolically z.*) -Qed. - -Definition isitzero_num_app (e : Exp) : Exp := -EExp ( EApp ( EFun 1 (EExp (ECase (VVal (VVar 0)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (1)))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0)))))]))) [e]). - -Theorem isitzero_num_app_ex: - forall (z : Z), - exists (y : Z), - ⟨ [], (isitzero_num_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ ((y = 0)%Z \/ (y = 1)%Z). -Proof. - setoid_rewrite RTCEquiv;[|constructor]. - intros z. - stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. - case_innermost. - * stepOne. stepOne. stepOne. stepOne. solve_terminated. exact 0. - * stepOne. stepOne. stepOne. stepOne. stepOne. solve_terminated. exact 0. - - (*solve_symbolically z.*) -Qed. - -Definition isitzero_atom_app (e : Exp) : Exp := -EExp ( EApp ( EFun 1(EExp (ECase (VVal (VVar 0)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "true"%string))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "false"%string))))]))) [e]). - -Theorem isitzero_atom_app_ex: - forall (z : Z), (z > 0)%Z -> - exists (y : string), - ⟨ [], (isitzero_atom_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = "false"%string). -Proof. - setoid_rewrite RTCEquiv;[|constructor]. - intros. unfold isitzero_atom_app. - stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. stepOne. - case_innermost. - * lia. - * stepOne. stepOne. stepOne. stepOne. stepOne. solve_terminated. exact 0. auto. -Qed. - -Theorem timestwo_ex': - forall (z : Z), - exists (y : Z), - ⟨ [], (times_two_simple (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. -Proof. - setoid_rewrite RTCEquiv;[|constructor]. unfold times_two_simple. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - intros. solve_terminated. exact 0. -Qed. - -Print EFun. - -Definition times_two_simple_app (e : Exp) : Exp := - EExp (EApp (EExp (EFun 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "*"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (2))))])))) [e]). - -Theorem timestwo_ex'': - forall (z : Z), - exists (y : Z), - ⟨ [], (times_two_simple_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. -Proof. - setoid_rewrite RTCEquiv;[|constructor]. unfold times_two_simple_app. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. cbn. - stepOne. - intros. solve_terminated. exact 0. -Qed. - -Theorem timestwo_ex''': - forall (z : nat), - exists (y : Z), - ⟨ [], (times_two_rec (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = (Z.of_nat z) * 2)%Z. -Proof. - setoid_rewrite RTCEquiv;[|constructor]. unfold times_two_rec. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. setoid_rewrite <- jesus_christ';auto. simpl. - induction z using lt_wf_ind. - destruct z. - * do 7 stepOne. do 1 stepOne. solve_terminated. exact 0. - * do 30 stepOne. setoid_rewrite <- jesus_christ';auto. simpl. - specialize (H z). assert (z < S z) by lia. apply H in H0. clear H. - destruct H0. destruct H. - eapply frame_indep_core_func with (fsapp := [FParams (ICall (VLit "erlang"%string) (VLit "+"%string)) [] [˝ VLit 2%Z]]) in H. simpl in H. - eexists. eapply maxKTransitive'. assert (Z.of_nat (S z) - 1 = Z.of_nat z)%Z by lia. rewrite H1. eauto. - - do 3 stepOne. cbn. admit. - -(* stepOne. - stepOne. - stepOne. - stepOne. intros z. case_innermost. repeat stepThousand. solve_terminated. exact 0. - do 29 stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - stepOne. - *) -Abort. - -Ltac my_tac args := - lazymatch args with - | (?a, ?rest) => - (* first argument is a *) - (* rest is the remaining arguments *) - (* do something with a ... *) - revert rest; - my_tac a - | (?only) => revert only - end. - -Theorem asd: forall (a s d f : nat), (a = a) /\ (s = s) /\ (d = d) /\ (f = f) /\ True. -Proof. -intros. -Compute (a,s,d,f). -my_tac (a,s,d,f). auto. Qed. - -Theorem timestwo_ex''': - forall (z : nat), - exists (y : Z), - ⟨ [], (plus_nums_rec (˝VLit (Z.of_nat z)) (˝VLit 0%Z)) ⟩ -->* RValSeq [VLit y] /\ (y = (Z.of_nat z))%Z. -Proof. - setoid_rewrite RTCEquiv;[|constructor]. - do 8 stepOne. -Admitted. - - -Definition plus_nums_rec' (e f : Exp) := ELetRec [(2, (EExp (ECase (VVal (VVar 1)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VVar 2)));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 4));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (3, 2))) [(VVal (VVar 1));(VVal (VVar 0))])))))))])))] (EApp (VVal (VFunId (0, 2))) [e;f]). - -Theorem plus_nums_rec_ex': - forall (z : nat), - exists (y : Z), - ⟨ [], (plus_nums_rec' (˝VLit (Z.of_nat z)) (˝VLit 0%Z)) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat z)%Z. -Proof. -setoid_rewrite RTCEquiv;[|constructor]. -do 8 stepOne. setoid_rewrite <- jesus_christ'; auto. simpl. -induction z using lt_wf_ind. -destruct z. stepThousand. solve_terminated. exact 0. -do 38 stepOne. setoid_rewrite <- jesus_christ'; auto. simpl. -Admitted. - -Theorem helper: - forall fs fs' - - - - - - - - - - - - diff --git a/src/Symbolic/SymbExamples.v b/src/Symbolic/SymbExamples.v new file mode 100644 index 00000000..cb8b7b12 --- /dev/null +++ b/src/Symbolic/SymbExamples.v @@ -0,0 +1,229 @@ +From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. +From CoreErlang.Interpreter Require Import StepFunctions Equivalences. +From CoreErlang.Symbolic Require Import SymbTheorems SymbTactics. + +Import ListNotations. + +Definition fact_frameStack (e : Exp) : Exp := + ELetRec + [(1, °ECase (˝VVar 1) [ + ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); + ([PVar], ˝ttrue, + °ELet 1 (EApp (˝VFunId (1, 1)) + [°ECall (˝VLit "erlang"%string) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]]) + (°ECall (˝VLit "erlang"%string) (˝VLit "*"%string) [˝VVar 1; ˝VVar 0]) + ) + ])] + (EApp (˝VFunId (0, 1)) [e]) + (* Write the definition here *) +. + +Theorem fact_eval_ex: + forall (z : Z), (0 <= z)%Z -> + exists (y : Z), + ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (z <= y /\ y >= 1)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition tailrec_fact (e d : Exp) : Exp := + ELetRec [ + (2, °ECase (˝VVar 1) [ + ([PLit (Integer 0%Z)], ˝ttrue, ˝VVar 2); + ([PVar], ˝ttrue, + (°EApp (˝VFunId (1, 2)) + [°ECall (˝erlang) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]; + °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 0; ˝VVar 3] + ])) + ] + ) + ] (EApp (˝VFunId (0, 2)) [e; d]) +. + +Theorem fact_tailrec_eval_ex: + forall (z : Z) (z' : Z), (0 <= z)%Z -> + exists (y : Z), + ⟨ [], (tailrec_fact (˝VLit z) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z)) * z')%Z. +Proof. + solve_symbolically z z'. + + destruct PreCond0. subst. + rewrite Z.mul_assoc. f_equal. + rewrite <- positive_nat_Z. + rewrite <- Nat2Z.inj_mul. f_equal. + assert (1%Z = Z.of_nat (Z.to_nat 1%Z))%Z by lia. rewrite H0. clear H0. + rewrite <- Nat2Z.inj_sub;[|lia]. + do 2 rewrite Nat2Z.id. + remember (Pos.to_nat p) as k. + pose proof Pos2Nat.is_pos p. + destruct k; try lia. + simpl. + rewrite Nat.sub_0_r. lia. +Qed. + +Definition timestwo (e : Exp) : Exp := + ELetRec [ + (1, °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 1; ˝VLit 2%Z] + + ) + ] (EApp (˝VFunId (0, 1)) [e]). + +Definition timestwo' (e : Exp) : Exp := + °ECall (˝erlang) (˝VLit "*"%string) [e; ˝VLit 2%Z]. + +Theorem timestwo_ex: + forall (z : Z), True -> + exists (y : Z), + ⟨ [], (timestwo (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Theorem timestwo'_ex: + forall (z : Z), True -> + exists (y : Z), + ⟨ [], (timestwo' (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition times_two_simple (e : Exp) : Exp := + (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "*"%string))) [e;(VVal (VLit (Integer (2))))])). + +Theorem times_two_simple_ex: + forall (z : Z), True -> + exists (y : Z), + ⟨ [], (times_two_simple (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition times_two_rec (e : Exp) : Exp := ELetRec [ +(1, (EExp (ECase (VVal (VVar 1)) +[ + ([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0))))); + ([PVar], (VVal (VLit (Atom "true"%string))), + (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) + (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VVar 0))]));(VVal (VLit (Integer (2))))])))))])))] + +(EApp (VVal (VFunId (0, 1))) [e]). + +Theorem times_two_rec_ex: + forall (z : Z), (0 <= z)%Z -> + exists (y : Z), + ⟨ [], (times_two_rec (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition plus_nums_simple (e f : Exp) : Exp := +(EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [e;f])). + +Theorem plus_nums_simple_ex: + forall (z : Z) (z' : Z), True -> + exists (y : Z), + ⟨ [], (plus_nums_simple (˝VLit z) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = z + z')%Z. +Proof. + solve_symbolically z. +Qed. + +Definition plus_nums_rec (e f : Exp) := ELetRec [(2, (EExp (ECase (VVal (VVar 1)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VVar 2)));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 4));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (3, 2))) [(VVal (VVar 1));(VVal (VVar 0))])))))))])))] (EApp (VVal (VFunId (0, 2))) [e;f]). + +Theorem plus_nums_rec_ex: + forall (z : Z), + exists (y : Z), + ⟨ [], (plus_nums_rec (˝VLit z) (˝VLit 0%Z)) ⟩ -->* RValSeq [VLit y] /\ (y = z)%Z. +Proof. + (* This cannot be proven by induction, since the goal is too specific. *) +Abort. + +Theorem plus_nums_rec_ex': + forall (z : Z) (z' : Z), (z >= 0)%Z -> + exists (y : Z), + ⟨ [], (plus_nums_rec (˝VLit z) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = z + z')%Z. +Proof. + solve_symbolically z z'. +Qed. + + +Definition isitzero_atom (e : Exp) : Exp := +(EExp (ECase (e) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "true"%string))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "false"%string))))])). + +Theorem isitzero_atom_ex: + forall (z : Z), (z >= 0)%Z -> + exists (y : string), + ⟨ [], (isitzero_atom (˝VLit (Z.succ z))) ⟩ -->* RValSeq [VLit y] /\ (y = "false"%string)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition isitzero_num (e : Exp) : Exp := +(EExp (ECase (e) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (1)))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0)))))])). + +Theorem isitzero_num_ex: + forall (z : Z), True -> + exists (y : Z), + ⟨ [], (isitzero_num (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ ((y = 0)%Z \/ (y = 1)%Z). +Proof. + solve_symbolically z. +Qed. + +Definition isitzero_num_app (e : Exp) : Exp := +EExp ( EApp ( EFun 1 (EExp (ECase (VVal (VVar 0)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (1)))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0)))))]))) [e]). + +Theorem isitzero_num_app_ex: + forall (z : Z), True -> + exists (y : Z), + ⟨ [], (isitzero_num_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ ((y = 0)%Z \/ (y = 1)%Z). +Proof. + solve_symbolically z. +Qed. + +Definition isitzero_atom_app (e : Exp) : Exp := +EExp ( EApp ( EFun 1(EExp (ECase (VVal (VVar 0)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "true"%string))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "false"%string))))]))) [e]). + +Theorem isitzero_atom_app_ex: + forall (z : Z), (z > 0)%Z -> + exists (y : string), + ⟨ [], (isitzero_atom_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = "false"%string). +Proof. + solve_symbolically z. +Qed. + +Theorem timestwo_ex': + forall (z : Z), + exists (y : Z), + ⟨ [], (times_two_simple (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Definition times_two_simple_app (e : Exp) : Exp := + EExp (EApp (EExp (EFun 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "*"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (2))))])))) [e]). + +Theorem timestwo_ex'': + forall (z : Z), + exists (y : Z), + ⟨ [], (times_two_simple_app (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + +Theorem timestwo_ex''': + forall (z : Z), (0 <= z)%Z -> + exists (y : Z), + ⟨ [], (times_two_rec (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = z * 2)%Z. +Proof. + solve_symbolically z. +Qed. + + + + + + + + + + + diff --git a/src/Symbolic/SymbFinal.v b/src/Symbolic/SymbTactics.v similarity index 60% rename from src/Symbolic/SymbFinal.v rename to src/Symbolic/SymbTactics.v index 5066296d..eca5f0c6 100644 --- a/src/Symbolic/SymbFinal.v +++ b/src/Symbolic/SymbTactics.v @@ -1,393 +1,9 @@ From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. From CoreErlang.Interpreter Require Import StepFunctions Equivalences. +From CoreErlang.Symbolic Require Import SymbTheorems. Import ListNotations. -(* ----- DEFINITIONS ----- *) - -Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepMaxK fs' r' n' - end - end. - -Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := - match n with - | 0 => Some (fs, r) - | S n' => - match sequentialStepFunc fs r with - | Some (fs', r') => sequentialStepK fs' r' n' - | None => None - end - end. - -Definition canRec (fs : FrameStack) (r : Redex) : bool := - match fs with - | FParams (IApp (VClos (_ :: _) _ _ _)) _ [] :: _ => - match r with - | RValSeq _ => true - | RBox => true - | _ => false - end - | _ => false - end. - -Definition lastParamRBox (fs : FrameStack) (r : Redex) : (FrameStack * Redex) := - match fs, r with - | FParams ident vl ex :: fs', RValSeq [v] => (FParams ident (vl ++ [v]) ex :: fs', RBox) - | FParams ident vl ex :: fs', RBox => (FParams ident vl ex :: fs', RBox) - | fs', r => (fs', r) - end. - -Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match canRec fs r with - | true => lastParamRBox fs r - | false => - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepCanRec fs' r' n' - end - end - end. - -Arguments sequentialStepMaxK !_ !_ !_ /. -Arguments sequentialStepK !_ !_ !_ /. -Arguments sequentialStepCanRec !_ !_ !_ /. - -(* ----- LEMMAS ----- *) - -Lemma maxKZeroRefl: - forall (fs : FrameStack) (r : Redex), - sequentialStepMaxK fs r 0 = (fs, r). -Proof. - intros. unfold sequentialStepMaxK. - destruct (sequentialStepFunc fs r). - 1:destruct p. all:reflexivity. -Qed. - -Lemma maxKForwardOne: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - (exists n, sequentialStepMaxK fs r (S n) = ([], r')) <-> - exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros. split; intro. - * destruct H0. exists (S x). auto. - * destruct H0. destruct x. - + exists 0. - rewrite maxKZeroRefl in H0. inv H0. - inv H. all:auto. - + exists x. auto. -Qed. - -Lemma maxKOverflow: - forall (fs : FrameStack) (r r' : Redex) (n m : nat), - is_result r' -> - n <= m -> - sequentialStepMaxK fs r n = ([], r') -> - sequentialStepMaxK fs r m = ([], r'). -Proof. - intros fs r r' n. revert fs r r'. - induction n; intros. - * destruct m. - + auto. - + rewrite maxKZeroRefl in H1. inv H1. - inv H. all:auto. - * destruct m. - + inv H0. - + unfold sequentialStepMaxK in H1|-*. - destruct (sequentialStepFunc fs r). - 1:destruct p; fold sequentialStepMaxK. - all:fold sequentialStepMaxK in H1. - - apply IHn; auto. lia. - - auto. -Qed. - -Lemma maxKForwardThousand: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - (exists n, sequentialStepMaxK fs r (1000 + n) = ([], r')) <-> - exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros. split; intro. - * destruct H0. exists (1000 + x). auto. - * destruct H0. - exists x. - apply (maxKOverflow _ _ _ x); auto. lia. -Qed. - -Lemma maxKEquivK: - forall (fs fs' : FrameStack) (r r' : Redex), - (exists n, sequentialStepK fs r n = Some (fs', r')) <-> - (exists n, sequentialStepMaxK fs r n = (fs', r')). -Proof. - intros. split;intro. - * destruct H. exists x. - revert H. revert fs r. - induction x; intros. - + unfold sequentialStepK in *. inv H. - rewrite maxKZeroRefl. auto. - + unfold sequentialStepMaxK. - unfold sequentialStepK in H. - destruct (sequentialStepFunc fs r). - 1:destruct p. - all:fold sequentialStepMaxK. all:fold sequentialStepK in H. - all:auto. inv H. - * destruct H. revert H. revert fs r. - induction x; intros. - + rewrite maxKZeroRefl in H. inv H. exists 0. - unfold sequentialStepK. reflexivity. - + unfold sequentialStepMaxK in H. - destruct (sequentialStepFunc fs r) eqn:Hssf; fold sequentialStepMaxK in H. - - destruct p. - apply IHx in H. destruct H. exists (S x0). - unfold sequentialStepK. rewrite Hssf. fold sequentialStepK. - auto. - - inv H. exists 0. unfold sequentialStepK. reflexivity. -Qed. - -Lemma kEquiv: - forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), - ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> sequentialStepK fs r k = Some (fs', r'). -Proof. - intros. split;revert fs fs' r r'. - * induction k; intros. - + inv H. unfold sequentialStepK. auto. - + inv H. unfold sequentialStepK. - apply sequentialStepEquiv in H1. rewrite H1. - fold sequentialStepK. auto. - * induction k; intros. - + unfold sequentialStepK in H. inv H. constructor. - + unfold sequentialStepK in H. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold sequentialStepK in H. - apply sequentialStepEquiv in Hssf. - econstructor; eauto. - - inv H. -Qed. - -Theorem RTCEquiv: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - ⟨ fs, r ⟩ -->* r' <-> exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros fs r r' Hres. split; intros. - * inv H. destruct H0. - apply kEquiv in H0. - apply maxKEquivK. - exists x. auto. - * apply maxKEquivK in H. - destruct H. econstructor. split;[auto|]. - apply kEquiv. eauto. -Qed. - -Lemma canRecUnfold: - forall (fs : FrameStack) (r : Redex), - canRec fs r = true -> - exists ext_top ext' id params e vl fs', - (fs = FParams (IApp (VClos (ext_top :: ext') id params e)) vl [] :: fs') /\ - ((exists vseq, r = RValSeq vseq) \/ (r = RBox)). -Proof. - intros. unfold canRec in H. - destruct fs; try discriminate. destruct f; try discriminate. destruct ident; try discriminate. - destruct v; try discriminate. destruct ext; try discriminate. destruct el; try discriminate. - destruct r; try discriminate. - * do 8 eexists. 1:reflexivity. left. eexists. reflexivity. - * do 8 eexists. 1:reflexivity. right. reflexivity. -Qed. - -Lemma maxKTransCanRec: - forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), - is_result r'' -> - sequentialStepCanRec fs r k = (fs', r') -> - (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros. - destruct H1. revert H0 H1. revert x fs fs' r r'. - induction k; intros. - + unfold sequentialStepCanRec in H0. - destruct (canRec fs r) eqn:HCanRec. - - apply canRecUnfold in HCanRec. - destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. - * subst. simpl in H0. destruct vs. - ++ inv H0. exists x. auto. - ++ destruct vs. - -- inv H0. destruct x. - ** rewrite maxKZeroRefl in H1. inv H1. - ** exists (S x). - simpl in H1. simpl. - destruct (params =? length (vl ++ [v]));auto. - -- inv H0. exists x. auto. - * subst. simpl in H0. inv H0. exists x. auto. - - destruct (sequentialStepFunc fs r) eqn:Hssf. 1:destruct p. all:inv H0. all:eexists;eauto. - + simpl in H0. - destruct (canRec fs r) eqn:HCanRec. - - apply canRecUnfold in HCanRec. - destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. - * subst. simpl in H0. destruct vs. - ++ inv H0. exists x. auto. - ++ destruct vs. - -- inv H0. destruct x. - ** rewrite maxKZeroRefl in H1. inv H1. - ** exists (S x). - simpl in H1. simpl. - destruct (params =? length (vl ++ [v]));auto. - -- inv H0. exists x. auto. - * subst. simpl in H0. inv H0. exists x. auto. - - destruct (sequentialStepFunc fs r) eqn:Hssf. - ** destruct p. - unfold sequentialStepCanRec in H0. rewrite HCanRec in H0. rewrite Hssf in H0. - fold sequentialStepCanRec in H0. - specialize (IHk _ _ _ _ _ H0 H1). - destruct IHk. exists (S x0). unfold sequentialStepMaxK. rewrite Hssf. - fold sequentialStepMaxK. auto. - ** inv H0. - destruct x. - ++ rewrite maxKZeroRefl in H1. inv H1. exists 0. - unfold sequentialStepCanRec in H3. rewrite HCanRec in H3. rewrite Hssf in H3. inv H3. - apply maxKZeroRefl. - ++ unfold sequentialStepMaxK in H1. - unfold sequentialStepCanRec in H3. - rewrite HCanRec in H3. rewrite Hssf in H3. inv H3. - rewrite Hssf in H1. inv H1. - exists 0. apply maxKZeroRefl. -Qed. - -Lemma maxKInsertCanRecGeneral: - forall (fs : FrameStack) (r r'' : Redex) (k : nat), - is_result r'' -> - (exists n, (let (fs', r') := sequentialStepCanRec fs r k in sequentialStepMaxK fs' r' n) = ([], r'')) <-> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros. split; intros. - * destruct (sequentialStepCanRec fs r k) eqn:Hsscr. - eapply maxKTransCanRec; eauto. - * destruct H0. - destruct (sequentialStepCanRec fs r k) eqn:Hsscr. - revert H0 Hsscr. revert fs r f r0 k. - induction x; intros. - + rewrite maxKZeroRefl in H0. inv H0. inv H. - all:destruct k. - all:inv Hsscr. all:exists 0; auto. - + unfold sequentialStepMaxK in H0. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold sequentialStepMaxK in H0. - destruct k. - ** simpl in Hsscr. - destruct (canRec fs r) eqn:HCanRec. - ++ apply canRecUnfold in HCanRec. - destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. - -- subst. simpl in Hsscr. destruct vs. - *** inv Hsscr. - *** destruct vs. - +++ inv Hsscr. - exists (S x). simpl. - simpl in Hssf. - destruct (params =? length (vl ++ [v])); inv Hssf; auto. - +++ inv Hsscr. - -- subst. simpl in Hsscr. inv Hsscr. - exists (S x). unfold sequentialStepMaxK. - rewrite Hssf. fold sequentialStepMaxK. auto. - ++ unfold sequentialStepCanRec in Hsscr. rewrite HCanRec in Hsscr. - rewrite Hssf in Hsscr. inv Hsscr. exists (S x). - unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. - ** simpl in Hsscr. - destruct (canRec fs r) eqn:HCanRec. - ++ apply canRecUnfold in HCanRec. - destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. - -- subst. simpl in Hsscr. destruct vs. - *** inv Hsscr. - *** destruct vs. - +++ inv Hsscr. - exists (S x). unfold sequentialStepMaxK. simpl. simpl in Hssf. - rewrite Hssf. fold sequentialStepMaxK. auto. - +++ inv Hsscr. - -- subst. simpl in Hsscr. inv Hsscr. exists (S x). - unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. - ++ unfold sequentialStepCanRec in Hsscr. rewrite HCanRec in Hsscr. - rewrite Hssf in Hsscr. - specialize (IHx _ _ _ _ _ H0 Hsscr). auto. - - inv H0. - destruct k. - ** unfold sequentialStepCanRec in Hsscr. - destruct (canRec [] r'') eqn:HCanRec. - ++ simpl in HCanRec. discriminate. - ++ rewrite Hssf in Hsscr. inv Hsscr. exists 0. apply maxKZeroRefl. - ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. - all:exists 0; auto. -Qed. - -Lemma maxKInsertCanRec: - forall (fs : FrameStack) (r r'' : Redex), - is_result r'' -> - (exists n, (let (fs', r') := sequentialStepCanRec fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros fs r r''. - exact (maxKInsertCanRecGeneral fs r r'' 1000). -Qed. - -Theorem frame_indep_core_func: - forall (fs fs' : FrameStack) (r r' : Redex), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - forall (fsapp : FrameStack), (exists n, sequentialStepMaxK (fs ++ fsapp) r n = (fs' ++ fsapp, r')). -Proof. - intros. - apply maxKEquivK. apply maxKEquivK in H. - destruct H. apply kEquiv in H. - exists x. apply kEquiv. apply frame_indep_core. auto. -Qed. - -Theorem maxKTransitive: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - (exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) -> - (exists n, sequentialStepMaxK fs r n = (fs'', r'')). -Proof. - setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. - destruct H, H0. exists (x + x0). - eapply transitive_eval; eauto. -Qed. - -Lemma maxKDone: - forall (r r' : Redex), - is_result r' -> - (exists n : nat, ([] : FrameStack, r') = ([], r)) <-> - (exists n, sequentialStepMaxK [] r' n = ([], r)). -Proof. - intros. split;intro. - * destruct H0. inv H0. setoid_rewrite <- RTCEquiv;[|auto]. - econstructor. split. auto. constructor. - * destruct H0. destruct x. - + rewrite maxKZeroRefl in H0. exists 0. auto. - + inv H; simpl in H0; exists 0; auto. -Qed. - -Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. -Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. - -Theorem maxKTransitive': - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (P : Prop), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - ((exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) /\ P) -> - ((exists n, sequentialStepMaxK fs r n = (fs'', r'')) /\ P). -Proof. - setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. - destruct H, H0, H0. - split;auto. - exists (x + x0). - eapply transitive_eval; eauto. -Qed. - -(* ----- TACTICS ----- *) Ltac contains_match := lazymatch goal with @@ -480,6 +96,7 @@ Ltac solve_final_state := Ltac solve_final_postcond := first [ nia + | auto | idtac "Could not solve postcondition" ]. @@ -719,7 +336,15 @@ Ltac take_to_rec_loop_mult h t := separate_cases_mult h t; solve_symbolically_internal_mult h t | (* If we did not hit a point of recursion, or a case separation, - the loop needs to be continued. *) + the loop needs to be continued. + + A single step is done manually, + because non-recursive functions defined in a LetRec can cause issues: + we can get to a point of potential recursion, but since the function is + not in fact recursive, that branch will fail. Without this stepOne, we + can run into an infinite loop. + *) + stepOne; solve_symbolically_internal_mult h t ] with @@ -903,7 +528,15 @@ Ltac take_to_rec_loop_0 h := separate_cases_0 h; solve_symbolically_internal_0 h | (* If we did not hit a point of recursion, or a case separation, - the loop needs to be continued. *) + the loop needs to be continued. + + A single step is done manually, + because non-recursive functions defined in a LetRec can cause issues: + we can get to a point of potential recursion, but since the function is + not in fact recursive, that branch will fail. Without this stepOne, we + can run into an infinite loop. + *) + stepOne; solve_symbolically_internal_0 h ] with @@ -930,75 +563,3 @@ Tactic Notation "solve_symbolically" ident(h) := Am I right, is it only possible to have a function application with an empty list of parameters left to evaluate on the *top* of the frame stack? *) - -(* ----- EXAMPLES ----- *) - -Definition fact_frameStack (e : Exp) : Exp := - ELetRec - [(1, °ECase (˝VVar 1) [ - ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); - ([PVar], ˝ttrue, - °ELet 1 (EApp (˝VFunId (1, 1)) - [°ECall (˝VLit "erlang"%string) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]]) - (°ECall (˝VLit "erlang"%string) (˝VLit "*"%string) [˝VVar 1; ˝VVar 0]) - ) - ])] - (EApp (˝VFunId (0, 1)) [e]) - (* Write the definition here *) -. - -Theorem fact_eval_ex: - forall (z : Z), (0 <= z)%Z -> - exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (z <= y /\ y >= 1)%Z. -Proof. - solve_symbolically z. -Qed. - -Definition tailrec_fact (e d : Exp) : Exp := - ELetRec [ - (2, °ECase (˝VVar 1) [ - ([PLit (Integer 0%Z)], ˝ttrue, ˝VVar 2); - ([PVar], ˝ttrue, - (°EApp (˝VFunId (1, 2)) - [°ECall (˝erlang) (˝VLit "-"%string) [˝VVar 0; ˝VLit 1%Z]; - °ECall (˝erlang) (˝VLit "*"%string) [˝VVar 0; ˝VVar 3] - ])) - ] - ) - ] (EApp (˝VFunId (0, 2)) [e; d]) -. - -Theorem fact_tailrec_eval_ex: - forall (z : Z) (z' : Z), (0 <= z)%Z -> - exists (y : Z), - ⟨ [], (tailrec_fact (˝VLit z) (˝VLit z')) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z)) * z')%Z. -Proof. - solve_symbolically z z'. - - -Qed. - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/Symbolic/SymbTheorems.v b/src/Symbolic/SymbTheorems.v new file mode 100644 index 00000000..f71311ee --- /dev/null +++ b/src/Symbolic/SymbTheorems.v @@ -0,0 +1,387 @@ +From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. +From CoreErlang.Interpreter Require Import StepFunctions Equivalences. + +Import ListNotations. + +Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepMaxK fs' r' n' + end + end. + +Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := + match n with + | 0 => Some (fs, r) + | S n' => + match sequentialStepFunc fs r with + | Some (fs', r') => sequentialStepK fs' r' n' + | None => None + end + end. + +Definition canRec (fs : FrameStack) (r : Redex) : bool := + match fs with + | FParams (IApp (VClos (_ :: _) _ _ _)) _ [] :: _ => + match r with + | RValSeq _ => true + | RBox => true + | _ => false + end + | _ => false + end. + +Definition lastParamRBox (fs : FrameStack) (r : Redex) : (FrameStack * Redex) := + match fs, r with + | FParams ident vl ex :: fs', RValSeq [v] => (FParams ident (vl ++ [v]) ex :: fs', RBox) + | FParams ident vl ex :: fs', RBox => (FParams ident vl ex :: fs', RBox) + | fs', r => (fs', r) + end. + +Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := + match canRec fs r with + | true => lastParamRBox fs r + | false => + match sequentialStepFunc fs r with + | None => (fs, r) + | Some (fs', r') => + match n with + | 0 => (fs, r) + | S n' => sequentialStepCanRec fs' r' n' + end + end + end. + +Arguments sequentialStepMaxK !_ !_ !_ /. +Arguments sequentialStepK !_ !_ !_ /. +Arguments sequentialStepCanRec !_ !_ !_ /. + +(* ----- LEMMAS ----- *) + +Lemma maxKZeroRefl: + forall (fs : FrameStack) (r : Redex), + sequentialStepMaxK fs r 0 = (fs, r). +Proof. + intros. unfold sequentialStepMaxK. + destruct (sequentialStepFunc fs r). + 1:destruct p. all:reflexivity. +Qed. + +Lemma maxKForwardOne: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, sequentialStepMaxK fs r (S n) = ([], r')) <-> + exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (S x). auto. + * destruct H0. destruct x. + + exists 0. + rewrite maxKZeroRefl in H0. inv H0. + inv H. all:auto. + + exists x. auto. +Qed. + +Lemma maxKOverflow: + forall (fs : FrameStack) (r r' : Redex) (n m : nat), + is_result r' -> + n <= m -> + sequentialStepMaxK fs r n = ([], r') -> + sequentialStepMaxK fs r m = ([], r'). +Proof. + intros fs r r' n. revert fs r r'. + induction n; intros. + * destruct m. + + auto. + + rewrite maxKZeroRefl in H1. inv H1. + inv H. all:auto. + * destruct m. + + inv H0. + + unfold sequentialStepMaxK in H1|-*. + destruct (sequentialStepFunc fs r). + 1:destruct p; fold sequentialStepMaxK. + all:fold sequentialStepMaxK in H1. + - apply IHn; auto. lia. + - auto. +Qed. + +Lemma maxKForwardThousand: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + (exists n, sequentialStepMaxK fs r (1000 + n) = ([], r')) <-> + exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros. split; intro. + * destruct H0. exists (1000 + x). auto. + * destruct H0. + exists x. + apply (maxKOverflow _ _ _ x); auto. lia. +Qed. + +Lemma maxKEquivK: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, sequentialStepK fs r n = Some (fs', r')) <-> + (exists n, sequentialStepMaxK fs r n = (fs', r')). +Proof. + intros. split;intro. + * destruct H. exists x. + revert H. revert fs r. + induction x; intros. + + unfold sequentialStepK in *. inv H. + rewrite maxKZeroRefl. auto. + + unfold sequentialStepMaxK. + unfold sequentialStepK in H. + destruct (sequentialStepFunc fs r). + 1:destruct p. + all:fold sequentialStepMaxK. all:fold sequentialStepK in H. + all:auto. inv H. + * destruct H. revert H. revert fs r. + induction x; intros. + + rewrite maxKZeroRefl in H. inv H. exists 0. + unfold sequentialStepK. reflexivity. + + unfold sequentialStepMaxK in H. + destruct (sequentialStepFunc fs r) eqn:Hssf; fold sequentialStepMaxK in H. + - destruct p. + apply IHx in H. destruct H. exists (S x0). + unfold sequentialStepK. rewrite Hssf. fold sequentialStepK. + auto. + - inv H. exists 0. unfold sequentialStepK. reflexivity. +Qed. + +Lemma kEquiv: + forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), + ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> sequentialStepK fs r k = Some (fs', r'). +Proof. + intros. split;revert fs fs' r r'. + * induction k; intros. + + inv H. unfold sequentialStepK. auto. + + inv H. unfold sequentialStepK. + apply sequentialStepEquiv in H1. rewrite H1. + fold sequentialStepK. auto. + * induction k; intros. + + unfold sequentialStepK in H. inv H. constructor. + + unfold sequentialStepK in H. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepK in H. + apply sequentialStepEquiv in Hssf. + econstructor; eauto. + - inv H. +Qed. + +Theorem RTCEquiv: + forall (fs : FrameStack) (r r' : Redex), + is_result r' -> + ⟨ fs, r ⟩ -->* r' <-> exists n, sequentialStepMaxK fs r n = ([], r'). +Proof. + intros fs r r' Hres. split; intros. + * inv H. destruct H0. + apply kEquiv in H0. + apply maxKEquivK. + exists x. auto. + * apply maxKEquivK in H. + destruct H. econstructor. split;[auto|]. + apply kEquiv. eauto. +Qed. + +Lemma canRecUnfold: + forall (fs : FrameStack) (r : Redex), + canRec fs r = true -> + exists ext_top ext' id params e vl fs', + (fs = FParams (IApp (VClos (ext_top :: ext') id params e)) vl [] :: fs') /\ + ((exists vseq, r = RValSeq vseq) \/ (r = RBox)). +Proof. + intros. unfold canRec in H. + destruct fs; try discriminate. destruct f; try discriminate. destruct ident; try discriminate. + destruct v; try discriminate. destruct ext; try discriminate. destruct el; try discriminate. + destruct r; try discriminate. + * do 8 eexists. 1:reflexivity. left. eexists. reflexivity. + * do 8 eexists. 1:reflexivity. right. reflexivity. +Qed. + +Lemma maxKTransCanRec: + forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), + is_result r'' -> + sequentialStepCanRec fs r k = (fs', r') -> + (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. + destruct H1. revert H0 H1. revert x fs fs' r r'. + induction k; intros. + + unfold sequentialStepCanRec in H0. + destruct (canRec fs r) eqn:HCanRec. + - apply canRecUnfold in HCanRec. + destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. + * subst. simpl in H0. destruct vs. + ++ inv H0. exists x. auto. + ++ destruct vs. + -- inv H0. destruct x. + ** rewrite maxKZeroRefl in H1. inv H1. + ** exists (S x). + simpl in H1. simpl. + destruct (params =? length (vl ++ [v]));auto. + -- inv H0. exists x. auto. + * subst. simpl in H0. inv H0. exists x. auto. + - destruct (sequentialStepFunc fs r) eqn:Hssf. 1:destruct p. all:inv H0. all:eexists;eauto. + + simpl in H0. + destruct (canRec fs r) eqn:HCanRec. + - apply canRecUnfold in HCanRec. + destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. + * subst. simpl in H0. destruct vs. + ++ inv H0. exists x. auto. + ++ destruct vs. + -- inv H0. destruct x. + ** rewrite maxKZeroRefl in H1. inv H1. + ** exists (S x). + simpl in H1. simpl. + destruct (params =? length (vl ++ [v]));auto. + -- inv H0. exists x. auto. + * subst. simpl in H0. inv H0. exists x. auto. + - destruct (sequentialStepFunc fs r) eqn:Hssf. + ** destruct p. + unfold sequentialStepCanRec in H0. rewrite HCanRec in H0. rewrite Hssf in H0. + fold sequentialStepCanRec in H0. + specialize (IHk _ _ _ _ _ H0 H1). + destruct IHk. exists (S x0). unfold sequentialStepMaxK. rewrite Hssf. + fold sequentialStepMaxK. auto. + ** inv H0. + destruct x. + ++ rewrite maxKZeroRefl in H1. inv H1. exists 0. + unfold sequentialStepCanRec in H3. rewrite HCanRec in H3. rewrite Hssf in H3. inv H3. + apply maxKZeroRefl. + ++ unfold sequentialStepMaxK in H1. + unfold sequentialStepCanRec in H3. + rewrite HCanRec in H3. rewrite Hssf in H3. inv H3. + rewrite Hssf in H1. inv H1. + exists 0. apply maxKZeroRefl. +Qed. + +Lemma maxKInsertCanRecGeneral: + forall (fs : FrameStack) (r r'' : Redex) (k : nat), + is_result r'' -> + (exists n, (let (fs', r') := sequentialStepCanRec fs r k in sequentialStepMaxK fs' r' n) = ([], r'')) <-> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros. split; intros. + * destruct (sequentialStepCanRec fs r k) eqn:Hsscr. + eapply maxKTransCanRec; eauto. + * destruct H0. + destruct (sequentialStepCanRec fs r k) eqn:Hsscr. + revert H0 Hsscr. revert fs r f r0 k. + induction x; intros. + + rewrite maxKZeroRefl in H0. inv H0. inv H. + all:destruct k. + all:inv Hsscr. all:exists 0; auto. + + unfold sequentialStepMaxK in H0. + destruct (sequentialStepFunc fs r) eqn:Hssf. + - destruct p. fold sequentialStepMaxK in H0. + destruct k. + ** simpl in Hsscr. + destruct (canRec fs r) eqn:HCanRec. + ++ apply canRecUnfold in HCanRec. + destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. + -- subst. simpl in Hsscr. destruct vs. + *** inv Hsscr. + *** destruct vs. + +++ inv Hsscr. + exists (S x). simpl. + simpl in Hssf. + destruct (params =? length (vl ++ [v])); inv Hssf; auto. + +++ inv Hsscr. + -- subst. simpl in Hsscr. inv Hsscr. + exists (S x). unfold sequentialStepMaxK. + rewrite Hssf. fold sequentialStepMaxK. auto. + ++ unfold sequentialStepCanRec in Hsscr. rewrite HCanRec in Hsscr. + rewrite Hssf in Hsscr. inv Hsscr. exists (S x). + unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. + ** simpl in Hsscr. + destruct (canRec fs r) eqn:HCanRec. + ++ apply canRecUnfold in HCanRec. + destruct HCanRec as [ext_top [ext' [id [params [e [vl [fs'' [Hcr1 [[vs Hcr2] | Hcr2]]]]]]]]]. + -- subst. simpl in Hsscr. destruct vs. + *** inv Hsscr. + *** destruct vs. + +++ inv Hsscr. + exists (S x). unfold sequentialStepMaxK. simpl. simpl in Hssf. + rewrite Hssf. fold sequentialStepMaxK. auto. + +++ inv Hsscr. + -- subst. simpl in Hsscr. inv Hsscr. exists (S x). + unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. auto. + ++ unfold sequentialStepCanRec in Hsscr. rewrite HCanRec in Hsscr. + rewrite Hssf in Hsscr. + specialize (IHx _ _ _ _ _ H0 Hsscr). auto. + - inv H0. + destruct k. + ** unfold sequentialStepCanRec in Hsscr. + destruct (canRec [] r'') eqn:HCanRec. + ++ simpl in HCanRec. discriminate. + ++ rewrite Hssf in Hsscr. inv Hsscr. exists 0. apply maxKZeroRefl. + ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. + all:exists 0; auto. +Qed. + +Lemma maxKInsertCanRec: + forall (fs : FrameStack) (r r'' : Redex), + is_result r'' -> + (exists n, (let (fs', r') := sequentialStepCanRec fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> + (exists n, sequentialStepMaxK fs r n = ([], r'')). +Proof. + intros fs r r''. + exact (maxKInsertCanRecGeneral fs r r'' 1000). +Qed. + +Theorem frame_indep_core_func: + forall (fs fs' : FrameStack) (r r' : Redex), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + forall (fsapp : FrameStack), (exists n, sequentialStepMaxK (fs ++ fsapp) r n = (fs' ++ fsapp, r')). +Proof. + intros. + apply maxKEquivK. apply maxKEquivK in H. + destruct H. apply kEquiv in H. + exists x. apply kEquiv. apply frame_indep_core. auto. +Qed. + +Theorem maxKTransitive: + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + (exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) -> + (exists n, sequentialStepMaxK fs r n = (fs'', r'')). +Proof. + setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. + destruct H, H0. exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +Theorem maxKTransitive': + forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (P : Prop), + (exists n, sequentialStepMaxK fs r n = (fs', r')) -> + ((exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) /\ P) -> + ((exists n, sequentialStepMaxK fs r n = (fs'', r'')) /\ P). +Proof. + setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. + destruct H, H0, H0. + split;auto. + exists (x + x0). + eapply transitive_eval; eauto. +Qed. + +Lemma maxKDone: + forall (r r' : Redex), + is_result r' -> + (exists n : nat, ([] : FrameStack, r') = ([], r)) <-> + (exists n, sequentialStepMaxK [] r' n = ([], r)). +Proof. + intros. split;intro. + * destruct H0. inv H0. setoid_rewrite <- RTCEquiv;[|auto]. + econstructor. split. auto. constructor. + * destruct H0. destruct x. + + rewrite maxKZeroRefl in H0. exists 0. auto. + + inv H; simpl in H0; exists 0; auto. +Qed. + +Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. +Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. + diff --git a/src/Symbolic/Symbolic.v b/src/Symbolic/Symbolic.v deleted file mode 100644 index b2e11789..00000000 --- a/src/Symbolic/Symbolic.v +++ /dev/null @@ -1,1353 +0,0 @@ -From CoreErlang.FrameStack Require Import SubstSemantics SubstSemanticsLemmas. -From CoreErlang.Interpreter Require Import StepFunctions Equivalences. - -Open Scope string_scope. -Import ListNotations. - -Print positive. - -Definition fact_frameStack (e : Exp) : Exp := - ELetRec - [(1, °ECase (˝VVar 1) [ - ([PLit 0%Z], ˝ttrue, (˝VLit 1%Z)); - ([PVar], ˝ttrue, - °ELet 1 (EApp (˝VFunId (1, 1)) - [°ECall (˝VLit "erlang") (˝VLit "-") [˝VVar 0; ˝VLit 1%Z]]) - (°ECall (˝VLit "erlang") (˝VLit "*") [˝VVar 1; ˝VVar 0]) - ) - ])] - (EApp (˝VFunId (0, 1)) [e]) - (* Write the definition here *) -. - -Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. -Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. - -Ltac case_innermost_term t := - lazymatch t with - | context[match ?x with _ => _ end] => - first [ case_innermost_term x - | let H := fresh "Heq" in - destruct x eqn:H; - first [apply Z_eqb_eq_corr in H - |apply Z_eqb_neq_corr in H - | idtac]] - | _ => fail "No match subterm found" - end. - -Ltac case_innermost := - match goal with - | |- ?g => case_innermost_term g - end. - -Ltac case_innermost_in H := - let T := type of H in - case_innermost_term T. - -Tactic Notation "case_innermost" := - case_innermost. - -Tactic Notation "case_innermost" ident(H) := - case_innermost_in H. - -Fixpoint ssmkInner (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => ssmkInner fs' r' n' - end - end. - -Definition isEnd (fs : FrameStack) (r : Redex) : bool := - match fs, r with - | [], RValSeq _ => true - | _, _ => false - end. - -Fixpoint ssmk (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := -match isEnd fs r with -| true => (fs, r) -| false => - match n with - | 0 => (fs, r) - | S n' => - let (fs', r') := ssmkInner fs r 1000 in - ssmk fs' r' n' - end -end. - -Arguments ssmkInner !_ !_ !_ /. -Arguments ssmk !_ !_ !_ /. - -Ltac simpl_and_try_solve := - simpl; (* simplify the goal *) - lazymatch goal with - | [ |- context[ssmk] ] => try lia (* eval not done: is the case impossible? *) - | _ => try (eexists; split;[reflexivity|nia]) (* eval done: the result exists & postcond holds *) - end. - - -Ltac solve_forward := - repeat (simpl_and_try_solve; case_innermost). - - -Theorem fact_eval_example: - forall (z : Z), (0 <= z < 10)%Z -> exists (y : Z), ssmk [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros. unfold fact_frameStack. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. - case_innermost. - all:simpl_and_try_solve. -Qed. - -Theorem fact_eval_example': - forall (z : Z), (0 <= z < 30)%Z -> exists (y : Z), ssmk [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. - intros; unfold fact_frameStack. - solve_forward. -Qed. - -Theorem fact_eval_example_rec0: - forall (z : Z), (0 <= z)%Z -> - exists (y : Z), ssmk [] (fact_frameStack (˝VLit z)) 1000 = ([], RValSeq [VLit y]) /\ (z <= y)%Z. -Proof. -Abort. - -Lemma ssmkInnerTrans: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n n' : nat), - ssmkInner fs r n = (fs', r') -> ssmkInner fs' r' n' = (fs'', r'') -> ssmkInner fs r (n + n') = (fs'', r''). -Proof. - intros fs fs' fs'' r r' r'' n. revert fs fs' fs'' r r' r''. - induction n; intros. - * simpl. unfold ssmkInner in H. destruct (sequentialStepFunc fs r); try destruct p; inv H; auto. - * simpl. unfold ssmkInner. unfold ssmkInner in H. - destruct (sequentialStepFunc fs r) eqn:Hssf. - + destruct p. fold ssmkInner in *. eapply IHn; eauto. - + inv H. - destruct n'. - - unfold ssmkInner in H0. rewrite Hssf in H0. auto. - - unfold ssmkInner in H0. rewrite Hssf in H0. auto. -Qed. - -Lemma ssmkInnerLet: - forall (fs: FrameStack) (r: Redex) (n n' : nat), - ssmkInner fs r (n + n') = let (fs', r') := ssmkInner fs r n in ssmkInner fs' r' n'. -Proof. - intros. revert fs r n'. induction n; intros. - * simpl. destruct (ssmkInner fs r 0) eqn:HssmkInner. - unfold ssmkInner in HssmkInner. - destruct (sequentialStepFunc fs r) eqn:Hssf. - 1:destruct p. all:inv HssmkInner. all:auto. - * simpl. - unfold ssmkInner. destruct (sequentialStepFunc fs r) eqn:Hssf. - 1:destruct p. all:fold ssmkInner. - + auto. - + destruct n'. - all:unfold ssmkInner. - all:rewrite Hssf. - all:auto. -Qed. - -Theorem ssmkEquiv: - forall (fs : FrameStack) (r : Redex) (n : nat), - ssmk fs r n = ssmkInner fs r (n * 1000). -Proof. - intros fs r n. revert fs r. - induction n; intros. - + simpl. unfold ssmk, ssmkInner. - destruct (isEnd fs r). - all:destruct (sequentialStepFunc fs r). - 1,3:destruct p. all:reflexivity. - + rewrite Nat.mul_succ_l. - unfold ssmk. destruct (isEnd fs r) eqn:HisEnd. - - unfold isEnd in *. destruct fs; try discriminate. destruct r; try discriminate. - rewrite Nat.add_comm. simpl. reflexivity. - - fold ssmk. - destruct (ssmkInner fs r 1000) eqn:Hssmk. - rewrite Nat.add_comm. - rewrite ssmkInnerLet. rewrite Hssmk. auto. -Qed. - -Lemma ssmkTrans: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n n' : nat), - ssmk fs r n = (fs', r') -> ssmk fs' r' n' = (fs'', r'') -> ssmk fs r (n + n') = (fs'', r''). -Proof. - setoid_rewrite ssmkEquiv. - intros. - assert ((n + n') * 1000 = (n * 1000 + n' * 1000)) by lia. - rewrite H1. clear H1. - eapply ssmkInnerTrans; eauto. -Qed. - -Lemma backOneInner: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n n' : nat), - ssmkInner fs r 1 = (fs', r') -> - (let (fs0, r0) := ssmkInner fs' r' n in ssmk fs0 r0 n' = (fs'', r'')) -> - let (fs0, r0) := ssmkInner fs r (S n) in ssmk fs0 r0 n' = (fs'', r''). -Proof. - intros. - destruct (ssmkInner fs' r' n) eqn:HssmkInner. - rewrite ssmkEquiv in H0. - destruct (ssmkInner fs r (S n)) eqn:HssmkInner0. - rewrite ssmkEquiv. - assert (S n = 1 + n) by lia. - rewrite H1 in HssmkInner0. clear H1. - rewrite ssmkInnerLet in HssmkInner0. - rewrite H in HssmkInner0. - rewrite HssmkInner0 in HssmkInner. inv HssmkInner. auto. -Qed. - -Lemma advanceOneInner: - forall (fs fs'' : FrameStack) (r r'' : Redex) (n n' : nat), - (let (fs0, r0) := ssmkInner fs r (S n) in ssmk fs0 r0 n' = (fs'', r'')) -> - exists (fs' : FrameStack) (r' : Redex), - ssmkInner fs r 1 = (fs', r') /\ - (let (fs0, r0) := ssmkInner fs' r' n in ssmk fs0 r0 n' = (fs'', r'')). -Proof. - intros. - destruct (ssmkInner fs r (S n)) eqn:HssmkInner. - rewrite ssmkEquiv in H. - assert (S n = 1 + n) by lia. - rewrite H0 in HssmkInner. clear H0. - rewrite ssmkInnerLet in HssmkInner. - destruct (ssmkInner fs r 1) eqn:HssmkInner0. - do 2 eexists. split. eauto. - rewrite HssmkInner. - rewrite ssmkEquiv. auto. -Qed. - -Lemma backOnePivot: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n : nat), - ssmkInner fs r 1 = (fs', r') -> - ssmk fs' r' n = (fs'', r'') -> - let (fs0, r0) := ssmkInner fs r 1 in ssmk fs0 r0 n = (fs'', r''). -Proof. - intros. rewrite H. auto. -Qed. - -Lemma advanceOnePivot: - forall (fs fs'' : FrameStack) (r r'' : Redex) (n : nat), - (let (fs0, r0) := ssmkInner fs r 1 in ssmk fs0 r0 n = (fs'', r'')) -> - exists (fs' : FrameStack) (r' : Redex), - ssmkInner fs r 1 = (fs', r') /\ - ssmk fs' r' n = (fs'', r''). -Proof. - intros. setoid_rewrite ssmkEquiv. - destruct (ssmkInner fs r 1) eqn:HssmkInner. - rewrite ssmkEquiv in H. - do 2 eexists. split. eauto. auto. -Qed. - -Lemma backOneChange: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (n : nat), - ssmkInner fs r 1 = (fs', r') -> - (let (fs0, r0) := ssmkInner fs' r' 999 in ssmk fs0 r0 n = (fs'', r'')) -> - ssmk fs r (S n) = (fs'', r''). -Proof. - intros. - rewrite ssmkEquiv. - destruct (ssmkInner fs' r' 999) eqn:HssmkInner. - rewrite ssmkEquiv in H0. - assert (S n * 1000 = 1 + (999 + n * 1000)) by lia. - rewrite H1. clear H1. - rewrite ssmkInnerLet. rewrite H. - rewrite ssmkInnerLet. rewrite HssmkInner. auto. -Qed. - -Lemma advanceOneChange: - forall (fs fs'' : FrameStack) (r r'' : Redex) (n : nat), - ssmk fs r (S n) = (fs'', r'') -> - exists (fs' : FrameStack) (r' : Redex), - ssmkInner fs r 1 = (fs', r') /\ - (let (fs0, r0) := ssmkInner fs' r' 999 in ssmk fs0 r0 n = (fs'', r'')). -Proof. - intros. rewrite ssmkEquiv in H. - assert (S n * 1000 = 1 + (999 + n * 1000)) by lia. - rewrite H0 in H. clear H0. - rewrite ssmkInnerLet in H. - destruct (ssmkInner fs r 1) eqn:HssmkInner. - rewrite ssmkInnerLet in H. - destruct (ssmkInner f r0 999) eqn:HssmkInner0. - do 2 eexists. split. eauto. - rewrite HssmkInner0. rewrite ssmkEquiv. auto. -Qed. - -Lemma ssmkInnerOneMore: - forall (fs : FrameStack) (r : Redex) (v : list Val) (n : nat), - ssmkInner fs r n = ([], RValSeq v) -> ssmkInner fs r (S n) = ([], RValSeq v). -Proof. - intros fs r v n. revert fs r v. - induction n; intros. - * unfold ssmkInner in *. - destruct (sequentialStepFunc fs r) eqn:Hssf. - 1:destruct p. all:inv H. reflexivity. - * unfold ssmkInner. unfold ssmkInner in H. - destruct (sequentialStepFunc fs r) eqn:Hssf. all:auto. - destruct p. fold ssmkInner in *. - apply IHn in H. - unfold ssmkInner in H. destruct (sequentialStepFunc f r0) eqn:Hssf0. - 1:destruct p. 1:fold ssmkInner in H. all:auto. -Qed. - -Theorem ssmkInnerMore: - forall (fs : FrameStack) (r : Redex) (v : list Val) (n n' : nat), - n <= n' -> - ssmkInner fs r n = ([], RValSeq v) -> ssmkInner fs r n' = ([], RValSeq v). -Proof. - intros fs r v n. revert fs r v. - induction n; intros. - * destruct n'. - all:unfold ssmkInner in *. - all:destruct (sequentialStepFunc fs r) eqn:Hssf. - 1,3:destruct p. - all:auto. inv H0. - * destruct n'. - + inv H. - + assert (n <= n') by lia. - unfold ssmkInner. unfold ssmkInner in H0. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold ssmkInner in *. - apply IHn. lia. auto. - - auto. -Qed. - -Ltac advanceOne H := - first [ apply advanceOneChange in H;destruct H as [fs' [r' [Hfirst H]]];inv Hfirst - | apply advanceOneInner in H;destruct H as [fs' [r' [Hfirst H]]];inv Hfirst - | apply advanceOnePivot in H;destruct H as [fs' [r' [Hfirst H]]];inv Hfirst - | idtac "Nothing to advance"]. - -Theorem fact_eval_rec: - forall (z : nat), (* (0 <= z) -> *) - forall (y : nat), ssmk [] (fact_frameStack (˝VLit (Z.of_nat z))) 1000 = ([], RValSeq [VLit (Z.of_nat y)]) -> - (z <= y). -Proof. - intros. unfold fact_frameStack in H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - - - induction z. - * simpl in H. inv H. nia. - * (*simpl in H0. simpl in IHz.*) - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - advanceOne H. - - - assert ((Z.of_nat (S z) - 1)%Z = Z.of_nat z) by lia. - rewrite H0 in H. clear H0. - - - - - - -Abort. - -Lemma help: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - (exists n, ssmk fs r (S n) = ([], r')) <-> - exists n, ssmk fs r n = ([], r'). -Proof. - intros. split; intro. - * destruct H0. exists (S x). auto. - * destruct H0. destruct x. - + unfold ssmk in *. - destruct (isEnd fs r) eqn:HisEnd. - - inv H0. exists 0. reflexivity. - - fold ssmk. inv H0. - inv H. simpl. exists 0. simpl. reflexivity. - + exists x. auto. -Qed. - -Definition mayRec (fs : FrameStack) (r : Redex) : bool := - match fs with - | FParams (IApp (VClos (_ :: _) _ _ _)) _ _ :: _ => - match r with - | RValSeq _ => true - | _ => false - end - | _ => false - end. - -Compute mayRec [FParams - (IApp - (VClos - [(0, 1, - ° ECase (˝ VVar 1) - [([PLit 0%Z], ˝ VLit "true", ˝ VLit 1%Z); - ([PVar], ˝ VLit "true", - ° ELet 1 - (° EApp (˝ VFunId (1, 1)) - [° ECall (˝ VLit "erlang") (˝ VLit "-") - [˝ VVar 0; ˝ VLit 1%Z]]) - (° ECall (˝ VLit "erlang") (˝ VLit "*") [˝ VVar 1; ˝ VVar 0]))])] - 0 1 - (° ECase (˝ VVar 1) - [([PLit 0%Z], ˝ VLit "true", ˝ VLit 1%Z); - ([PVar], ˝ VLit "true", - ° ELet 1 - (° EApp (˝ VFunId (1, 1)) - [° ECall (˝ VLit "erlang") (˝ VLit "-") [˝ VVar 0; ˝ VLit 1%Z]]) - (° ECall (˝ VLit "erlang") (˝ VLit "*") [˝ VVar 1; ˝ VVar 0]))]))) - [] []] (RValSeq [VLit (Z.of_nat 1)]). - -Fixpoint ssmkMayRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex * nat := -match mayRec fs r with -| true => (fs, r, n) -| false => - match sequentialStepFunc fs r with - | None => (fs, r, n) - | Some (fs', r') => - match n with - | 0 => (fs, r, n) - | S n' => ssmkMayRec fs' r' n' - end - end -end. - -Compute ssmkMayRec [] (fact_frameStack (˝VLit 4%Z)) 100. - -Theorem ssmkRec: - forall (fs : FrameStack) (r : Redex) (n : nat), - ssmkInner fs r n = - let '(fs', r', n') := ssmkMayRec fs r n in ssmkInner fs' r' n'. -Proof. - intros. revert fs r. induction n; intros. - * simpl. unfold ssmkInner. - destruct (mayRec fs r). - + reflexivity. - + destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. rewrite Hssf. reflexivity. - - rewrite Hssf. reflexivity. - * simpl. unfold ssmkInner. - destruct (mayRec fs r). - + reflexivity. - + destruct (sequentialStepFunc fs r) eqn:Hssf. - - fold ssmkInner. destruct p. auto. - - rewrite Hssf. reflexivity. -Qed. - -Theorem fact_eval_example_rec0: - forall (z : nat), (*(0 <= z) -> *) - exists (y : nat), - (exists (n : nat), ssmk [] (fact_frameStack (˝VLit (Z.of_nat z))) n = ([], RValSeq [VLit (Z.of_nat y)])) - /\ (z <= y). -Proof. - intros. setoid_rewrite <- help;[|constructor]. - - Opaque ssmkInner. simpl. - setoid_rewrite ssmkRec. simpl. - Transparent ssmkInner. - -Abort. - -(* Ltac toPotentialRec := - Opaque ssmkInner; simpl; try (setoid_rewrite ssmkRec); simpl; Transparent ssmkInner. - *) - -Fixpoint ssmkInnerNoSimpl (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => ssmkInnerNoSimpl fs' r' n' - end - end. - -Arguments ssmkInnerNoSimpl : simpl never. - -Lemma ssmkInnerSimplEquiv : - forall (fs : FrameStack) (r : Redex) (n : nat), - ssmkInner fs r n = ssmkInnerNoSimpl fs r n. -Proof. reflexivity. Qed. - -Theorem ssmkSimpl : - forall (fs : FrameStack) (r : Redex) (n : nat), - match isEnd fs r with - | true => (fs, r) - | false => let (fs', r') := ssmkInnerNoSimpl fs r 1000 in ssmk fs' r' n - end = ssmk fs r (S n). -Proof. reflexivity. Qed. - -Theorem ssmkRecNoSimpl : - forall (fs : FrameStack) (r : Redex) (n : nat), - ssmkInner fs r n = - let '(fs', r', n') := ssmkMayRec fs r n in ssmkInnerNoSimpl fs' r' n'. -Proof. - intros. rewrite ssmkRec. destruct (ssmkMayRec fs r n). destruct p. rewrite ssmkInnerSimplEquiv. reflexivity. -Qed. - -Ltac toPotentialRec := -match goal with -| |- context[ssmkInner] => idtac -| _ => try (setoid_rewrite <- ssmkSimpl); simpl -end; - try (setoid_rewrite ssmkRecNoSimpl); simpl; - try (setoid_rewrite <- ssmkInnerSimplEquiv). - -Lemma asd: - forall (fs : FrameStack) (r : Redex) (n : nat), - ssmkInner fs r (S n) = let (fs', r') := ssmkInner fs r 1 in ssmkInnerNoSimpl fs' r' n. -Proof. Admitted. - -Theorem fact_eval_example_rec0: - forall (z : nat), (*(0 <= z) -> *) - exists (y : Z), - (exists (n : nat), ssmk [] (fact_frameStack (˝VLit (Z.of_nat z))) n = ([], RValSeq [VLit y])) - /\ ((Z.of_nat z) <= y)%Z. -Proof. - intros. setoid_rewrite <- help;[|constructor]. - toPotentialRec. - induction z. - * simpl. eexists. split;[exists 0;reflexivity|nia]. - * setoid_rewrite asd. simpl. setoid_rewrite <- ssmkInnerSimplEquiv. - toPotentialRec. setoid_rewrite ssmkInnerSimplEquiv. cbn. - remember (IApp _). clear Heqf. - -Abort. - -Theorem ssmkInnerOuter: - forall (fs : FrameStack) (r r': Redex) (k : nat), - is_result r' -> - (exists n, (let (fs0, r0) := ssmkInner fs r k in ssmk fs0 r0 n) = ([], r')) <-> - (exists n, ssmk fs r n = ([], r')). -Proof. - intros. split. - * intros. - destruct H0. destruct (ssmkInner fs r k) eqn:HssmkInner. - setoid_rewrite ssmkEquiv. - rewrite ssmkEquiv in H0. - exists (x + k). - assert ((x + k) * 1000 = k + ((x * 1000) + (k * 999))) by lia. - rewrite H1. clear H1. - rewrite ssmkInnerLet. rewrite HssmkInner. - rewrite ssmkInnerLet. rewrite H0. - inv H. - + destruct k; simpl; reflexivity. - + destruct k; simpl; reflexivity. - * intros. - destruct H0. - (* setoid_rewrite not working backwards?? *) - assert - ( (exists n : nat, (let (fs0, r0) := ssmkInner fs r k in ssmkInner fs0 r0 (n * 1000)) = ([], r')) -> - (exists n : nat, (let (fs0, r0) := ssmkInner fs r k in ssmk fs0 r0 n) = ([], r'))). - { intros. destruct (ssmkInner fs r k). setoid_rewrite ssmkEquiv. auto. } - apply H1. clear H1. - (* setoid_rewrite not working backwards again??? *) - assert - ( (∃ n : nat, ssmkInner fs r (k + n * 1000) = ([], r')) -> - (∃ n : nat, (let (fs0, r0) := ssmkInner fs r k in ssmkInner fs0 r0 (n * 1000)) = ([], r'))). - { intros. setoid_rewrite ssmkInnerLet in H1. destruct (ssmkInner fs r k). auto. } - apply H1. clear H1. - rewrite ssmkEquiv in H0. - exists x. - assert (k + x * 1000 = x * 1000 + k) by lia. - rewrite H1. clear H1. - rewrite ssmkInnerLet. rewrite H0. - inv H. - + destruct k; simpl; reflexivity. - + destruct k; simpl; reflexivity. -Qed. - -Theorem ssmkOuterIsInner: - forall (fs : FrameStack) (r r': Redex), - is_result r' -> - (exists n, ssmk fs r n = ([], r')) <-> - (exists n, ssmkInner fs r n = ([], r')). -Proof. - intros. split; intro. - * destruct H0. exists (x * 1000). rewrite <- ssmkEquiv. auto. - * destruct H0. - exists x. rewrite ssmkEquiv. - assert (x * 1000 = x + x * 999) by lia. - rewrite H1. clear H1. - rewrite ssmkInnerLet. rewrite H0. - inv H. - + destruct x; simpl; reflexivity. - + destruct x; simpl; reflexivity. -Qed. - -Print frame_indep_core. -Close Scope string_scope. - -Fixpoint ssExactlyk (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := -match n with -| 0 => Some (fs, r) -| S n' => - match sequentialStepFunc fs r with - | Some (fs', r') => ssExactlyk fs' r' n' - | _ => None - end -end. - -Theorem kStepEquiv: - forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), - ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> ssExactlyk fs r k = Some (fs', r'). -Proof. - intros. split. - * revert fs fs' r r'. - induction k; intros. - + simpl. inv H. reflexivity. - + simpl. destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. apply IHk. - inv H. apply sequentialStepEquiv in H1. rewrite Hssf in H1. inv H1. auto. - - inv H. apply sequentialStepEquiv in H1. rewrite H1 in Hssf. discriminate. - * revert fs fs' r r'. - induction k; intros. - + simpl in H. inv H. constructor. - + simpl in H. destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. apply sequentialStepEquiv in Hssf. - econstructor. eauto. apply IHk. auto. - - discriminate. -Qed. - -Theorem kStepMaxkStep: - forall (fs fs' : FrameStack) (r r' : Redex), - (exists n, ssmkInner fs r n = (fs', r')) <-> - (exists n, ssExactlyk fs r n = Some (fs', r')). -Proof. - intros. split. - * intro. destruct H. revert H. revert fs fs' r r'. - induction x; intros. - + unfold ssmkInner in H. destruct (sequentialStepFunc fs r). - - destruct p. inv H. exists 0. reflexivity. - - inv H. exists 0. reflexivity. - + unfold ssmkInner in H. - destruct (sequentialStepFunc fs r) eqn:Hssf; fold ssmkInner in H. - - destruct p. apply IHx in H. destruct H. exists (S x0). simpl. rewrite Hssf. auto. - - inv H. exists 0. reflexivity. - * intro. destruct H. exists x. - revert H. revert fs fs' r r'. - induction x; intros. - + simpl in H. inv H. unfold ssmkInner. - destruct (sequentialStepFunc _ _). 1:destruct p. all:reflexivity. - + simpl in H. unfold ssmkInner. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold ssmkInner. apply IHx. auto. - - inv H. -Qed. - -Theorem frame_indep_core_functional: - forall (fs fs' : FrameStack) (r r' : Redex), - (exists n, ssmkInner fs r n = (fs', r')) -> - forall (fsapp : FrameStack), (exists n, ssmkInner (fs ++ fsapp) r n = (fs' ++ fsapp, r')). -Proof. - intros. - apply kStepMaxkStep. apply kStepMaxkStep in H. - destruct H. apply kStepEquiv in H. - exists x. apply kStepEquiv. apply frame_indep_core. auto. -Qed. - -Theorem ssmkTransitive: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), - (exists n, ssmkInner fs r n = (fs', r')) -> - (exists n, ssmkInner fs' r' n = (fs'', r'')) -> - (exists n, ssmkInner fs r n = (fs'', r'')). -Proof. - setoid_rewrite kStepMaxkStep. setoid_rewrite <- kStepEquiv. intros. - destruct H. destruct H0. exists (x + x0). - eapply transitive_eval; eauto. -Qed. - -Theorem fact_eval_example_rec0': - forall (z : nat), (*(0 <= z) -> *) - exists (y : Z), - (exists (n : nat), ssmk [] (fact_frameStack (˝VLit (Z.of_nat z))) n = ([], RValSeq [VLit y])) - /\ ((Z.of_nat z) <= y)%Z. -Proof. - intros. - setoid_rewrite <- help;[|constructor]. - toPotentialRec. - induction z. - * simpl. eexists. split;[exists 0;reflexivity|nia]. - * setoid_rewrite asd. simpl. setoid_rewrite <- ssmkInnerSimplEquiv. - toPotentialRec. setoid_rewrite ssmkInnerSimplEquiv. cbn. - remember (IApp _). - setoid_rewrite <- ssmkInnerSimplEquiv. - setoid_rewrite ssmkInnerOuter;[|constructor]. - setoid_rewrite ssmkOuterIsInner;[|constructor]. - setoid_rewrite ssmkInnerOuter in IHz;[|constructor]. - setoid_rewrite ssmkOuterIsInner in IHz;[|constructor]. - - destruct IHz. destruct H. - remember (FLet _ _) as l. - pose proof frame_indep_core_functional. - specialize (H1 _ _ _ _ H [l]). simpl in H1. - - assert ((Z.of_nat (S z) - 1)%Z = Z.of_nat z) by lia. rewrite H2. clear H2. - - eexists. split. - eapply ssmkTransitive. eauto. - subst l. - setoid_rewrite <- ssmkOuterIsInner;[|constructor]. - setoid_rewrite <- help;[|constructor]. simpl. - exists 0. simpl. reflexivity. - - (* we actually also need the info, that 0! > 0, which is surprising... *) - setoid_rewrite <- ssmkOuterIsInner in H;[|constructor]. - setoid_rewrite <- help in H;[|constructor]. - destruct z. - + subst f. simpl in H. destruct H. destruct x0. - - simpl in H. inv H. lia. - - simpl in H. inv H. lia. - + nia. -Qed. - -(* --------------------------------------------------------------- *) - -Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepMaxK fs' r' n' - end - end. - -Fixpoint sequentialStepMaxKNoSimpl (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepMaxKNoSimpl fs' r' n' - end - end. - -Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := - match n with - | 0 => Some (fs, r) - | S n' => - match sequentialStepFunc fs r with - | Some (fs', r') => sequentialStepK fs' r' n' - | None => None - end - end. - -Arguments sequentialStepMaxK !_ !_ !_ /. -Arguments sequentialStepMaxKNoSimpl : simpl never. -Arguments sequentialStepK !_ !_ !_ /. - -Definition canRec (fs : FrameStack) (r : Redex) : bool := - match fs with - | FParams (IApp (VClos (_ :: _) _ _ _)) _ _ :: _ => - match r with - | RValSeq _ => true - | _ => false - end - | _ => false - end. - -Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := - match canRec fs r with - | true => (fs, r) - | false => - match sequentialStepFunc fs r with - | None => (fs, r) - | Some (fs', r') => - match n with - | 0 => (fs, r) - | S n' => sequentialStepCanRec fs' r' n' - end - end - end. - -Lemma maxKZeroRefl: - forall (fs : FrameStack) (r : Redex), - sequentialStepMaxK fs r 0 = (fs, r). -Proof. - intros. unfold sequentialStepMaxK. - destruct (sequentialStepFunc fs r). - 1:destruct p. all:reflexivity. -Qed. - -Lemma canRecRefl: - forall (fs : FrameStack) (r : Redex), - sequentialStepCanRec fs r 0 = (fs, r). -Proof. - intros. unfold sequentialStepCanRec. - destruct (canRec fs r). 2:destruct (sequentialStepFunc fs r). - 2:destruct p. all:reflexivity. -Qed. - -Lemma maxKForwardOne: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - (exists n, sequentialStepMaxK fs r (S n) = ([], r')) <-> - exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros. split; intro. - * destruct H0. exists (S x). auto. - * destruct H0. destruct x. - + exists 0. - rewrite maxKZeroRefl in H0. inv H0. - inv H. all:auto. - + exists x. auto. -Qed. - -Lemma maxKOverflow: - forall (fs : FrameStack) (r r' : Redex) (n m : nat), - is_result r' -> - n <= m -> - sequentialStepMaxK fs r n = ([], r') -> - sequentialStepMaxK fs r m = ([], r'). -Proof. - intros fs r r' n. revert fs r r'. - induction n; intros. - * destruct m. - + auto. - + rewrite maxKZeroRefl in H1. inv H1. - inv H. all:auto. - * destruct m. - + inv H0. - + unfold sequentialStepMaxK in H1|-*. - destruct (sequentialStepFunc fs r). - 1:destruct p; fold sequentialStepMaxK. - all:fold sequentialStepMaxK in H1. - - apply IHn; auto. lia. - - auto. -Qed. - -Lemma maxKForwardThousand: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - (exists n, sequentialStepMaxK fs r (1000 + n) = ([], r')) <-> - exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros. split; intro. - * destruct H0. exists (1000 + x). auto. - * destruct H0. - exists x. - apply (maxKOverflow _ _ _ x); auto. lia. -Qed. - -Lemma maxKEquivK: - forall (fs fs' : FrameStack) (r r' : Redex), - (exists n, sequentialStepK fs r n = Some (fs', r')) <-> - (exists n, sequentialStepMaxK fs r n = (fs', r')). -Proof. - intros. split;intro. - * destruct H. exists x. - revert H. revert fs r. - induction x; intros. - + unfold sequentialStepK in *. inv H. - rewrite maxKZeroRefl. auto. - + unfold sequentialStepMaxK. - unfold sequentialStepK in H. - destruct (sequentialStepFunc fs r). - 1:destruct p. - all:fold sequentialStepMaxK. all:fold sequentialStepK in H. - all:auto. inv H. - * destruct H. revert H. revert fs r. - induction x; intros. - + rewrite maxKZeroRefl in H. inv H. exists 0. - unfold sequentialStepK. reflexivity. - + unfold sequentialStepMaxK in H. - destruct (sequentialStepFunc fs r) eqn:Hssf; fold sequentialStepMaxK in H. - - destruct p. - apply IHx in H. destruct H. exists (S x0). - unfold sequentialStepK. rewrite Hssf. fold sequentialStepK. - auto. - - inv H. exists 0. unfold sequentialStepK. reflexivity. -Qed. - -Lemma kEquiv: - forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), - ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> sequentialStepK fs r k = Some (fs', r'). -Proof. - intros. split;revert fs fs' r r'. - * induction k; intros. - + inv H. unfold sequentialStepK. auto. - + inv H. unfold sequentialStepK. - apply sequentialStepEquiv in H1. rewrite H1. - fold sequentialStepK. auto. - * induction k; intros. - + unfold sequentialStepK in H. inv H. constructor. - + unfold sequentialStepK in H. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold sequentialStepK in H. - apply sequentialStepEquiv in Hssf. - econstructor; eauto. - - inv H. -Qed. - -Theorem RTCEquiv: - forall (fs : FrameStack) (r r' : Redex), - is_result r' -> - ⟨ fs, r ⟩ -->* r' <-> exists n, sequentialStepMaxK fs r n = ([], r'). -Proof. - intros fs r r' Hres. split; intros. - * inv H. destruct H0. - apply kEquiv in H0. - apply maxKEquivK. - exists x. auto. - * apply maxKEquivK in H. - destruct H. econstructor. split;[auto|]. - apply kEquiv. eauto. -Qed. - -Lemma maxKNoSimplEquiv: - forall (fs : FrameStack) (r : Redex) (n : nat), - sequentialStepMaxK fs r n = sequentialStepMaxKNoSimpl fs r n. -Proof. reflexivity. Qed. - -Lemma maxKTransCanRec: - forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), - is_result r'' -> - sequentialStepCanRec fs r k = (fs', r') -> - (exists n, sequentialStepMaxK fs' r' n = ([], r'')) -> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros. - destruct H1. revert H0 H1. revert x fs fs' r r'. - induction k; intros. - + rewrite canRecRefl in H0. inv H0. exists x. auto. - + unfold sequentialStepCanRec in H0. - destruct (canRec fs r) eqn:HCanRec. - - inv H0. eapply IHk; eauto. - destruct k; unfold sequentialStepCanRec; rewrite HCanRec; auto. - - destruct (sequentialStepFunc fs r) eqn:Hssf. - fold sequentialStepCanRec in H0. - ** destruct p. - setoid_rewrite <- maxKForwardOne;[|auto]. - unfold sequentialStepMaxK. rewrite Hssf. fold sequentialStepMaxK. - eapply IHk; eauto. - ** inv H0. exists x. auto. -Qed. - -Lemma maxKInsertCanRec: - forall (fs : FrameStack) (r r'' : Redex), - is_result r'' -> - (exists n, (let (fs', r') := sequentialStepCanRec fs r 1000 in sequentialStepMaxK fs' r' n) = ([], r'')) <-> - (exists n, sequentialStepMaxK fs r n = ([], r'')). -Proof. - intros. split; intros. - * destruct (sequentialStepCanRec fs r 1000) eqn:Hsscr. - eapply maxKTransCanRec; eauto. - * destruct H0. - destruct (sequentialStepCanRec fs r 1000) eqn:Hsscr. - remember 1000 as k. clear Heqk. - revert H0 Hsscr. revert fs r f r0 k. - induction x; intros. - + rewrite maxKZeroRefl in H0. inv H0. inv H. - all:simpl in Hsscr. all:destruct k. - all:inv Hsscr. all:exists 0; auto. - + unfold sequentialStepMaxK in H0. - destruct (sequentialStepFunc fs r) eqn:Hssf. - - destruct p. fold sequentialStepMaxK in H0. - destruct k. - ** rewrite canRecRefl in Hsscr. inv Hsscr. - exists (S x). unfold sequentialStepMaxK. rewrite Hssf. - fold sequentialStepMaxK. auto. - ** unfold sequentialStepCanRec in Hsscr. - destruct (canRec fs r) eqn:HCanRec. - ++ inv Hsscr. exists (S x). - unfold sequentialStepMaxK. rewrite Hssf. - fold sequentialStepMaxK. auto. - ++ rewrite Hssf in Hsscr. fold sequentialStepCanRec in Hsscr. - eapply IHx; eauto. - - inv H0. - destruct k. - ** rewrite canRecRefl in Hsscr. inv Hsscr. exists 0. inv H; auto. - ** unfold sequentialStepCanRec in Hsscr. inv H; simpl in Hsscr; inv Hsscr. - all:exists 0; auto. -Qed. - -Theorem frame_indep_core_func: - forall (fs fs' : FrameStack) (r r' : Redex), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - forall (fsapp : FrameStack), (exists n, sequentialStepMaxK (fs ++ fsapp) r n = (fs' ++ fsapp, r')). -Proof. - intros. - apply maxKEquivK. apply maxKEquivK in H. - destruct H. apply kEquiv in H. - exists x. apply kEquiv. apply frame_indep_core. auto. -Qed. - -Theorem maxKTransitive: - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - (exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) -> - (exists n, sequentialStepMaxK fs r n = (fs'', r'')). -Proof. - setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. - destruct H, H0. exists (x + x0). - eapply transitive_eval; eauto. -Qed. - -Lemma maxKDone: - forall (r r' : Redex), - is_result r' -> - (exists n : nat, ([] : FrameStack, r') = ([], r)) <-> - (exists n, sequentialStepMaxK [] r' n = ([], r)). -Proof. - intros. split;intro. - * destruct H0. inv H0. setoid_rewrite <- RTCEquiv;[|auto]. - econstructor. split. auto. constructor. - * destruct H0. destruct x. - + rewrite maxKZeroRefl in H0. exists 0. auto. - + inv H; simpl in H0; exists 0; auto. -Qed. - -Ltac toRec := -match goal with -| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => - try (setoid_rewrite <- maxKInsertCanRec;[|constructor]);simpl; - try (setoid_rewrite <- maxKDone;[|constructor]) -| _ => idtac "nothing to do" -end. - -Ltac stepOne := -match goal with -| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => - try (setoid_rewrite <- maxKForwardOne;[|constructor]);simpl -| _ => idtac "nothing to do" -end. - -Ltac stepThousand := -match goal with -| |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => - try (setoid_rewrite <- maxKForwardThousand;[|constructor]);simpl -| _ => idtac "nothing to do" -end. - -Ltac toNextRec := stepOne; toRec. - -Theorem fact_eval_ex: - forall (z : nat), - exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y)%Z. -Proof. - intros. - setoid_rewrite RTCEquiv;[|constructor]. - - toRec. - - (* List of things to solve automatically: *) - - (* 1. We need to figure out what to do the induction on: the variable wrapped inside the Redex *) - - induction z. - * repeat stepThousand. - (* 2. Is there a way to get "y" to be a "nat" as well? I was having problems with that... *) - repeat eexists. exact 0. nia. - * toNextRec. - - (* 3. Why is eval_arith in the redex not simplifying on it's own? Could be because of Arguments...? *) - cbn. - - (* 4. We actually might have multiple arguments in the postcondition, so repeat the destructs until - we run out of exists. Innermost destruct should always be [IHExp IHPostcond] *) - destruct IHz as [y [IHExp IHPostcond]]. - - (* 5. This clears ++ from the FrameStack given back (good, should always work), and, in this case it - converts the ++ in the FrameStack input into ::, because there is only 1 frame. But will we need - to deal with cases with multiple frames as the input? *) - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. - - simpl in IHExp_fic. - - (* 6. The framestack in the goal needs to match the framestack in IHExp_fic. *) - assert ((Z.of_nat (S z) - 1)%Z = Z.of_nat z) by lia. rewrite H. clear H. - - eexists. split. - + eapply maxKTransitive. auto. (* comes from IHExp_fic *) - repeat stepThousand. - repeat eexists. (* solves something else also? Unusual... *) - exact 0. - + (* 7. This particular postcondition is interesting, because the induction hypothesis IHPostcond - is not enough on its own: we need to know that we can not get 0 as a factorial value! - That could only happen in the 0 case, because of IHPostcond, so IHExp needs to be calculated - with it. *) - Fail nia. - setoid_rewrite <- maxKForwardThousand in IHExp;[|constructor]. - simpl in IHExp. - case_innermost IHExp. - - simpl in IHExp. destruct IHExp as [n IHExp]. inv IHExp. nia. - - nia. -Qed. - -Lemma NatZSuccPred: - forall (n : nat), (Z.of_nat (S n) - 1)%Z = Z.of_nat n. -Proof. lia. Qed. - -Theorem maxKTransitive': - forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (P : Prop), - (exists n, sequentialStepMaxK fs r n = (fs', r')) -> - ((exists n, sequentialStepMaxK fs' r' n = (fs'', r'')) /\ P) -> - ((exists n, sequentialStepMaxK fs r n = (fs'', r'')) /\ P). -Proof. - setoid_rewrite <- maxKEquivK. setoid_rewrite <- kEquiv. intros. - destruct H, H0, H0. - split;auto. - exists (x + x0). - eapply transitive_eval; eauto. -Qed. - -Ltac solve_final_state := - eexists; - [auto| (* This is for the step number, which is always irrelevant (|- nat) when this tactic is called *) - first [ auto (* The program indeed terminated at ([], r) where is_result r *) - | idtac "Unexpected end state - (can be due to an exception in the Erlang program, - a result when an exception was expected, - non-termination in the given depth or - an impossible input that was not ruled out)" - ]]. - -Ltac solve_final_postcond := - first [ nia - | idtac "Could not solve postcondition" - ]. - -Ltac solve_terminated := - lazymatch goal with - | |- context[sequentialStepMaxK] => fail "The program has not yet terminated" - | |- _ => - lazymatch goal with - | |- ex _ => eexists;solve_terminated - | |- _ /\ _ => split;[solve_final_state|solve_final_postcond] - | |- _ => idtac - end - end. - -Ltac give_steps_if_needed_using steptac := - first [ progress simpl - | steptac - ]. - -Ltac match_with_backfall backfall := - lazymatch goal with - | |- context[match ?x with _ => _ end] => - case_innermost; - try nia; - backfall - | |- _ => fail "Match expression not found" - end. - -Ltac able_to_ind := - lazymatch goal with - | |- context[sequentialStepMaxK ?fs ?r] => - let b := eval compute in (canRec fs r) in - lazymatch b with - | true => idtac - | false => fail - end - | |- _ => fail - end. - -(* -Fixpoint Exp_list_eqb (le1 le2 : list Exp) : bool := - match le1, le2 with - | [], [] => true - | [], _ :: _ => false - | _ :: _, [] => false - | e1 :: le1', e2 :: le2' => andb (Exp_eqb_strict e1 e2) (Exp_list_eqb le1' le2') - end. - -Fixpoint Val_list_eqb (lv1 lv2 : list Val) : bool := - match lv1, lv2 with - | [], [] => true - | [], _ :: _ => false - | _ :: _, [] => false - | v1 :: lv1', v2 :: lv2' => andb (Val_eqb_strict v1 v2) (Val_list_eqb lv1' lv2') - end. - -Fixpoint Pat_list_eqb (lp1 lp2 : list Pat) : bool := - match lp1, lp2 with - | [], [] => true - | [], _ :: _ => false - | _ :: _, [] => false - | p1 :: lp1', p2 :: lp2' => andb (Pat_eqb p1 p2) (Pat_list_eqb lp1' lp2') - end. - -Fixpoint FCase1_eqb (l1 l2 : list (list Pat * Exp * Exp)) : bool := - match l1, l2 with - | [], [] => true - | [], _ :: _ => false - | _ :: _, [] => false - | (lp1, e1, e1') :: l1', (lp2, e2, e2') :: l2' => - andb (Pat_list_eqb lp1 lp2) (andb (Exp_eqb_strict e1 e2) (andb (Exp_eqb_strict e1' e2') (FCase1_eqb l1' l2'))) - end. - -Print FrameIdent. -Definition FrameIdent_eqb (fi1 fi2 : FrameIdent) : bool := - match fi1, fi2 with - | IValues, IValues => true - | ITuple, ITuple => true - | IMap, IMap => true - | ICall v1 v1', ICall v2 v2' => andb (Val_eqb_strict v1 v2) (Val_eqb_strict v1' v2') - | IPrimOp s1, IPrimOp s2 => String.eqb s1 s2 - | IApp v1, IApp v2 => Val_eqb_strict v1 v2 - | _, _ => false - end. - -Print Frame. -Definition Frame_eqb (f1 f2 : Frame) : bool := - match f1, f2 with - | FCons1 e1, FCons1 e2 => Exp_eqb_strict e1 e2 - | FCons2 v1, FCons2 v2 => Val_eqb_strict v1 v2 - | FParams fi1 vl1 el1, FParams fi2 vl2 el2 => - andb (FrameIdent_eqb fi1 fi2) (andb (Val_list_eqb vl1 vl2) (Exp_list_eqb el1 el2)) - | FApp1 el1, FApp1 el2 => Exp_list_eqb el1 el2 - | FCallMod e1 el1, FCallMod e2 el2 => andb (Exp_eqb_strict e1 e2) (Exp_list_eqb el1 el2) - | FCallFun v1 el1, FCallFun v2 el2 => andb (Val_eqb_strict v1 v2) (Exp_list_eqb el1 el2) - | FCase1 l1, FCase1 l2 => FCase1_eqb l1 l2 - | FCase2 vl1 e1 l1, FCase2 vl2 e2 l2 => - andb (Val_list_eqb vl1 vl2) (andb (Exp_eqb_strict e1 e2) (FCase1_eqb l1 l2)) - | FLet n1 e1, FLet n2 e2 => andb (Nat.eqb n1 n2) (Exp_eqb_strict e1 e2) - | FSeq e1, FSeq e2 => Exp_eqb_strict e1 e2 - | FTry n1 e1 n1' e1', FTry n2 e2 n2' e2' => - andb (Nat.eqb n1 n2) (andb (Exp_eqb_strict e1 e2) (andb (Nat.eqb n1' n2') (Exp_eqb_strict e1' e2'))) - | _, _ => false - end. - -Fixpoint FrameStack_prefix (fs1 fs2 : FrameStack) : bool := - match fs1, fs2 with - | [], _ => true - | f1 :: fs1', f2 :: fs2' => andb (Frame_eqb f1 f2) (FrameStack_prefix fs1' fs2') - | _, _ => false - end.*) - -Ltac base_case := - stepThousand; - first [ solve_terminated - | match_with_backfall base_case - | base_case]. - -Ltac ind_case := idtac. - -Ltac induction_head symb := - let n := fresh "n" in - let IH := fresh "IH" in - induction symb as [n IH] using lt_wf_ind; - let Hn := fresh "Hn" in - destruct n eqn:Hn; - [base_case|ind_case]. - -Ltac solve_to_rec symb := - toRec; - first [ solve_terminated - | able_to_ind; induction_head symb - | match_with_backfall solve_to_rec - | solve_to_rec]. - -Ltac solve_symbolically symb := - first [ intros; setoid_rewrite RTCEquiv;[|constructor]; solve_to_rec symb - | fail "Could not solve goal symbolically" - ]. - -Theorem fact_eval_ex': - forall (z : nat), - exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ ((Z.of_nat z) <= y /\ y >= 1)%Z. -Proof. - solve_symbolically z. - - toNextRec. cbn. - try rewrite NatZSuccPred. - specialize (IH n0 (Nat.lt_succ_diag_r _)). - destruct IH as [y [IHExp IHPostcond]]. - - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. simpl in IHExp_fic. - eexists. eapply maxKTransitive'. auto. - repeat stepThousand. - solve_terminated. -Qed. - -Theorem fact_eval_ex'': - forall (z : nat), - exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit (Z.of_nat z))) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact z))%Z. -Proof. - solve_symbolically z. - - toNextRec. cbn. - try rewrite NatZSuccPred. - specialize (IH n0 (Nat.lt_succ_diag_r _)). - destruct IH as [y [IHExp IHPostcond]]. - - pose proof (frame_indep_core_func _ _ _ _ IHExp) as IHExp_fic. simpl in IHExp_fic. - eexists. eapply maxKTransitive'. auto. - repeat stepThousand. - solve_terminated. -Qed. - -Theorem fact_eval : forall n, - ⟨[], fact_frameStack (˝VLit (Z.of_nat n))⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. -Proof. - intros. - pose proof fact_eval_ex'' n. - destruct H. destruct H. subst x. auto. -Qed. - - - - - - - - - - - - - - - - - - - - - - - From d070600f73bbfc4a4984ddc075418565c8b9ae1e Mon Sep 17 00:00:00 2001 From: mtlevr Date: Fri, 12 Dec 2025 15:43:11 +0100 Subject: [PATCH 12/20] Put symbolic evaluation in the make file --- _CoqProject | 4 ++++ src/Symbolic/SymbTactics.v | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/_CoqProject b/_CoqProject index b92a4be0..77fe54fb 100644 --- a/_CoqProject +++ b/_CoqProject @@ -52,6 +52,10 @@ src/Interpreter/Scheduler.v src/Interpreter/Equivalences.v src/Interpreter/ExampleASTs +src/Symbolic/SymbTheorems.v +src/Symbolic/SymbTactics.v +src/Symbolic/SymbExamples.v + src/BigStep/Syntax.v src/BigStep/Induction.v src/BigStep/Equalities.v diff --git a/src/Symbolic/SymbTactics.v b/src/Symbolic/SymbTactics.v index eca5f0c6..57b77025 100644 --- a/src/Symbolic/SymbTactics.v +++ b/src/Symbolic/SymbTactics.v @@ -48,21 +48,21 @@ match goal with | |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => try (setoid_rewrite <- maxKInsertCanRec;[|constructor]);simpl; try (setoid_rewrite <- maxKDone;[|constructor]) -| _ => idtac "nothing to do" +| _ => idtac end. Ltac stepOne := match goal with | |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => try (setoid_rewrite <- maxKForwardOne;[|constructor]);simpl -| _ => idtac "nothing to do" +| _ => idtac end. Ltac stepThousand := match goal with | |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => try (setoid_rewrite <- maxKForwardThousand;[|constructor]);simpl -| _ => idtac "nothing to do" +| _ => idtac end. Ltac toNextRec := stepOne; toRec. From 71ff66503621f8a1d51f188d23b51dd6e348406e Mon Sep 17 00:00:00 2001 From: mtlevr Date: Mon, 2 Feb 2026 13:38:44 +0100 Subject: [PATCH 13/20] Updated examples of symbolic exec --- src/Symbolic/SymbExamples.v | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Symbolic/SymbExamples.v b/src/Symbolic/SymbExamples.v index cb8b7b12..b33bb605 100644 --- a/src/Symbolic/SymbExamples.v +++ b/src/Symbolic/SymbExamples.v @@ -21,10 +21,11 @@ Definition fact_frameStack (e : Exp) : Exp := Theorem fact_eval_ex: forall (z : Z), (0 <= z)%Z -> exists (y : Z), - ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (z <= y /\ y >= 1)%Z. + ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z))%Z). Proof. solve_symbolically z. -Qed. + admit. +Admitted. Definition tailrec_fact (e d : Exp) : Exp := ELetRec [ From d496813afaadd8e946dfd9f832b2834012e96e1b Mon Sep 17 00:00:00 2001 From: berpeti Date: Wed, 4 Feb 2026 13:41:02 +0100 Subject: [PATCH 14/20] Minor change: Admitted -> Abort --- src/Symbolic/SymbExamples.v | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Symbolic/SymbExamples.v b/src/Symbolic/SymbExamples.v index b33bb605..5192861b 100644 --- a/src/Symbolic/SymbExamples.v +++ b/src/Symbolic/SymbExamples.v @@ -24,8 +24,7 @@ Theorem fact_eval_ex: ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z))%Z). Proof. solve_symbolically z. - admit. -Admitted. +Abort. Definition tailrec_fact (e d : Exp) : Exp := ELetRec [ From f00a005445a2fc35962dc8d5cb78c5da48c38799 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Mon, 16 Feb 2026 11:48:44 +0100 Subject: [PATCH 15/20] removed the even_odd program --- src/Symbolic/even_odd.core | 192 ------------------------------------- src/Symbolic/even_odd.erl | 40 -------- 2 files changed, 232 deletions(-) delete mode 100644 src/Symbolic/even_odd.core delete mode 100644 src/Symbolic/even_odd.erl diff --git a/src/Symbolic/even_odd.core b/src/Symbolic/even_odd.core deleted file mode 100644 index d5caa662..00000000 --- a/src/Symbolic/even_odd.core +++ /dev/null @@ -1,192 +0,0 @@ -module 'even_odd' ['even'/1, - 'even2'/1, - 'main'/1, - 'module_info'/0, - 'module_info'/1, - 'odd'/1, - 'odd2'/1] - attributes [%% Line 1 - 'file' = - %% Line 1 - [{[101|[118|[101|[110|[95|[111|[100|[100|[46|[101|[114|[108]]]]]]]]]]]],1}]] -'even'/1 = - %% Line 4 - ( fun (_0) -> - ( case ( _0 - -| [{'function',{'even',1}}] ) of - <0> when 'true' -> - %% Line 5 - 'true' - %% Line 6 - - when call 'erlang':'>' - (( _0 - -| [{'function',{'even',1}}] ), - 0) -> - let <_1> = - call %% Line 7 - 'erlang':%% Line 7 - '-' - (%% Line 7 - N, %% Line 7 - 1) - in %% Line 7 - apply 'odd'/1 - (_1) - %% Line 8 - <_3> when 'true' -> - %% Line 9 - 'false' - end - -| [{'function',{'even',1}}] ) - -| [{'function',{'even',1}}] ) -'odd'/1 = - %% Line 11 - ( fun (_0) -> - ( case ( _0 - -| [{'function',{'odd',1}}] ) of - <1> when 'true' -> - %% Line 12 - 'true' - %% Line 13 - - when call 'erlang':'>' - (( _0 - -| [{'function',{'odd',1}}] ), - 1) -> - let <_1> = - call %% Line 14 - 'erlang':%% Line 14 - '-' - (%% Line 14 - N, %% Line 14 - 1) - in %% Line 14 - apply 'even'/1 - (_1) - %% Line 15 - <_3> when 'true' -> - %% Line 16 - 'false' - end - -| [{'function',{'odd',1}}] ) - -| [{'function',{'odd',1}}] ) -'even2'/1 = - %% Line 21 - ( fun (_0) -> - ( case ( _0 - -| [{'function',{'even2',1}}] ) of - <0> when 'true' -> - %% Line 22 - 'true' - %% Line 23 - <1> when 'true' -> - %% Line 24 - 'false' - %% Line 25 - - when call 'erlang':'>' - (( _0 - -| [{'function',{'even2',1}}] ), - 1) -> - let <_1> = - call %% Line 26 - 'erlang':%% Line 26 - '-' - (%% Line 26 - N, %% Line 26 - 2) - in %% Line 26 - apply 'even2'/1 - (_1) - %% Line 27 - <_3> when 'true' -> - %% Line 28 - 'false' - end - -| [{'function',{'even2',1}}] ) - -| [{'function',{'even2',1}}] ) -'odd2'/1 = - %% Line 30 - ( fun (_0) -> - ( case ( _0 - -| [{'function',{'odd2',1}}] ) of - <0> when 'true' -> - %% Line 31 - 'false' - %% Line 32 - <1> when 'true' -> - %% Line 33 - 'true' - %% Line 34 - - when call 'erlang':'>' - (( _0 - -| [{'function',{'odd2',1}}] ), - 1) -> - let <_1> = - call %% Line 35 - 'erlang':%% Line 35 - '-' - (%% Line 35 - N, %% Line 35 - 2) - in %% Line 35 - apply 'odd2'/1 - (_1) - %% Line 36 - <_3> when 'true' -> - %% Line 37 - 'false' - end - -| [{'function',{'odd2',1}}] ) - -| [{'function',{'odd2',1}}] ) -'main'/1 = - %% Line 39 - ( fun (_0) -> - ( case ( _0 - -| [{'function',{'main',1}}] ) of - <[]> when 'true' -> - let <_4> = - apply %% Line 40 - 'even'/1 - (%% Line 40 - 5) - in let <_3> = - apply %% Line 40 - 'odd'/1 - (%% Line 40 - 5) - in let <_2> = - apply %% Line 40 - 'even2'/1 - (%% Line 40 - 5) - in let <_1> = - apply %% Line 40 - 'odd2'/1 - (%% Line 40 - 5) - in %% Line 40 - [_4|[_3|[_2|[_1|[]]]]] - ( <_5> when 'true' -> - ( primop 'match_fail' - (( {'function_clause',_5} - -| [{'function',{'main',1}}] )) - -| [{'function',{'main',1}}] ) - -| ['compiler_generated'] ) - end - -| [{'function',{'main',1}}] ) - -| [{'function',{'main',1}}] ) -'module_info'/0 = - ( fun () -> - call 'erlang':'get_module_info' - ('even_odd') - -| [{'function',{'module_info',0}}] ) -'module_info'/1 = - ( fun (_0) -> - call 'erlang':'get_module_info' - ('even_odd', ( _0 - -| [{'function',{'module_info',1}}] )) - -| [{'function',{'module_info',1}}] ) -end \ No newline at end of file diff --git a/src/Symbolic/even_odd.erl b/src/Symbolic/even_odd.erl deleted file mode 100644 index 01412d72..00000000 --- a/src/Symbolic/even_odd.erl +++ /dev/null @@ -1,40 +0,0 @@ --module(even_odd). --export([even/1, odd/1, even2/1, odd2/1, main/1]). - -even(0) -> - true; -even(N) when N > 0 -> - odd(N - 1); -even(_) -> - false. - -odd(1) -> - true; -odd(N) when N > 1 -> - even(N - 1); -odd(_) -> - false. - - - - -even2(0) -> - true; -even2(1) -> - false; -even2(N) when N > 1 -> - even2(N - 2); -even2(_) -> - false. - -odd2(0) -> - false; -odd2(1) -> - true; -odd2(N) when N > 1 -> - odd2(N - 2); -odd2(_) -> - false. - -main([]) -> - [even(5), odd(5), even2(5), odd2(5)]. From fae03ebf492f6075d7bbbe1903a2625943db8dfb Mon Sep 17 00:00:00 2001 From: mtlevr Date: Mon, 16 Feb 2026 13:09:00 +0100 Subject: [PATCH 16/20] Added comments to SymbTheorems --- src/Symbolic/SymbTheorems.v | 69 ++++++++++++++++++++++++++++++------- 1 file changed, 57 insertions(+), 12 deletions(-) diff --git a/src/Symbolic/SymbTheorems.v b/src/Symbolic/SymbTheorems.v index f71311ee..f5e042f3 100644 --- a/src/Symbolic/SymbTheorems.v +++ b/src/Symbolic/SymbTheorems.v @@ -3,26 +3,36 @@ From CoreErlang.Interpreter Require Import StepFunctions Equivalences. Import ListNotations. -Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := +(** This file contains definitions theorems that are used in the tactics defined + in SymbTactics.v. + *) + +(* This function performs at most "k" reduction steps. If we cannot perform a + reduction, the last config is returned. *) +Fixpoint sequentialStepMaxK (fs : FrameStack) (r : Redex) (k : nat) : FrameStack * Redex := match sequentialStepFunc fs r with | None => (fs, r) | Some (fs', r') => - match n with + match k with | 0 => (fs, r) - | S n' => sequentialStepMaxK fs' r' n' + | S k' => sequentialStepMaxK fs' r' k' end end. -Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (n : nat) : option (FrameStack * Redex) := - match n with +(* Partial function performing "k" reduction steps *) +Fixpoint sequentialStepK (fs : FrameStack) (r : Redex) (k : nat) : option (FrameStack * Redex) := + match k with | 0 => Some (fs, r) - | S n' => + | S k' => match sequentialStepFunc fs r with - | Some (fs', r') => sequentialStepK fs' r' n' + | Some (fs', r') => sequentialStepK fs' r' k' | None => None end end. +(* A configuration can be said to be potentially recursive, if the top frame is + a function application with a non-empty closure and no more parameters need to + be evaluated. *) Definition canRec (fs : FrameStack) (r : Redex) : bool := match fs with | FParams (IApp (VClos (_ :: _) _ _ _)) _ [] :: _ => @@ -34,33 +44,42 @@ Definition canRec (fs : FrameStack) (r : Redex) : bool := | _ => false end. +(* In the semantics, eval_cool_params and eval_cool_params_0 are responsible + for the final step of function evaluation. For symbolic execution, it is + better to split eval_cool_params in two steps, so the redex becomes an RBox + and we only need to care about the frame stack. *) Definition lastParamRBox (fs : FrameStack) (r : Redex) : (FrameStack * Redex) := match fs, r with | FParams ident vl ex :: fs', RValSeq [v] => (FParams ident (vl ++ [v]) ex :: fs', RBox) - | FParams ident vl ex :: fs', RBox => (FParams ident vl ex :: fs', RBox) - | fs', r => (fs', r) + | FParams ident vl ex :: fs', RBox => (fs, r) + | fs', r' => (fs', r') end. -Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (n : nat) : FrameStack * Redex := +(* This function performs at most "k" reduction steps, unless a potentially recursive + configuration is found. If it is found, lastParamRBox is used to convert it to the + eval_cool_params_0 form. *) +Fixpoint sequentialStepCanRec (fs : FrameStack) (r : Redex) (k : nat) : FrameStack * Redex := match canRec fs r with | true => lastParamRBox fs r | false => match sequentialStepFunc fs r with | None => (fs, r) | Some (fs', r') => - match n with + match k with | 0 => (fs, r) - | S n' => sequentialStepCanRec fs' r' n' + | S k' => sequentialStepCanRec fs' r' k' end end end. +(* The 3 functions should only be computed if all parameters are constructors. *) Arguments sequentialStepMaxK !_ !_ !_ /. Arguments sequentialStepK !_ !_ !_ /. Arguments sequentialStepCanRec !_ !_ !_ /. (* ----- LEMMAS ----- *) +(* Max 0 steps is reflexive *) Lemma maxKZeroRefl: forall (fs : FrameStack) (r : Redex), sequentialStepMaxK fs r 0 = (fs, r). @@ -70,6 +89,8 @@ Proof. 1:destruct p. all:reflexivity. Qed. +(* If a step count exists to reach an end configuration with at max that number of + steps, one more step also works. *) Lemma maxKForwardOne: forall (fs : FrameStack) (r r' : Redex), is_result r' -> @@ -85,6 +106,8 @@ Proof. + exists x. auto. Qed. +(* If a step count exists to reach an end configuration with at max that number of + steps, more steps also work in general. *) Lemma maxKOverflow: forall (fs : FrameStack) (r r' : Redex) (n m : nat), is_result r' -> @@ -108,6 +131,7 @@ Proof. - auto. Qed. +(* A specialized version of maxKOverflow, using 1000 extra steps. *) Lemma maxKForwardThousand: forall (fs : FrameStack) (r r' : Redex), is_result r' -> @@ -121,6 +145,8 @@ Proof. apply (maxKOverflow _ _ _ x); auto. lia. Qed. +(* The max k step function is equivalent to the k step function, but importantly + the step count needs to be existential. *) Lemma maxKEquivK: forall (fs fs' : FrameStack) (r r' : Redex), (exists n, sequentialStepK fs r n = Some (fs', r')) <-> @@ -151,6 +177,7 @@ Proof. - inv H. exists 0. unfold sequentialStepK. reflexivity. Qed. +(* The k step function is equivalent to the inductive definition. *) Lemma kEquiv: forall (fs fs' : FrameStack) (r r' : Redex) (k : nat), ⟨ fs, r ⟩ -[k]-> ⟨ fs', r' ⟩ <-> sequentialStepK fs r k = Some (fs', r'). @@ -171,6 +198,7 @@ Proof. - inv H. Qed. +(* The k step function with existential step count is equivalent to the RTC. *) Theorem RTCEquiv: forall (fs : FrameStack) (r r' : Redex), is_result r' -> @@ -186,6 +214,8 @@ Proof. apply kEquiv. eauto. Qed. +(* If the canRec function gives true for a config, the top frame will be potentially + recursive, and the redex will be either an RValSeq or an RBox. *) Lemma canRecUnfold: forall (fs : FrameStack) (r : Redex), canRec fs r = true -> @@ -201,6 +231,8 @@ Proof. * do 8 eexists. 1:reflexivity. right. reflexivity. Qed. +(* If sequentialStepMaxK gets to an end config, then + sequentialStepCanRec ∘ sequentialStepMaxK gets to the same end config. *) Lemma maxKTransCanRec: forall (fs fs': FrameStack) (r r' r'': Redex) (k : nat), is_result r'' -> @@ -259,6 +291,8 @@ Proof. exists 0. apply maxKZeroRefl. Qed. +(* One of the directions of this lemma is essentially the same as the previous lemma. + In this lemma, "let" is used instead of separating things with implications. *) Lemma maxKInsertCanRecGeneral: forall (fs : FrameStack) (r r'' : Redex) (k : nat), is_result r'' -> @@ -323,6 +357,7 @@ Proof. all:exists 0; auto. Qed. +(* A specialization of the previous lemma with 1000 steps. *) Lemma maxKInsertCanRec: forall (fs : FrameStack) (r r'' : Redex), is_result r'' -> @@ -333,6 +368,7 @@ Proof. exact (maxKInsertCanRecGeneral fs r r'' 1000). Qed. +(* The frame_indep_core lemma, but for the executable semantics. *) Theorem frame_indep_core_func: forall (fs fs' : FrameStack) (r r' : Redex), (exists n, sequentialStepMaxK fs r n = (fs', r')) -> @@ -344,6 +380,7 @@ Proof. exists x. apply kEquiv. apply frame_indep_core. auto. Qed. +(* The max k step function is transitive. *) Theorem maxKTransitive: forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex), (exists n, sequentialStepMaxK fs r n = (fs', r')) -> @@ -355,6 +392,9 @@ Proof. eapply transitive_eval; eauto. Qed. +(* The tactics require proving postconditions after termination. "P" is the + postcondition; it's much easier to use transitivity with "P" still being + present in the conjunction. *) Theorem maxKTransitive': forall (fs fs' fs'' : FrameStack) (r r' r'' : Redex) (P : Prop), (exists n, sequentialStepMaxK fs r n = (fs', r')) -> @@ -368,6 +408,8 @@ Proof. eapply transitive_eval; eauto. Qed. +(* If we've reached an end config, but don't have enough steps to evaluate sequentialStepMaxK + with simpl, we can rewrite. This is a very niche lemma for a very niche case in 1 tactic. *) Lemma maxKDone: forall (r r' : Redex), is_result r' -> @@ -382,6 +424,9 @@ Proof. + inv H; simpl in H0; exists 0; auto. Qed. +(* The tactic "nia" works better with "=" and "<>" instead of "=?". These tactics are stated + here separately, because the standard library uses "<->", and we don't want to accidentally + rewrite backwards. *) Lemma Z_eqb_eq_corr : forall (z1 z2 : Z), (z1 =? z2)%Z = true -> z1 = z2. Proof. lia. Qed. Lemma Z_eqb_neq_corr: forall (z1 z2 : Z), (z1 =? z2)%Z = false-> z1 <>z2. Proof. lia. Qed. From 1ac9dd1cec9c4296003395d90032af577322900d Mon Sep 17 00:00:00 2001 From: mtlevr Date: Mon, 16 Feb 2026 13:47:46 +0100 Subject: [PATCH 17/20] Added a long description at the start of the file --- src/Symbolic/SymbTactics.v | 50 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/src/Symbolic/SymbTactics.v b/src/Symbolic/SymbTactics.v index 57b77025..49c6df0a 100644 --- a/src/Symbolic/SymbTactics.v +++ b/src/Symbolic/SymbTactics.v @@ -4,6 +4,56 @@ From CoreErlang.Symbolic Require Import SymbTheorems. Import ListNotations. +(** This file contains tactics that can be used to solve program property goals. + The tactic "solve_symbolically i1 [i2 ...]" can solve goals for programs that + are non-recursive, and structurally recursive programs that use their first + argument for the recursion. This first argument needs to be an integer (Z). + + The "solve_symbolically" tactic works for goals in the following form: + + forall i1 i2... , PreCond (i1 i2 ...) -> + exists o1 o2... , ⟨ [], prog (i1 i2 ...) ⟩ -->* REnd (o1 o2 ...) + /\ PostCond (i1 i2 ... o1 o2 ...) + + - i1 i2... are symbolic variables + - PreCond (i1 i2 ...) is of type "Prop", and it's the conjunction of all + preconditions. These preconditions depend on the symbolic variables. + If no precondition needs to be given, PreCond (i1 i2 ...) should be "True" + - o1 o2... are subterms of the end configuration + - prog (i1 i2 ...) is a redex at the start of the evaluation, parameterized + by the symbolic variables. It should be a function application, with i1 i2 ... + being the parameters of the function. + - REnd (o1 o2 ...) is the end configuration, parameterized by the subterms + introduced in the exists. By the nature of the RTC, REnd (o1 o2 ...) is either + an "RValSeq" or "RExc". + - PostCond (i1 i2 ... o1 o2 ...) is of type Prop, and it's the conjunction + of all postconditions. These postcondicions depend on the symbolic variables + and the end configuration subterms. + + An example for the kind of goal that "solve_symbolically" can prove: + + forall (z : Z), (0 <= z)%Z -> + exists (y : Z), ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] + /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z))%Z). + + For the example above, + - i1 : Z := z + - PreCond (i1) : Prop := (0 <= z)%Z + - o1 : Z := y + - prog (i1) : Redex := RExp (fact_frameStack (˝VLit z)) + (see SymbExamples for fact_frameStack) + - REnd (o1) : Redex := RValSeq [VLit y] + - PostCons (i1 o1) : Prop := (y = Z.of_nat (Factorial.fact (Z.to_nat z))%Z) + + The "solve_symbolically" tactic needs to be given all symbolic variables (i1, i2, ...) + The tactic evaluates the program symbolically. If branching is needed, the branch + condition gets added to the precondition, and the evaluation continues on all + branches. If the program terminates, the tactic tries to either prove the branch + is impossible to reach, or prove the postcondition. If the studied function is + structurally recursive, and the recursion is done on the first argument, which is + also of type Z, the tactic can also solve the goal. If the program terminates, but the + postcondition could not be solved, the user needs to do that manually. + *) Ltac contains_match := lazymatch goal with From 4f997b1e35c19aeedacdd8edbaa9a77ad250dafc Mon Sep 17 00:00:00 2001 From: mtlevr Date: Mon, 16 Feb 2026 15:51:41 +0100 Subject: [PATCH 18/20] Added more comments to tactics --- src/Symbolic/SymbTactics.v | 110 +++++++++++++++++++++++++++++-------- 1 file changed, 86 insertions(+), 24 deletions(-) diff --git a/src/Symbolic/SymbTactics.v b/src/Symbolic/SymbTactics.v index 49c6df0a..5788414a 100644 --- a/src/Symbolic/SymbTactics.v +++ b/src/Symbolic/SymbTactics.v @@ -18,7 +18,7 @@ Import ListNotations. - i1 i2... are symbolic variables - PreCond (i1 i2 ...) is of type "Prop", and it's the conjunction of all preconditions. These preconditions depend on the symbolic variables. - If no precondition needs to be given, PreCond (i1 i2 ...) should be "True" + If no precondition needs to be given, PreCond (i1 i2 ...) should be "True". - o1 o2... are subterms of the end configuration - prog (i1 i2 ...) is a redex at the start of the evaluation, parameterized by the symbolic variables. It should be a function application, with i1 i2 ... @@ -28,7 +28,13 @@ Import ListNotations. an "RValSeq" or "RExc". - PostCond (i1 i2 ... o1 o2 ...) is of type Prop, and it's the conjunction of all postconditions. These postcondicions depend on the symbolic variables - and the end configuration subterms. + and the end configuration subterms. If no postconditions needs to be given, + PostCond (i1 i2 ... o1 o2 ...) should be "True". + + If the solve_symbolically tactic receives a goal in the above form, the forms + of goals in the subtactics will be correctly taken care of. It's especially + important for "True" to be provided as a pre- or postcondition, in case the + respective condition is not needed. An example for the kind of goal that "solve_symbolically" can prove: @@ -55,18 +61,27 @@ Import ListNotations. postcondition could not be solved, the user needs to do that manually. *) +(* Guard tactic to see if case separation is needed. *) Ltac contains_match := lazymatch goal with | |- context[match _ with _ => _ end] => idtac | |- _ => fail end. +(* Guard tactic to see if the configuration is potentially recursive. *) Ltac possibly_recursive := lazymatch goal with | |- context[FParams (IApp (VClos (_ :: _) _ _ _)) _ [] :: _] => idtac | |- _ => fail end. +(* The "case_innermost" tactic is for performing destruct on the innermost match expression. + This is used during case separation, where the cases manifest as deeply-nested pattern + matches. *) + +(* This subtactic does the actual case separation. In case "=?" is used, it's also + converted into "=" or "<>", because lia and nia work better with the latter. + Heq will be the name of the introduced hypothesis. *) Ltac case_innermost_term t Heq := lazymatch t with | context[match ?x with _ => _ end] => @@ -78,21 +93,26 @@ Ltac case_innermost_term t Heq := | _ => fail "No match subterm found" end. +(* Performing "case_innermost" in the goal. *) Ltac case_innermost Heq := match goal with | |- ?g => case_innermost_term g Heq end. +(* Performing "case_innermost" in a Hypo. *) Ltac case_innermost_in H Heq := let T := type of H in case_innermost_term T Heq. +(* Notations for the last 2 tactics. *) Tactic Notation "case_innermost" ident(Heq) := case_innermost Heq. Tactic Notation "case_innermost" ident(H) ident(Heq) := case_innermost_in H Heq. +(* This tactic tries to get to a potentially recursive configuration. At most 1000 + steps are performed (see SymbTheorems/maxKInsertCanRec). *) Ltac toRec := match goal with | |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => @@ -101,6 +121,7 @@ match goal with | _ => idtac end. +(* Performing at most 1 reduction step. *) Ltac stepOne := match goal with | |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => @@ -108,6 +129,7 @@ match goal with | _ => idtac end. +(* Performing at most 1000 reduction steps *) Ltac stepThousand := match goal with | |- context[exists n : nat, sequentialStepMaxK _ _ n = _] => @@ -115,8 +137,7 @@ match goal with | _ => idtac end. -Ltac toNextRec := stepOne; toRec. - +(* Guard tactic to see if we can start the inductive reasoning algorithm. *) Ltac able_to_ind := lazymatch goal with | |- context[sequentialStepMaxK ?fs ?r] => @@ -128,12 +149,17 @@ Ltac able_to_ind := | |- _ => fail end. +(* Guard tactic to see if we have not yet terminated. *) Ltac is_not_terminated := lazymatch goal with | |- context[sequentialStepMaxK _ _ _] => idtac | |- _ => fail end. +(* Tactic for solving + exists _, ([], r) = ([], ?r) + The unexpected end state part should never be able to run, because "solve_symbolically" + makes sure to only call this subtactic in the case above. *) Ltac solve_final_state := exists 0; (* This is for the step number, which is always irrelevant (|- nat) when this tactic is called *) first [ auto (* The program indeed terminated at ([], r) where is_result r *) @@ -141,15 +167,18 @@ Ltac solve_final_state := (can be due to an exception in the Erlang program, a result when an exception was expected, non-termination in the given depth or - an impossible input that was not ruled out)" + an impossible precondition that was not ruled out)" ]. +(* Tactic to solve the final postcondition, or impossible branch. If extra SMT solvers + are added to the project, they should be put here. *) Ltac solve_final_postcond := first [ nia | auto | idtac "Could not solve postcondition" ]. +(* Solving a terminated goal. This requires the max K function to not be in the goal. *) Ltac solve_terminated := lazymatch goal with | |- context[sequentialStepMaxK] => fail "The program has not yet terminated" @@ -161,21 +190,26 @@ Ltac solve_terminated := end end. -Tactic Notation "intros_tail" := - idtac. +Ltac strip_IH_precond IH := + (* By this point, the induction hypothesis is an implication chain, similar to this: -Tactic Notation "intros_tail" ident_list(t) := - intros t. + IH : C1 -> C2 -> ... -> Cn -> forall s1 s2 ... , PreCond -> ... -Ltac strip_IH_precond IH := - (* By this point, the induction hypothesis is an implication list. Note that this tactic - terminates at hitting a forall, even if implication is just syntactic sugar for a forall - in Coq. - - P -> Q is equivalent to forall _ : P, Q - - When hitting a forall, lia cannot go further, because it is a declaration of a symbolic - variable. In that case 'P' is not solvable. So this is a trick, but it is intended behaviour. *) + This tactic strips the IH of the conditions C1 ... Cn before the forall, which can + all be solved using lia. Note that some tricks are needed, because implication is + just syntactic sugar for a forall in Coq. + + P -> Q is equivalent to forall _ : P, Q + + The trick is to first get the condition C1, use lia to prove it, then specialize IH + with it. C1 can then be cleared. + + The problem with tha lazymatch is that (| ?p -> _) will also match on + (forall _ : ?p, _). However, asserting (_ : ?p) cannot be solved by lia. So after this + tactic, we've simplified IH to: + + IH : forall s1 s2 ... , PreCond -> ... + *) let TIH := type of IH in lazymatch TIH with | ?p -> _ => @@ -187,6 +221,12 @@ Ltac strip_IH_precond IH := end. Ltac destruct_until_conj IH := + (* By this point, IH will be in the form: + + IH : exists t1 t2 ... , (Term /\ PostCond) + + Since IH is a hypothesis, destruct can be used to 'give values to' t1, t2, etc. + *) lazymatch (type of IH) with | _ /\ _ => idtac | ex _ => @@ -196,6 +236,12 @@ Ltac destruct_until_conj IH := end. Ltac eexists_until_conj := + (* By this point, the goal will be in the form: + + |- exists t1 t2 ... , (Term /\ PostCond) + + eexists can be used to 'give values to' t1, t2, etc. + *) lazymatch goal with | |- _ /\ _ => idtac | |- ex _ => eexists; eexists_until_conj @@ -222,9 +268,6 @@ Ltac separate_cases_mult h t := (* Finally, we get back to the standard goal on both branches. *) revert h t precond'. -(* Tactic Notation "separate_cases_mult" ident(h) ident_list(t) := - separate_cases_mult h t. *) - Ltac base_case_mult_inner h t := (* Do a thousand reduction steps. *) stepThousand; @@ -241,7 +284,12 @@ Ltac base_case_mult_inner h t := ]. Ltac base_case_mult precond heq' h t := - (* We need to return h and the precondition to the goal, before the loop begins. *) + (* This tactic is for the base case of the induction. Since "solve_symbolically" can + only be used for structurally recursive functions, this case will definitely + terminate. We need to get back to the standard form where symbolic variables are + universally quantified. The precondition is unified with the branch condition, + and everything is reverted in order. Symbolic evaluation is done in + "base_case_mult_inner". *) let precond' := fresh "PreCond" in let Tp := type of precond in let Th := type of heq' in @@ -408,7 +456,16 @@ solve_symbolically_internal_mult h t := ]. (* HACK: it is way easier, to handle cases with 1 and more than 1 symbolic variables separately. - Ltac is very peculiar with empty parameter lists, which is annoying. *) + Ltac is very peculiar with empty parameter lists, which is annoying. + + Tactics ending in "_0" are copies of tactics ending in "_mult", but for them only the + first symbolic variable (h) is provided without the rest (t). We provide "Tactic Notation" + to use "solve_symbolically_internal_mult" and "solve_symbolically_internal_0" in the cases + where more than 1 parameter is given and only 1 parameter is given. + + The upside of this approach is the individual sub-tactics are way less complicated, + but the downside is making changes requires refactoring in two places. *) + Tactic Notation "solve_symbolically" ident(h) ne_ident_list(t) := (* To start, rewrite the goal from inductive to functional *) setoid_rewrite RTCEquiv;[|auto]; @@ -451,7 +508,12 @@ Ltac base_case_0_inner h := ]. Ltac base_case_0 precond heq' h := - (* We need to return h and the precondition to the goal, before the loop begins. *) + (* This tactic is for the base case of the induction. Since "solve_symbolically" can + only be used for structurally recursive functions, this case will definitely + terminate. We need to get back to the standard form where symbolic variables are + universally quantified. The precondition is unified with the branch condition, + and everything is reverted in order. Symbolic evaluation is done in + "base_case_mult_inner". *) let precond' := fresh "PreCond" in let Tp := type of precond in let Th := type of heq' in From 482fb7bd5c23af54515538c9953a191b9a6b96b4 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Mon, 16 Feb 2026 16:01:50 +0100 Subject: [PATCH 19/20] Added some comments to examples, plus manually solved one --- src/Symbolic/SymbExamples.v | 48 ++++++++++++++++++++++++++----------- 1 file changed, 34 insertions(+), 14 deletions(-) diff --git a/src/Symbolic/SymbExamples.v b/src/Symbolic/SymbExamples.v index 5192861b..096c31da 100644 --- a/src/Symbolic/SymbExamples.v +++ b/src/Symbolic/SymbExamples.v @@ -4,6 +4,9 @@ From CoreErlang.Symbolic Require Import SymbTheorems SymbTactics. Import ListNotations. +(** This file gives some examples for the "solve_symbolically" tactic. + *) + Definition fact_frameStack (e : Exp) : Exp := ELetRec [(1, °ECase (˝VVar 1) [ @@ -15,16 +18,32 @@ Definition fact_frameStack (e : Exp) : Exp := ) ])] (EApp (˝VFunId (0, 1)) [e]) - (* Write the definition here *) . +(* Proving that fact_frameStack is equivalent to Coq's factorial. + This requires some manual work for proving the postcondition in the inductive case. + *) Theorem fact_eval_ex: forall (z : Z), (0 <= z)%Z -> exists (y : Z), ⟨ [], (fact_frameStack (˝VLit z)) ⟩ -->* RValSeq [VLit y] /\ (y = Z.of_nat (Factorial.fact (Z.to_nat z))%Z). Proof. solve_symbolically z. -Abort. + + destruct PreCond0. subst. + destruct H. subst. clear H. + rewrite Z2Nat.inj_sub;[|lia]. + Search Z.to_nat Z.pos. + assert (Z.to_nat 1%Z = 1). { lia. } + rewrite H. clear H. + rewrite Z2Nat.inj_pos. + rewrite <- positive_nat_Z at 1. + rewrite <- Nat2Z.inj_mul. f_equal. + remember (Pos.to_nat p) as k. + destruct k. + * lia. + * simpl. rewrite Nat.sub_0_r. reflexivity. +Qed. Definition tailrec_fact (e d : Exp) : Exp := ELetRec [ @@ -40,6 +59,10 @@ Definition tailrec_fact (e d : Exp) : Exp := ] (EApp (˝VFunId (0, 2)) [e; d]) . +(* Proving that tailrec_fact works equivalently to Coq's factorial. + This also requires some manual work for the postcondition, and also when stating + the theorem itself it needs to be proven for a general second argument. + *) Theorem fact_tailrec_eval_ex: forall (z : Z) (z' : Z), (0 <= z)%Z -> exists (y : Z), @@ -71,6 +94,7 @@ Definition timestwo (e : Exp) : Exp := Definition timestwo' (e : Exp) : Exp := °ECall (˝erlang) (˝VLit "*"%string) [e; ˝VLit 2%Z]. +(* The tactic works with functions that are defined to be recursive, but actually are not. *) Theorem timestwo_ex: forall (z : Z), True -> exists (y : Z), @@ -79,6 +103,7 @@ Proof. solve_symbolically z. Qed. +(* The tactic works for non-recursive functions. *) Theorem timestwo'_ex: forall (z : Z), True -> exists (y : Z), @@ -90,6 +115,7 @@ Qed. Definition times_two_simple (e : Exp) : Exp := (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "*"%string))) [e;(VVal (VLit (Integer (2))))])). +(* Multiplying by two, using 'erlang':'*' *) Theorem times_two_simple_ex: forall (z : Z), True -> exists (y : Z), @@ -108,6 +134,7 @@ Definition times_two_rec (e : Exp) : Exp := ELetRec [ (EApp (VVal (VFunId (0, 1))) [e]). +(* Multiplying by two, using a recursive definition. (1 argument for the tactic) *) Theorem times_two_rec_ex: forall (z : Z), (0 <= z)%Z -> exists (y : Z), @@ -119,6 +146,7 @@ Qed. Definition plus_nums_simple (e f : Exp) : Exp := (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [e;f])). +(* Adding two numbers using 'erlang':'+'. *) Theorem plus_nums_simple_ex: forall (z : Z) (z' : Z), True -> exists (y : Z), @@ -137,6 +165,7 @@ Proof. (* This cannot be proven by induction, since the goal is too specific. *) Abort. +(* Adding two numbers using a recursive definition. (2 arguments for the tactic) *) Theorem plus_nums_rec_ex': forall (z : Z) (z' : Z), (z >= 0)%Z -> exists (y : Z), @@ -145,10 +174,11 @@ Proof. solve_symbolically z z'. Qed. - Definition isitzero_atom (e : Exp) : Exp := (EExp (ECase (e) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "true"%string))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "false"%string))))])). +(* Theorem with atom in the postcondition instead of Z. This is just a case expression, + not a function application. *) Theorem isitzero_atom_ex: forall (z : Z), (z >= 0)%Z -> exists (y : string), @@ -179,6 +209,7 @@ Proof. solve_symbolically z. Qed. +(* Theorem with atom in the postcondition instead of Z. *) Definition isitzero_atom_app (e : Exp) : Exp := EExp ( EApp ( EFun 1(EExp (ECase (VVal (VVar 0)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "true"%string))));([PVar], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Atom "false"%string))))]))) [e]). @@ -216,14 +247,3 @@ Theorem timestwo_ex''': Proof. solve_symbolically z. Qed. - - - - - - - - - - - From b234b41a6614276934c6a82fef751b3cb7dd2211 Mon Sep 17 00:00:00 2001 From: mtlevr Date: Mon, 16 Feb 2026 16:41:41 +0100 Subject: [PATCH 20/20] removed a print statement --- src/Symbolic/SymbExamples.v | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Symbolic/SymbExamples.v b/src/Symbolic/SymbExamples.v index 096c31da..c8748faa 100644 --- a/src/Symbolic/SymbExamples.v +++ b/src/Symbolic/SymbExamples.v @@ -33,7 +33,6 @@ Proof. destruct PreCond0. subst. destruct H. subst. clear H. rewrite Z2Nat.inj_sub;[|lia]. - Search Z.to_nat Z.pos. assert (Z.to_nat 1%Z = 1). { lia. } rewrite H. clear H. rewrite Z2Nat.inj_pos.