Showing preview only (2,031K chars total). Download the full file or copy to clipboard to get everything.
Repository: sifive/Kami
Branch: master
Commit: ffb77238f27b
Files: 66
Total size: 1.9 MB
Directory structure:
gitextract_xcclyzzt/
├── .gitignore
├── All.v
├── AllDefn.v
├── AllNotations.v
├── Compiler/
│ ├── Compiler.v
│ ├── CompilerDoubleWrites.v
│ ├── CompilerProps.v
│ ├── CompilerSimple.v
│ ├── CompilerSimpleProps.v
│ ├── CompilerSimpleSem.v
│ ├── Rtl.v
│ ├── Test.v
│ └── UnverifiedIncompleteCompiler.v
├── Extraction.v
├── GallinaModules/
│ ├── AuxLemmas.v
│ ├── AuxTactics.v
│ └── Relations.v
├── Guard.v
├── LICENSE
├── Lib/
│ ├── EclecticLib.v
│ ├── Fold.v
│ ├── HexNotation.v
│ ├── HexNotationWord.v
│ ├── NatStr.v
│ ├── VectorFacts.v
│ ├── Word.v
│ └── WordProperties.v
├── LibStruct.v
├── Makefile
├── Notations.v
├── NotationsTest.v
├── PPlusProperties.v
├── PProperties.v
├── Properties.v
├── README.adoc
├── Rewrites/
│ ├── Notations_rewrites.v
│ ├── ReflectionImpl.v
│ ├── ReflectionOrig.v
│ ├── ReflectionPre.v
│ ├── ReflectionSoundTheorems1.v
│ ├── ReflectionSoundTheorems2.v
│ └── ReflectionSoundTopTheorems.v
├── SignatureMatch.v
├── Simulator/
│ ├── CoqSim/
│ │ ├── Eval.v
│ │ ├── HaskellTypes.v
│ │ ├── Misc.v
│ │ ├── RegisterFile.v
│ │ ├── Simulator.v
│ │ └── TransparentProofs.v
│ ├── NativeTest.v
│ └── README.adoc
├── StateMonad.v
├── Syntax.v
├── SyntaxDoubleWrites.v
├── Tactics.v
├── Tutorial/
│ ├── ExtractEx.v
│ ├── GallinaActionEx.v
│ ├── PhoasEx.v
│ ├── SyntaxEx.v
│ └── TacticsEx.v
├── Utila.v
├── WfActionT.v
├── WfMod_Helper.v
├── _CoqProject
├── fixHaskell.sh
└── kami.el
================================================
FILE CONTENTS
================================================
================================================
FILE: .gitignore
================================================
*.cache
Lib/.*.aux
Lib/*.v.d
*.v.d
*.glob
Lib/*.glob
*.vo
*.vok
*.vos
Lib/*.vo
*.aux
Target.hs
../Target.hs
*.hi
*.o
Compiler/PrettyPrintVerilog
Compiler/CompAction
obj_dir
top.sv
*.vcd
*.mem
Makefile.coq.*
Makefile.coq
.coqdeps.d
*~
*.md
*.hs
FixLits
.*.swk
.*.swl
.*.swm
.*.swn
.*.swo
.*.swp
================================================
FILE: All.v
================================================
Require Export Kami.AllNotations.
(* N.b.: this module exports notations or things dependent on them *)
Require Export Kami.Extraction.
================================================
FILE: AllDefn.v
================================================
Require Export Kami.Lib.Word Kami.Lib.HexNotationWord Kami.Lib.Fold Kami.Lib.EclecticLib Kami.Utila RecordUpdate.RecordSet.
Require Export Kami.Lib.NatStr.
Require Export Kami.Syntax Kami.Properties Kami.PProperties Kami.PPlusProperties Kami.Tactics.
================================================
FILE: AllNotations.v
================================================
Require Export Kami.AllDefn.
Require Export Kami.Notations.
Require Export Kami.LibStruct.
Export Kami.Lib.Word.Notations.
Export ListNotations.
================================================
FILE: Compiler/Compiler.v
================================================
Require Import Kami.StateMonad Kami.Syntax Kami.Properties Kami.PProperties Kami.PPlusProperties Kami.Notations Kami.Lib.EclecticLib.
Import Word.Notations.
Require Import ZArith.
Set Implicit Arguments.
Set Asymmetric Patterns.
Section Compile.
Variable ty: Kind -> Type.
Variable regMapTy: Type.
Inductive RegMapExpr: Type :=
| VarRegMap (v: regMapTy): RegMapExpr
| UpdRegMap (r: string) (pred: Bool @# ty) (k: FullKind) (val: Expr ty k)
(regMap: RegMapExpr): RegMapExpr
| CompactRegMap (regMap: RegMapExpr): RegMapExpr.
Inductive CompActionT: Kind -> Type :=
| CompCall (f: string) (argRetK: Kind * Kind) (pred: Bool @# ty)
(arg: fst argRetK @# ty)
lret (cont: fullType ty (SyntaxKind (snd argRetK)) -> CompActionT lret): CompActionT lret
| CompLetExpr k (e: Expr ty k) lret (cont: fullType ty k -> CompActionT lret): CompActionT lret
| CompNondet k lret (cont: fullType ty k -> CompActionT lret): CompActionT lret
| CompSys (pred: Bool @# ty) (ls: list (SysT ty)) lret (cont: CompActionT lret): CompActionT lret
| CompRead (r: string) (k: FullKind) (readMap: RegMapExpr) lret (cont: fullType ty k -> CompActionT lret): CompActionT lret
| CompRet lret (e: lret @# ty) (newMap: RegMapExpr) : CompActionT lret
| CompLetFull k (a: CompActionT k) lret (cont: fullType ty (SyntaxKind k) -> regMapTy -> CompActionT lret): CompActionT lret
| CompAsyncRead (idxNum num : nat) (readPort dataArray writePort: string) (isWriteMask: bool)
(idx : Bit (Nat.log2_up idxNum) @# ty) (pred : Bool @# ty) (k : Kind) (writeMap readMap : RegMapExpr) lret
(cont : fullType ty (SyntaxKind (Array num k)) -> regMapTy -> CompActionT lret) : CompActionT lret
| CompWrite (idxNum num : nat) (writePort dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# ty) (Data : Kind) (val : Array num Data @# ty)
(mask : option (Array num Bool @# ty)) (pred : Bool @# ty) (writeMap readMap : RegMapExpr) lret
(cont : regMapTy -> CompActionT lret) : CompActionT lret
| CompSyncReadReq (idxNum num : nat) (readReq readReg dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# ty) (Data : Kind)
(isAddr : bool) (pred : Bool @# ty) (writeMap readMap : RegMapExpr) lret
(cont : regMapTy -> CompActionT lret) : CompActionT lret
| CompSyncReadRes (idxNum num : nat) (readResp readReg dataArray writePort : string) (isWriteMask: bool)
(Data : Kind) (isAddr : bool) (writeMap readMap : RegMapExpr) lret
(cont : fullType ty (SyntaxKind (Array num Data)) -> regMapTy -> CompActionT lret) : CompActionT lret.
Inductive EActionT (lretT : Kind) : Type :=
| EMCall (meth : string) s (e : Expr ty (SyntaxKind (fst s)))
(cont : (fullType ty (SyntaxKind (snd s))) -> EActionT lretT) : EActionT lretT
| ELetExpr (k : FullKind) (e : Expr ty k) (cont : fullType ty k -> EActionT lretT) : EActionT lretT
| ELetAction (k : Kind) (a : EActionT k) (cont : fullType ty (SyntaxKind k) -> EActionT lretT) : EActionT lretT
| EReadNondet (k : FullKind) (cont : fullType ty k -> EActionT lretT) : EActionT lretT
| EReadReg (r : string) (k : FullKind) (cont : fullType ty k -> EActionT lretT) : EActionT lretT
| EWriteReg (r : string) (k : FullKind) (e : Expr ty k) (cont : EActionT lretT) : EActionT lretT
| EIfElse : Expr ty (SyntaxKind Bool) -> forall k, EActionT k -> EActionT k -> (fullType ty (SyntaxKind k) -> EActionT lretT) -> EActionT lretT
| ESys (ls : list (SysT ty)) (cont : EActionT lretT) : EActionT lretT
| EReturn (e : Expr ty (SyntaxKind lretT)) : EActionT lretT
| EAsyncRead (idxNum num : nat) (readPort dataArray writePort : string) (isWriteMask: bool) (idx : Bit (Nat.log2_up idxNum) @# ty)
(k : Kind) (cont : fullType ty (SyntaxKind (Array num k)) -> EActionT lretT) : EActionT lretT
| EWrite (idxNum num : nat) (write dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# ty)
(Data : Kind) (val : Array num Data @# ty) (mask : option (Array num Bool @# ty))
(cont : EActionT lretT) : EActionT lretT
| ESyncReadReq (idxNum num : nat) (readReq readReg dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# ty)
(Data : Kind) (isAddr : bool) (cont : EActionT lretT) : EActionT lretT
| ESyncReadRes (idxNum num : nat) (readRes readReg dataArray writePort: string) (isWriteMask: bool) (Data : Kind) (isAddr : bool)
(cont : fullType ty (SyntaxKind (Array num Data)) -> EActionT lretT) : EActionT lretT.
Fixpoint Action_EAction (lretT : Kind) (a : ActionT ty lretT) : EActionT lretT :=
match a in ActionT _ _ with
| MCall meth k argExpr cont =>
EMCall meth k argExpr (fun v => Action_EAction (cont v))
| Return x =>
EReturn x
| LetExpr k' expr cont => ELetExpr expr (fun v => Action_EAction (cont v))
| ReadNondet k' cont => EReadNondet k' (fun ret => Action_EAction (cont ret))
| Sys ls cont => ESys ls (Action_EAction cont)
| ReadReg r k' cont => EReadReg r k' (fun v => Action_EAction (cont v))
| WriteReg r k' expr cont => EWriteReg r expr (Action_EAction cont)
| LetAction k' a' cont => ELetAction (Action_EAction a') (fun v => Action_EAction (cont v))
| IfElse pred' k' aT aF cont => EIfElse pred' (Action_EAction aT) (Action_EAction aF) (fun v => Action_EAction (cont v))
end.
Section ReadMap.
Variable readMap: regMapTy.
Fixpoint compileAction k (a: ActionT ty k) (pred: Bool @# ty)
(writeMap: RegMapExpr) {struct a}:
CompActionT k :=
match a in ActionT _ _ with
| MCall meth k argExpr cont =>
CompCall meth k pred argExpr (fun ret => @compileAction _ (cont ret) pred writeMap)
| Return x =>
CompRet x writeMap
| LetExpr k' expr cont => CompLetExpr expr (fun ret => @compileAction _ (cont ret) pred writeMap)
| ReadNondet k' cont => CompNondet k' (fun ret => @compileAction _ (cont ret) pred writeMap)
| Sys ls cont => CompSys pred ls (compileAction cont pred writeMap)
| ReadReg r k' cont =>
@CompRead r k' (VarRegMap readMap) _ (fun v => @compileAction _ (cont v) pred writeMap)
| WriteReg r k' expr cont =>
CompLetFull (CompRet ($$ WO)%kami_expr
(UpdRegMap r pred expr writeMap)) (fun _ v => @compileAction _ cont pred (VarRegMap v))
| LetAction k' a' cont =>
CompLetFull (@compileAction k' a' pred writeMap)
(fun retval writeMap' => @compileAction k (cont retval) pred (VarRegMap writeMap'))
| IfElse pred' k' aT aF cont =>
CompLetExpr
(pred && pred')%kami_expr
(fun truePred =>
CompLetExpr
(pred && !pred')%kami_expr
(fun falsePred =>
CompLetFull (@compileAction k' aT (#truePred)%kami_expr writeMap)
(fun valT writesT =>
CompLetFull (@compileAction k' aF (#falsePred)%kami_expr (VarRegMap writesT))
(fun valF writesF =>
CompLetExpr (IF pred' then #valT else #valF)%kami_expr
(fun val => (@compileAction k (cont val) pred (VarRegMap writesF)))
))))
end.
Fixpoint EcompileAction k (a : EActionT k) (pred : Bool @# ty)
(writeMap : RegMapExpr) {struct a} :
CompActionT k :=
match a in EActionT _ with
| EMCall meth k argExpr cont =>
CompCall meth k pred argExpr (fun ret => @EcompileAction _ (cont ret) pred writeMap)
| EReturn x =>
CompRet x writeMap
| ELetExpr k' expr cont => CompLetExpr expr (fun ret => @EcompileAction _ (cont ret) pred writeMap)
| EReadNondet k' cont => CompNondet k' (fun ret => @EcompileAction _ (cont ret) pred writeMap)
| ESys ls cont => CompSys pred ls (EcompileAction cont pred writeMap)
| EReadReg r k' cont =>
@CompRead r k' (VarRegMap readMap) _ (fun v => @EcompileAction _ (cont v) pred writeMap)
| EWriteReg r k' expr cont =>
CompLetFull (CompRet ($$ WO)%kami_expr
(UpdRegMap r pred expr writeMap)) (fun _ v => @EcompileAction _ cont pred (VarRegMap v))
| ELetAction k' a' cont =>
CompLetFull (@EcompileAction k' a' pred writeMap)
(fun retval writeMap' => @EcompileAction k (cont retval) pred (VarRegMap writeMap'))
| EIfElse pred' k' aT aF cont =>
CompLetExpr
(pred && pred')%kami_expr
(fun truePred =>
CompLetExpr
(pred && !pred')%kami_expr
(fun falsePred =>
CompLetFull (@EcompileAction k' aT (#truePred)%kami_expr writeMap)
(fun valT writesT =>
CompLetFull (@EcompileAction k' aF (#falsePred)%kami_expr (VarRegMap writesT))
(fun valF writesF =>
CompLetExpr (IF pred' then #valT else #valF)%kami_expr
(fun val => (@EcompileAction k (cont val) pred (VarRegMap writesF)))
))))
| EAsyncRead idxNum num readPort dataArray writePort isWriteMask idx k cont =>
CompAsyncRead idxNum readPort dataArray writePort isWriteMask idx pred writeMap (VarRegMap readMap)
(fun array writeMap' => @EcompileAction _ (cont array) pred (VarRegMap writeMap'))
| EWrite idxNum num writePort dataArray idx Data val mask cont =>
CompWrite idxNum writePort dataArray idx val mask pred writeMap (VarRegMap readMap)
(fun writeMap' => @EcompileAction _ cont pred (VarRegMap writeMap'))
| ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr cont =>
CompSyncReadReq idxNum num readReq readReg dataArray idx Data isAddr pred writeMap (VarRegMap readMap)
(fun writeMap' => @EcompileAction _ cont pred (VarRegMap writeMap'))
| ESyncReadRes idxNum num readResp readReg dataArray writePort isWriteMask Data isAddr cont =>
CompSyncReadRes idxNum readResp readReg dataArray writePort isWriteMask isAddr writeMap (VarRegMap readMap)
(fun array writeMap' => @EcompileAction _ (cont array) pred (VarRegMap writeMap'))
end.
Fixpoint inlineWriteFile k (rf : RegFileBase) (a : EActionT k) : EActionT k :=
match rf with
| @Build_RegFileBase _isWrMask _num _dataArray _readers _write _idxNum _Data _init =>
match a with
| EMCall g sign arg cont =>
match String.eqb _write g with
| true =>
if _isWrMask then
match Signature_dec sign (WriteRqMask (Nat.log2_up _idxNum) _num _Data, Void) with
| left isEq =>
let inValue := (match isEq in _ = Y return Expr ty (SyntaxKind (fst Y)) with | eq_refl => arg end) in
ELetExpr ($$ WO)%kami_expr
(fun v => EWrite _idxNum _write _dataArray (inValue @% "addr")%kami_expr (inValue @% "data")%kami_expr
(Some (inValue @% "mask")%kami_expr) (inlineWriteFile rf (match isEq in _ = Y return fullType ty (SyntaxKind (snd Y)) -> EActionT k with
| eq_refl => cont
end v)))
| right _ => EMCall g sign arg (fun ret => inlineWriteFile rf (cont ret))
end
else
match Signature_dec sign (WriteRq (Nat.log2_up _idxNum) (Array _num _Data), Void) with
| left isEq =>
let inValue := (match isEq in _ = Y return Expr ty (SyntaxKind (fst Y)) with | eq_refl => arg end) in
ELetExpr ($$ WO)%kami_expr
(fun v => EWrite _idxNum _write _dataArray (inValue @% "addr")%kami_expr (inValue @% "data")%kami_expr
None (inlineWriteFile rf (match isEq in _ = Y return fullType ty (SyntaxKind (snd Y)) -> EActionT k with
| eq_refl => cont
end v)))
| right _ => EMCall g sign arg (fun ret => inlineWriteFile rf (cont ret))
end
| false => EMCall g sign arg (fun ret => inlineWriteFile rf (cont ret))
end
| ELetExpr _ e cont => ELetExpr e (fun ret => inlineWriteFile rf (cont ret))
| ELetAction _ a cont => ELetAction (inlineWriteFile rf a) (fun ret => inlineWriteFile rf (cont ret))
| EReadNondet k c => EReadNondet k (fun ret => inlineWriteFile rf (c ret))
| EReadReg r k c => EReadReg r k (fun ret => inlineWriteFile rf (c ret))
| EWriteReg r k e a => EWriteReg r e (inlineWriteFile rf a)
| EIfElse p _ aT aF c => EIfElse p (inlineWriteFile rf aT) (inlineWriteFile rf aF) (fun ret => inlineWriteFile rf (c ret))
| ESys ls c => ESys ls (inlineWriteFile rf c)
| EReturn e => EReturn e
| EAsyncRead idxNum num readPort dataArray writePort isWriteMask idx k cont =>
EAsyncRead idxNum readPort dataArray writePort isWriteMask idx (fun ret => inlineWriteFile rf (cont ret))
| EWrite idxNum num writePort dataArray idx Data val mask cont =>
EWrite idxNum writePort dataArray idx val mask (inlineWriteFile rf cont)
| ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr cont =>
ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr (inlineWriteFile rf cont)
| ESyncReadRes idxNum num readResp readReg dataArray writePort isWriteMask Data isAddr cont =>
ESyncReadRes idxNum readResp readReg dataArray writePort isWriteMask isAddr (fun v => inlineWriteFile rf (cont v))
end
end.
Fixpoint inlineAsyncReadFile (read : string) (rf : RegFileBase) k (a : EActionT k) : EActionT k :=
match rf with
| @Build_RegFileBase _isWrMask _num _dataArray _readers _write _idxNum _Data _init =>
match _readers with
| Async reads =>
match (existsb (String.eqb read) reads) with
| true =>
match a with
| EMCall g sign arg cont =>
match String.eqb read g with
| true =>
match Signature_dec sign (Bit (Nat.log2_up _idxNum), Array _num _Data) with
| left isEq =>
let inValue := (match isEq in _ = Y return Expr ty (SyntaxKind (fst Y)) with | eq_refl => arg end) in
EAsyncRead _idxNum read _dataArray _write _isWrMask inValue
(fun array =>
inlineAsyncReadFile read rf (match isEq in _ = Y return
fullType ty (SyntaxKind (snd Y)) -> EActionT k with
| eq_refl => cont
end array))
| right _ => EMCall g sign arg (fun ret => inlineAsyncReadFile read rf (cont ret))
end
| false => EMCall g sign arg (fun ret => inlineAsyncReadFile read rf (cont ret))
end
| ELetExpr _ e cont => ELetExpr e (fun ret => inlineAsyncReadFile read rf (cont ret))
| ELetAction _ a cont => ELetAction (inlineAsyncReadFile read rf a) (fun ret => inlineAsyncReadFile read rf (cont ret))
| EReadNondet k c => EReadNondet k (fun ret => inlineAsyncReadFile read rf (c ret))
| EReadReg r k c => EReadReg r k (fun ret => inlineAsyncReadFile read rf (c ret))
| EWriteReg r k e a => EWriteReg r e (inlineAsyncReadFile read rf a)
| EIfElse p _ aT aF c => EIfElse p (inlineAsyncReadFile read rf aT) (inlineAsyncReadFile read rf aF) (fun ret => inlineAsyncReadFile read rf (c ret))
| ESys ls c => ESys ls (inlineAsyncReadFile read rf c)
| EReturn e => EReturn e
| EAsyncRead idxNum num readPort dataArray writePort isWriteMask idx k cont =>
EAsyncRead idxNum readPort dataArray writePort isWriteMask idx (fun ret => inlineAsyncReadFile read rf (cont ret))
| EWrite idxNum num writePort dataArray idx Data val mask cont =>
EWrite idxNum writePort dataArray idx val mask (inlineAsyncReadFile read rf cont)
| ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr cont =>
ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr (inlineAsyncReadFile read rf cont)
| ESyncReadRes idxNum num readResp readReg dataArray writePort isWriteMask Data isAddr cont =>
ESyncReadRes idxNum readResp readReg dataArray writePort isWriteMask isAddr (fun v => inlineAsyncReadFile read rf (cont v))
end
| false => a
end
| Sync _ _ => a
end
end.
Lemma SyncRead_eq_dec (r r' : SyncRead) :
{r = r'} + {r <> r'}.
Proof.
destruct (string_dec (readReqName r) (readReqName r')),
(string_dec (readResName r) (readResName r')),
(string_dec (readRegName r) (readRegName r')), r, r';
simpl in *; subst; auto; right; intro; inv H; auto.
Qed.
Definition SyncRead_eqb (r r' : SyncRead) : bool :=
(String.eqb (readReqName r) (readReqName r'))
&& (String.eqb (readResName r) (readResName r'))
&& (String.eqb (readRegName r) (readRegName r')).
Lemma SyncRead_eqb_eq (r r' : SyncRead) :
SyncRead_eqb r r' = true <-> r = r'.
Proof.
split; intros.
- unfold SyncRead_eqb in H.
repeat (apply andb_prop in H; dest; rewrite String.eqb_eq in *).
destruct r, r'; simpl in *; subst; auto.
- rewrite H.
unfold SyncRead_eqb; repeat rewrite eqb_refl; auto.
Qed.
Fixpoint inlineSyncResFile (read : SyncRead) (rf : RegFileBase) k (a : EActionT k) : EActionT k :=
match rf with
| @Build_RegFileBase _isWrMask _num _dataArray _readers _write _idxNum _Data _init =>
match read with
| @Build_SyncRead _readReqName _readResName _readRegName =>
match _readers with
| Async _ => a
| Sync isAddr reads =>
match (existsb (SyncRead_eqb read) reads) with
| true =>
match a with
| EMCall g sign arg cont =>
match String.eqb _readResName g with
| true =>
match Signature_dec sign (Void, Array _num _Data) with
| left isEq =>
ESyncReadRes _idxNum _readResName _readRegName _dataArray _write _isWrMask isAddr (fun array => inlineSyncResFile read rf (match isEq in _ = Y return fullType ty (SyntaxKind (snd Y)) -> EActionT k with | eq_refl => cont end array))
| right _ => EMCall g sign arg (fun ret => inlineSyncResFile read rf (cont ret))
end
| false => EMCall g sign arg (fun ret => inlineSyncResFile read rf (cont ret))
end
| ELetExpr _ e cont => ELetExpr e (fun ret => inlineSyncResFile read rf (cont ret))
| ELetAction _ a cont => ELetAction (inlineSyncResFile read rf a) (fun ret => inlineSyncResFile read rf (cont ret))
| EReadNondet k c => EReadNondet k (fun ret => inlineSyncResFile read rf (c ret))
| EReadReg r k c => EReadReg r k (fun ret => inlineSyncResFile read rf (c ret))
| EWriteReg r k e a => EWriteReg r e (inlineSyncResFile read rf a)
| EIfElse p _ aT aF c => EIfElse p (inlineSyncResFile read rf aT) (inlineSyncResFile read rf aF) (fun ret => inlineSyncResFile read rf (c ret))
| ESys ls c => ESys ls (inlineSyncResFile read rf c)
| EReturn e => EReturn e
| EAsyncRead idxNum num readPort dataArray writePort isWriteMask idx k cont =>
EAsyncRead idxNum readPort dataArray writePort isWriteMask idx (fun ret => inlineSyncResFile read rf (cont ret))
| EWrite idxNum num writePort dataArray idx Data val mask cont =>
EWrite idxNum writePort dataArray idx val mask (inlineSyncResFile read rf cont)
| ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr cont =>
ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr (inlineSyncResFile read rf cont)
| ESyncReadRes idxNum num readResp readReg dataArray writePort isWriteMask Data isAddr cont =>
ESyncReadRes idxNum readResp readReg dataArray writePort isWriteMask isAddr (fun v => inlineSyncResFile read rf (cont v))
end
| false => a
end
end
end
end.
Fixpoint inlineSyncReqFile (read : SyncRead) (rf : RegFileBase) k (a : EActionT k) : EActionT k :=
match rf with
| @Build_RegFileBase _isWrMask _num _dataArray _readers _write _idxNum _Data _init =>
match read with
| @Build_SyncRead _readReqName _readResName _readRegName =>
match _readers with
| Async _ => a
| Sync isAddr reads =>
match (existsb (SyncRead_eqb read) reads) with
| true =>
match a with
| EMCall g sign arg cont =>
match String.eqb _readReqName g with
| true =>
match Signature_dec sign (Bit (Nat.log2_up _idxNum), Void) with
| left isEq =>
let inValue := (match isEq in _ = Y return Expr ty (SyntaxKind (fst Y)) with | eq_refl => arg end) in
ELetExpr ($$ WO)%kami_expr
(fun v => ESyncReadReq _idxNum _num _readReqName _readRegName _dataArray inValue _Data isAddr (inlineSyncReqFile read rf (match isEq in _ = Y return fullType ty (SyntaxKind (snd Y)) -> EActionT k with
| eq_refl => cont
end v)))
| right _ => EMCall g sign arg (fun ret => inlineSyncReqFile read rf (cont ret))
end
| false => EMCall g sign arg (fun ret => inlineSyncReqFile read rf (cont ret))
end
| ELetExpr _ e cont => ELetExpr e (fun ret => inlineSyncReqFile read rf (cont ret))
| ELetAction _ a cont => ELetAction (inlineSyncReqFile read rf a) (fun ret => inlineSyncReqFile read rf (cont ret))
| EReadNondet k c => EReadNondet k (fun ret => inlineSyncReqFile read rf (c ret))
| EReadReg r k c => EReadReg r k (fun ret => inlineSyncReqFile read rf (c ret))
| EWriteReg r k e a => EWriteReg r e (inlineSyncReqFile read rf a)
| EIfElse p _ aT aF c => EIfElse p (inlineSyncReqFile read rf aT) (inlineSyncReqFile read rf aF) (fun ret => inlineSyncReqFile read rf (c ret))
| ESys ls c => ESys ls (inlineSyncReqFile read rf c)
| EReturn e => EReturn e
| EAsyncRead idxNum num readPort dataArray writePort isWriteMask idx k cont =>
EAsyncRead idxNum readPort dataArray writePort isWriteMask idx (fun ret => inlineSyncReqFile read rf (cont ret))
| EWrite idxNum num writePort dataArray idx Data val mask cont =>
EWrite idxNum writePort dataArray idx val mask (inlineSyncReqFile read rf cont)
| ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr cont =>
ESyncReadReq idxNum num readReq readReg dataArray idx Data isAddr (inlineSyncReqFile read rf cont)
| ESyncReadRes idxNum num readResp readReg dataArray writePort isWriteMask Data isAddr cont =>
ESyncReadRes idxNum readResp readReg dataArray writePort isWriteMask isAddr (fun v => inlineSyncReqFile read rf (cont v))
end
| false => a
end
end
end
end.
End ReadMap.
Definition getRegFileWrite (rf : RegFileBase) : DefMethT :=
match rf with
| @Build_RegFileBase isWrMask num dataArray _ write idxNum Data _ =>
writeRegFileFn isWrMask num dataArray write idxNum Data
end.
Definition getAsyncReads (rf : RegFileBase) (read : string) : DefMethT :=
(read,
existT MethodT (Bit (Nat.log2_up (rfIdxNum rf)), Array (rfNum rf) (rfData rf))
(buildNumDataArray (rfNum rf) (rfDataArray rf) (rfIdxNum rf) (rfData rf))).
Definition getSyncReq (rf : RegFileBase) (isAddr : bool) (read : SyncRead) : DefMethT :=
if isAddr
then
(readReqName read,
existT MethodT (Bit (Nat.log2_up (rfIdxNum rf)), Void)
(fun (ty : Kind -> Type) (idx : fullType ty (SyntaxKind (fst (Bit (Nat.log2_up (rfIdxNum rf)), Void)))) =>
(Write readRegName read : fst (Bit (Nat.log2_up (rfIdxNum rf)), Void) <-
Var ty (SyntaxKind (fst (Bit (Nat.log2_up (rfIdxNum rf)), Void))) idx; Ret
Const ty WO)%kami_action))
else
(readReqName read,
existT MethodT (Bit (Nat.log2_up (rfIdxNum rf)), Void)
(fun (ty : Kind -> Type) (idx : fullType ty (SyntaxKind (fst (Bit (Nat.log2_up (rfIdxNum rf)), Void)))) =>
(LETA vals : Array (rfNum rf) (rfData rf) <- buildNumDataArray (rfNum rf) (rfDataArray rf) (rfIdxNum rf) (rfData rf) ty idx;
Write readRegName read : Array (rfNum rf) (rfData rf) <- Var ty (SyntaxKind (Array (rfNum rf) (rfData rf))) vals;
Ret Const ty WO)%kami_action)).
Definition getSyncRes (rf : RegFileBase) (isAddr : bool) (read : SyncRead) : DefMethT :=
if isAddr
then
(readResName read,
existT MethodT (Void, Array (rfNum rf) (rfData rf))
(fun (ty : Kind -> Type) (_ : fullType ty (SyntaxKind (fst (Void, Array (rfNum rf) (rfData rf))))) =>
(Read name : Bit (Nat.log2_up (rfIdxNum rf)) <- readRegName read;
buildNumDataArray (rfNum rf) (rfDataArray rf) (rfIdxNum rf) (rfData rf) ty name)%kami_action))
else
(readResName read,
existT MethodT (Void, Array (rfNum rf) (rfData rf))
(fun (ty : Kind -> Type) (_ : fullType ty (SyntaxKind (fst (Void, Array (rfNum rf) (rfData rf))))) =>
(Read data : Array (rfNum rf) (rfData rf) <- readRegName read;
Ret Var ty (SyntaxKind (Array (rfNum rf) (rfData rf))) data)%kami_action)).
Definition inlineSingle_Flat_pos meths1 meths2 n :=
match nth_error meths1 n with
| Some f => map (inlineSingle_Meth f) meths2
| None => meths2
end.
Definition inlineSingle_pos k meths (a : ActionT ty k) n :=
match nth_error meths n with
| Some f => inlineSingle a f
| None => a
end.
Definition getEachRfMethod (rf : RegFileBase) : list DefMethT :=
(getRegFileWrite rf :: match (rfRead rf) with
| Async read => map (getAsyncReads rf) read
| Sync isAddr read => map (getSyncReq rf isAddr) read
++ map (getSyncRes rf isAddr) read
end).
Definition EgetRegFileMapMethods k (rf : RegFileBase) : list (EActionT k -> EActionT k) :=
(inlineWriteFile rf :: match (rfRead rf) with
| Async read => map (fun x => @inlineAsyncReadFile x rf k) read
| Sync isAddr read => map (fun x => @inlineSyncReqFile x rf k) read
++ map (fun x => @inlineSyncResFile x rf k) read
end).
Definition EeachRfMethodInliners k (lrf : list RegFileBase) : list (EActionT k -> EActionT k) :=
concat (map (fun rf => EgetRegFileMapMethods k rf) lrf).
Definition eachRfMethodInliners k (lrf : list RegFileBase) : list (ActionT ty k -> ActionT ty k) :=
(concat (map (fun rf => (map (fun f a' => @inlineSingle ty k a' f) (getRegFileMethods rf))) lrf)).
Definition apply_nth {A : Type} (lf : list (A -> A)) (a : A) (n : nat) :=
match nth_error lf n with
| Some f => f a
| None => a
end.
Definition preCompileRegFiles k (ea : EActionT k) (lrf : list RegFileBase) : EActionT k :=
fold_left (apply_nth (EeachRfMethodInliners k lrf)) (seq 0 (length (EeachRfMethodInliners k lrf))) ea.
Definition compileActions (readMap : regMapTy) (acts: list (ActionT ty Void)) :=
fold_left (fun acc a =>
CompLetFull acc (fun _ writeMap =>
(CompLetFull (CompRet ($$ WO)%kami_expr
(CompactRegMap (VarRegMap writeMap)))
(fun _ v => @compileAction v _ a ($$ true)%kami_expr (VarRegMap v))))) acts
(CompRet ($$ WO)%kami_expr (VarRegMap readMap)).
Definition compileActionsRf (readMap : regMapTy) (acts : list (ActionT ty Void)) (lrf : list RegFileBase) :=
fold_left (fun acc a =>
CompLetFull acc (fun _ writeMap =>
(CompLetFull (CompRet ($$ WO)%kami_expr
(CompactRegMap (VarRegMap writeMap)))
(fun _ v => @EcompileAction v _ (preCompileRegFiles (Action_EAction a) lrf) ($$ true)%kami_expr (VarRegMap v))))) acts
(CompRet ($$ WO)%kami_expr (VarRegMap readMap)).
Definition compileRules (readMap : regMapTy) (rules: list RuleT) :=
compileActions readMap (map (fun a => snd a ty) rules).
Definition compileRulesRf (readMap : regMapTy) (rules : list RuleT) (lrf : list RegFileBase) :=
compileActionsRf readMap (map (fun a => snd a ty) rules) lrf.
End Compile.
Section Semantics.
Local Notation UpdRegT := RegsT.
Local Notation UpdRegsT := (list UpdRegT).
Local Notation RegMapType := (RegsT * UpdRegsT)%type.
Section PriorityUpds.
Variable o: RegsT.
Inductive PriorityUpds: UpdRegsT -> RegsT -> Prop :=
| NoUpds: PriorityUpds nil o
| ConsUpds (prevUpds: UpdRegsT) (prevRegs: RegsT)
(prevCorrect: PriorityUpds prevUpds prevRegs)
(u: UpdRegT)
(curr: RegsT)
(currRegsTCurr: getKindAttr o = getKindAttr curr)
(Hcurr: forall s v, In (s, v) curr -> In (s, v) u \/ ((~ In s (map fst u)) /\ In (s, v) prevRegs))
fullU
(HFullU: fullU = u :: prevUpds):
PriorityUpds fullU curr.
Lemma prevPrevRegsTrue prevUpds:
forall prev, PriorityUpds prevUpds prev -> getKindAttr o = getKindAttr prev.
Proof.
induction 1; eauto.
Qed.
End PriorityUpds.
Inductive SemRegMapExpr: (RegMapExpr type RegMapType) -> RegMapType -> Prop :=
| SemVarRegMap v:
SemRegMapExpr (VarRegMap _ v) v
| SemUpdRegMapTrue r (pred: Bool @# type) k val regMap
(PredTrue: evalExpr pred = true)
old upds
(HSemRegMap: SemRegMapExpr regMap (old, upds))
upds'
(HEqual : upds' = (hd nil upds ++ ((r, existT _ k (evalExpr val)) :: nil)) :: tl upds):
SemRegMapExpr (@UpdRegMap _ _ r pred k val regMap) (old, upds')
| SemUpdRegMapFalse r (pred: Bool @# type) k val regMap
(PredTrue: evalExpr pred = false)
old upds
(HSemRegMap: SemRegMapExpr regMap (old, upds)):
SemRegMapExpr (@UpdRegMap _ _ r pred k val regMap) (old, upds)
| SemCompactRegMap old upds regMap (HSemRegMap: SemRegMapExpr regMap (old, upds)):
SemRegMapExpr (@CompactRegMap _ _ regMap) (old, nil::upds).
Definition WfRegMapExpr (regMapExpr : RegMapExpr type RegMapType) (regMap : RegMapType) :=
SemRegMapExpr regMapExpr regMap /\
let '(old, new) := regMap in
forall u, In u new -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old).
Inductive SemCompActionT: forall k, CompActionT type RegMapType k -> RegMapType -> MethsT -> type k -> Prop :=
| SemCompCallTrue (f: string) (argRetK: Kind * Kind) (pred: Bool @# type)
(arg: fst argRetK @# type)
lret (cont: fullType type (SyntaxKind (snd argRetK)) -> CompActionT _ _ lret)
(ret: fullType type (SyntaxKind (snd argRetK)))
regMap calls val newCalls
(HNewCalls : newCalls = (f, existT _ argRetK (evalExpr arg, ret)) :: calls)
(HSemCompActionT: SemCompActionT (cont ret) regMap calls val)
(HPred : evalExpr pred = true):
SemCompActionT (@CompCall _ _ f argRetK pred arg lret cont) regMap newCalls val
| SemCompCallFalse (f: string) (argRetK: Kind * Kind) (pred: Bool @# type)
(arg: fst argRetK @# type)
lret (cont: fullType type (SyntaxKind (snd argRetK)) -> CompActionT _ _ lret)
(ret: fullType type (SyntaxKind (snd argRetK)))
regMap calls val
(HSemCompActionT: SemCompActionT (cont ret) regMap calls val)
(HPred : evalExpr pred = false):
SemCompActionT (@CompCall _ _ f argRetK pred arg lret cont) regMap calls val
| SemCompLetExpr k e lret cont
regMap calls val
(HSemCompActionT: SemCompActionT (cont (evalExpr e)) regMap calls val):
SemCompActionT (@CompLetExpr _ _ k e lret cont) regMap calls val
| SemCompNondet k lret cont
ret regMap calls val
(HSemCompActionT: SemCompActionT (cont ret) regMap calls val):
SemCompActionT (@CompNondet _ _ k lret cont) regMap calls val
| SemCompSys pred ls lret cont
regMap calls val
(HSemCompActionT: SemCompActionT cont regMap calls val):
SemCompActionT (@CompSys _ _ pred ls lret cont) regMap calls val
| SemCompRead r k readMap lret cont
regMap calls val regVal
updatedRegs readMapValOld readMapValUpds
(HReadMap: SemRegMapExpr readMap (readMapValOld, readMapValUpds))
(HUpdatedRegs: PriorityUpds readMapValOld readMapValUpds updatedRegs)
(HIn: In (r, (existT _ k regVal)) updatedRegs)
(HSemCompActionT: SemCompActionT (cont regVal) regMap calls val):
SemCompActionT (@CompRead _ _ r k readMap lret cont) regMap calls val
| SemCompRet lret e regMap regMapVal calls
(HCallsNil : calls = nil)
(HRegMapWf: WfRegMapExpr regMap regMapVal):
SemCompActionT (@CompRet _ _ lret e regMap) regMapVal calls (evalExpr e)
| SemCompLetFull k a lret cont
regMap_a calls_a val_a
(HSemCompActionT_a: SemCompActionT a regMap_a calls_a val_a)
regMap_cont calls_cont val_cont newCalls
(HNewCalls : newCalls = calls_a ++ calls_cont)
(HSemCompActionT_cont: SemCompActionT (cont val_a regMap_a) regMap_cont calls_cont val_cont):
SemCompActionT (@CompLetFull _ _ k a lret cont) regMap_cont newCalls val_cont
| SemCompAsyncRead num (readPort dataArray writePort: string) isWriteMask idxNum (idx : Bit (Nat.log2_up idxNum) @# type) pred Data readMap lret
updatedRegs readMapValOld readMapValUpds regVal writeMap writeMapTy regMap
(HWriteMap: SemRegMapExpr writeMap writeMapTy)
(HReadMap : SemRegMapExpr readMap (readMapValOld, readMapValUpds))
(HUpdatedRegs : PriorityUpds readMapValOld readMapValUpds updatedRegs)
(HIn : In (dataArray, (existT _ (SyntaxKind (Array idxNum Data)) regVal)) updatedRegs)
cont calls val contArray
(HContArray : contArray =
BuildArray (fun i : Fin.t num =>
ReadArray
(Var type _ regVal)
(CABit Add (Var type (SyntaxKind _) (evalExpr idx) ::
Const type (natToWord _ (proj1_sig (Fin.to_nat i)))::nil))))
(HSemCompActionT : SemCompActionT (cont (evalExpr contArray) writeMapTy) regMap calls val):
SemCompActionT (@CompAsyncRead _ _ idxNum num readPort dataArray writePort isWriteMask idx pred Data writeMap readMap lret cont) regMap calls val
| SemCompWriteSome num (writePort dataArray : string) idxNum (idx : Bit (Nat.log2_up idxNum) @# type) Data (array : Array num Data @# type)
(optMask : option (Array num Bool @# type)) (writeMap readMap : RegMapExpr type RegMapType) lret mask
(HMask : optMask = Some mask)
updatedRegs readMapValOld readMapValUpds regVal
(HReadMap : SemRegMapExpr readMap (readMapValOld, readMapValUpds))
(HUpdatedRegs : PriorityUpds readMapValOld readMapValUpds updatedRegs)
(HIn : In (dataArray, (existT _ (SyntaxKind (Array idxNum Data)) regVal)) updatedRegs)
regMapVal pred
(HUpdate : WfRegMapExpr (UpdRegMap dataArray pred
(fold_left (fun newArr i =>
ITE
(ReadArrayConst mask i)
(UpdateArray newArr
(CABit Add (idx :: Const type (natToWord _ (proj1_sig (Fin.to_nat i)))
:: nil))
(ReadArrayConst array i))
newArr
) (getFins num)
(Var type (SyntaxKind (Array idxNum Data)) regVal))
writeMap) regMapVal)
cont regMap_cont calls val
(HSemCompActionT : SemCompActionT (cont regMapVal) regMap_cont calls val):
SemCompActionT (@CompWrite _ _ idxNum num writePort dataArray idx Data array optMask pred writeMap readMap lret cont) regMap_cont calls val
| SemCompWriteNone num (writePort dataArray : string) idxNum (idx : Bit (Nat.log2_up idxNum) @# type) Data (array : Array num Data @# type)
(optMask : option (Array num Bool @# type)) (writeMap readMap : RegMapExpr type RegMapType) lret
(HMask : optMask = None)
updatedRegs readMapValOld readMapValUpds regVal
(HReadMap : SemRegMapExpr readMap (readMapValOld, readMapValUpds))
(HUpdatedRegs : PriorityUpds readMapValOld readMapValUpds updatedRegs)
(HIn : In (dataArray, (existT _ (SyntaxKind (Array idxNum Data)) regVal)) updatedRegs)
regMapVal pred
(HUpdate : WfRegMapExpr (UpdRegMap dataArray pred
(fold_left (fun newArr i =>
(UpdateArray newArr
(CABit Add (idx :: Const type (natToWord _ (proj1_sig (Fin.to_nat i)))
:: nil))
(ReadArrayConst array i))
) (getFins num)
(Var type (SyntaxKind (Array idxNum Data)) regVal))
writeMap) regMapVal)
cont regMap_cont calls val
(HSemCompActionT : SemCompActionT (cont regMapVal) regMap_cont calls val):
SemCompActionT (@CompWrite _ _ idxNum num writePort dataArray idx Data array optMask pred writeMap readMap lret cont) regMap_cont calls val
| SemCompSyncReadReqTrue num idxNum readReqName readRegName dataArray (idx : Bit (Nat.log2_up idxNum) @# type) k (isAddr : bool)
(writeMap : RegMapExpr type RegMapType) readMap lret cont
regMapVal pred
(HisAddr : isAddr = true)
(HWriteMap : WfRegMapExpr (UpdRegMap readRegName pred (Var type (SyntaxKind _) (evalExpr idx)) writeMap) regMapVal)
regMap_cont calls val
(HSemCompActionT : SemCompActionT (cont regMapVal) regMap_cont calls val):
SemCompActionT (@CompSyncReadReq _ _ idxNum num readReqName readRegName dataArray idx k isAddr pred writeMap readMap lret cont) regMap_cont calls val
| SemCompSyncReadReqFalse num idxNum readReqName readRegName dataArray (idx : Bit (Nat.log2_up idxNum) @# type) Data (isAddr : bool)
(writeMap : RegMapExpr type RegMapType) readMap lret cont
regMapVal pred
(HisAddr : isAddr = false)
updatedRegs readMapValOld readMapValUpds regV
(HReadMap : SemRegMapExpr readMap (readMapValOld, readMapValUpds))
(HUpdatedRegs : PriorityUpds readMapValOld readMapValUpds updatedRegs)
(HRegVal : In (dataArray, (existT _ (SyntaxKind (Array idxNum Data)) regV)) updatedRegs)
(HWriteMap : WfRegMapExpr
(UpdRegMap readRegName pred
(BuildArray (fun i : Fin.t num =>
ReadArray
(Var type _ regV)
(CABit Add (Var type (SyntaxKind _) (evalExpr idx) ::
Const type (natToWord _ (proj1_sig (Fin.to_nat i)))::nil)))) writeMap) regMapVal)
regMap_cont calls val
(HSemCompActionT : SemCompActionT (cont regMapVal) regMap_cont calls val):
SemCompActionT (@CompSyncReadReq _ _ idxNum num readReqName readRegName dataArray idx Data isAddr pred writeMap readMap lret cont) regMap_cont calls val
| SemCompSyncReadResTrue num idxNum readRespName readRegName dataArray writePort isWriteMask Data isAddr writeMap readMap lret cont
(HisAddr : isAddr = true)
writeMapTy
updatedRegs readMapValOld readMapValUpds regVal idx
(HWriteMap: SemRegMapExpr writeMap writeMapTy)
(HReadMap : SemRegMapExpr readMap (readMapValOld, readMapValUpds))
(HUpdatedRegs : PriorityUpds readMapValOld readMapValUpds updatedRegs)
(HRegVal1 : In (readRegName, existT _ (SyntaxKind (Bit (Nat.log2_up idxNum))) idx) updatedRegs)
(HRegVal2 : In (dataArray, existT _ (SyntaxKind (Array idxNum Data)) regVal) updatedRegs)
(contArray : Expr type (SyntaxKind (Array num Data)))
(HContArray : contArray =
BuildArray (fun i : Fin.t num =>
ReadArray
(Var type _ regVal)
(CABit Add (Var type (SyntaxKind _) idx ::
Const type (natToWord _ (proj1_sig (Fin.to_nat i)))::nil))))
regMap calls val
(HSemCompActionT : SemCompActionT (cont (evalExpr contArray) writeMapTy) regMap calls val):
SemCompActionT (@CompSyncReadRes _ _ idxNum num readRespName readRegName dataArray writePort isWriteMask Data isAddr writeMap readMap lret cont) regMap calls val
| SemCompSyncReadResFalse num idxNum readRespName readRegName dataArray writePort isWriteMask Data isAddr writeMap writeMapTy readMap lret cont
(HisAddr : isAddr = false)
updatedRegs readMapValOld readMapValUpds regVal
(HWriteMap: SemRegMapExpr writeMap writeMapTy)
(HReadMap : SemRegMapExpr readMap (readMapValOld, readMapValUpds))
(HUpdatedRegs : PriorityUpds readMapValOld readMapValUpds updatedRegs)
(HIn1 : In (readRegName, (existT _ (SyntaxKind (Array num Data)) regVal)) updatedRegs)
regMap calls val
(HSemCompActionT : SemCompActionT (cont regVal writeMapTy) regMap calls val):
SemCompActionT (@CompSyncReadRes _ _ idxNum num readRespName readRegName dataArray writePort isWriteMask Data isAddr writeMap readMap lret cont) regMap calls val.
Variable (k : Kind) (a : CompActionT type RegMapType k) (regInits : list RegInitT).
Section Loop.
Variable f: RegsT -> CompActionT type RegMapType Void.
Inductive SemCompTrace: RegsT -> list UpdRegsT -> list MethsT -> Prop :=
| SemCompTraceInit (oInit : RegsT) (lupds : list UpdRegsT) (lcalls : list MethsT)
(HNoUpds : lupds = nil) (HNoCalls : lcalls = nil)
(HInitRegs : Forall2 regInit oInit regInits) :
SemCompTrace oInit lupds lcalls
| SemCompTraceCont (o o' : RegsT) (lupds lupds' : list UpdRegsT) (upds : UpdRegsT)
(lcalls lcalls' : list MethsT) (calls : MethsT) val
(HOldTrace : SemCompTrace o lupds lcalls)
(HSemAction : SemCompActionT (f o) (o, upds) calls val)
(HNewUpds : lupds' = upds :: lupds)
(HNewCalls : lcalls' = calls :: lcalls)
(HPriorityUpds : PriorityUpds o upds o') :
SemCompTrace o' lupds' lcalls'.
End Loop.
End Semantics.
Section EActionT_Semantics.
Variable o : RegsT.
Inductive UpdOrMeth : Type :=
| UmUpd : RegT -> UpdOrMeth
| UmMeth : MethT -> UpdOrMeth.
Definition UpdOrMeths := list UpdOrMeth.
Fixpoint UpdOrMeths_RegsT (uml : UpdOrMeths) : RegsT :=
match uml with
| um :: uml' =>
match um with
| UmUpd u => u :: (UpdOrMeths_RegsT uml')
| UmMeth _ => (UpdOrMeths_RegsT uml')
end
| nil => nil
end.
Fixpoint UpdOrMeths_MethsT (uml : UpdOrMeths) : MethsT :=
match uml with
| um :: uml' =>
match um with
| UmUpd _ => (UpdOrMeths_MethsT uml')
| UmMeth m => m :: (UpdOrMeths_MethsT uml')
end
| nil => nil
end.
Inductive ESemAction :
forall k, EActionT type k -> UpdOrMeths -> type k -> Prop :=
| ESemCall (meth : string) (s : Kind * Kind) (marg : Expr type (SyntaxKind (fst s))) (mret : type (snd s)) (retK : Kind)
(fret : type retK) (cont : type (snd s) -> EActionT type retK) (uml : UpdOrMeths) (auml : list UpdOrMeth)
(HNewList : auml = (UmMeth (meth, existT SignT s (evalExpr marg, mret)) :: uml))
(HESemAction : ESemAction (cont mret) uml fret) :
ESemAction (EMCall meth s marg cont) auml fret
| ESemLetExpr (k : FullKind) (e : Expr type k) (retK : Kind) (fret : type retK) (cont : fullType type k -> EActionT type retK)
(uml : UpdOrMeths) (HESemAction : ESemAction (cont (evalExpr e)) uml fret) :
ESemAction (ELetExpr e cont) uml fret
| ESemLetAction (k : Kind) (ea : EActionT type k) (v : type k) (retK : Kind) (fret : type retK) (cont : type k -> EActionT type retK)
(newUml : list UpdOrMeth) (newUmlCont : list UpdOrMeth)
(HDisjRegs : DisjKey (UpdOrMeths_RegsT newUml) (UpdOrMeths_RegsT newUmlCont)) (HESemAction : ESemAction ea newUml v)
(HESemActionCont : ESemAction (cont v) newUmlCont fret)
(uNewUml : UpdOrMeths)
(HNewUml : uNewUml = newUml ++ newUmlCont) :
ESemAction (ELetAction ea cont) uNewUml fret
| ESemReadNondet (valueT : FullKind) (valueV : fullType type valueT) (retK : Kind) (fret : type retK)
(cont : fullType type valueT -> EActionT type retK) (newUml : UpdOrMeths)
(HESemAction : ESemAction (cont valueV) newUml fret):
ESemAction (EReadNondet _ cont) newUml fret
| ESemReadReg (r : string) (regT : FullKind) (regV : fullType type regT) (retK : Kind) (fret : type retK) (cont : fullType type regT -> EActionT type retK)
(newUml : UpdOrMeths) (HRegVal : In (r, existT _ regT regV) o)
(HESemAction : ESemAction (cont regV) newUml fret) :
ESemAction (EReadReg r _ cont) newUml fret
| ESemWriteReg (r : string) (k : FullKind) (e : Expr type k) (retK : Kind) (fret : type retK) (cont : EActionT type retK)
(newUml : list UpdOrMeth) (anewUml : list UpdOrMeth)
(HRegVal : In (r, k) (getKindAttr o))
(HDisjRegs : key_not_In r (UpdOrMeths_RegsT newUml))
(HANewUml : anewUml = (UmUpd (r, existT _ _ (evalExpr e))) :: newUml)
(HESemAction : ESemAction cont newUml fret):
ESemAction (EWriteReg r e cont) anewUml fret
| ESemIfElseTrue (p : Expr type (SyntaxKind Bool)) (k1 : Kind) (ea ea' : EActionT type k1) (r1 : type k1) (k2 : Kind) (cont : type k1 -> EActionT type k2)
(newUml1 newUml2 : list UpdOrMeth) (r2 : type k2)
(HDisjRegs : DisjKey (UpdOrMeths_RegsT newUml1) (UpdOrMeths_RegsT newUml2))
(HTrue : evalExpr p = true)
(HEAction : ESemAction ea newUml1 r1)
(HESemAction : ESemAction (cont r1) newUml2 r2)
(unewUml : UpdOrMeths)
(HUNewUml : unewUml = newUml1 ++ newUml2) :
ESemAction (EIfElse p ea ea' cont) unewUml r2
| ESemIfElseFalse (p : Expr type (SyntaxKind Bool)) (k1 : Kind) (ea ea' : EActionT type k1) (r1 : type k1) (k2 : Kind) (cont : type k1 -> EActionT type k2)
(newUml1 newUml2 : list UpdOrMeth) (r2 : type k2)
(HDisjRegs : DisjKey (UpdOrMeths_RegsT newUml1) (UpdOrMeths_RegsT newUml2))
(HFalse : evalExpr p = false)
(HEAction : ESemAction ea' newUml1 r1)
(HESemAction : ESemAction (cont r1) newUml2 r2)
(unewUml : UpdOrMeths)
(HUNewUml : unewUml = newUml1 ++ newUml2) :
ESemAction (EIfElse p ea ea' cont) unewUml r2
| ESemSys (ls : list (SysT type)) (k : Kind) (cont : EActionT type k) (r : type k) (newUml : UpdOrMeths)
(HESemAction : ESemAction cont newUml r) :
ESemAction (ESys ls cont) newUml r
| ESemReturn (k : Kind) (e : Expr type (SyntaxKind k)) (evale : fullType type (SyntaxKind k))
(HEvalE : evale = evalExpr e)
(newUml : UpdOrMeths)
(HNewUml : newUml = nil) :
ESemAction (EReturn e) newUml evale
| ESemAsyncRead (idxNum num : nat) (readPort dataArray : string) writePort isWriteMask (idx : Bit (Nat.log2_up idxNum) @# type) (Data : Kind) (retK : Kind) (fret : type retK)
(newUml : UpdOrMeths) (regV : fullType type (SyntaxKind (Array idxNum Data)))
(HRegVal : In (dataArray, (existT _ (SyntaxKind (Array idxNum Data)) regV)) o)
(cont : type (Array num Data) -> EActionT type retK)
(contArray : Expr type (SyntaxKind (Array num Data)))
(HContArray : contArray =
BuildArray (fun i : Fin.t num =>
ReadArray
(Var type _ regV)
(CABit Add (Var type (SyntaxKind _) (evalExpr idx) ::
Const type (natToWord _ (proj1_sig (Fin.to_nat i)))::nil))))
(HESemAction : ESemAction (cont (evalExpr contArray)) newUml fret):
ESemAction (EAsyncRead idxNum num readPort dataArray writePort isWriteMask idx Data cont) newUml fret
| ESemWriteSome (idxNum num : nat) (writePort dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# type) (Data : Kind) (array : Array num Data @# type)
(optMask : option (Array num Bool @# type)) (retK : Kind) (fret : type retK) (cont : EActionT type retK) (newUml : UpdOrMeths)
(anewUml : list UpdOrMeth) (regV : fullType type (SyntaxKind (Array idxNum Data))) (mask : Array num Bool @# type)
(HRegVal : In (dataArray, (existT _ (SyntaxKind (Array idxNum Data)) regV)) o)
(HMask : optMask = Some mask)
(HANewUml : anewUml =
(UmUpd (dataArray, existT _ _
(evalExpr (fold_left (fun newArr i =>
ITE
(ReadArrayConst mask i)
(UpdateArray newArr
(CABit Add (idx :: Const type (natToWord _ (proj1_sig (Fin.to_nat i)))
:: nil))
(ReadArrayConst array i))
newArr
) (getFins num)
(Var type (SyntaxKind (Array idxNum Data)) regV))))) :: newUml)
(HDisjRegs : key_not_In dataArray (UpdOrMeths_RegsT newUml))
(HESemAction : ESemAction cont newUml fret) :
ESemAction (EWrite idxNum writePort dataArray idx array optMask cont) anewUml fret
| ESemWriteNone (idxNum num : nat) (writePort dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# type) (Data : Kind) (array : Array num Data @# type)
(optMask : option (Array num Bool @# type)) (retK : Kind) (fret : type retK) (cont : EActionT type retK) (newUml : UpdOrMeths)
(anewUml : list UpdOrMeth) (regV : fullType type (SyntaxKind (Array idxNum Data)))
(HRegVal : In (dataArray, (existT _ (SyntaxKind (Array idxNum Data)) regV)) o)
(HMask : optMask = None)
(HANewUml : anewUml =
(UmUpd (dataArray, existT _ _
(evalExpr (fold_left (fun newArr i =>
(UpdateArray newArr
(CABit Add (idx :: Const type (natToWord _ (proj1_sig (Fin.to_nat i)))
:: nil))
(ReadArrayConst array i))
) (getFins num)
(Var type (SyntaxKind (Array idxNum Data)) regV))))) :: newUml)
(HDisjRegs : key_not_In dataArray (UpdOrMeths_RegsT newUml))
(HESemAction : ESemAction cont newUml fret) :
ESemAction (EWrite idxNum writePort dataArray idx array optMask cont) anewUml fret
| ESemSyncReadReqTrue (idxNum num : nat) (readReqName readRegName dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# type) (Data : Kind) (isAddr : bool)
(retK : Kind) (fret : type retK) (cont : EActionT type retK) (newUml : UpdOrMeths) (anewUml : list UpdOrMeth)
(HisAddr : isAddr = true)
(HRegVal : In (readRegName, (SyntaxKind (Bit (Nat.log2_up idxNum)))) (getKindAttr o))
(HDisjRegs : key_not_In readRegName (UpdOrMeths_RegsT newUml))
(HANewUml : anewUml = (UmUpd (readRegName, existT _ _ (evalExpr idx))) :: newUml)
(HESemAction : ESemAction cont newUml fret):
ESemAction (ESyncReadReq idxNum num readReqName readRegName dataArray idx Data isAddr cont) anewUml fret
| ESemSyncReadReqFalse (idxNum num : nat) (readReqName readRegName dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# type) (Data : Kind) (isAddr : bool)
(retK : Kind) (fret : type retK) (cont : EActionT type retK) (newUml : UpdOrMeths) (anewUml : list UpdOrMeth)
(regV : fullType type (SyntaxKind (Array idxNum Data)))
(HisAddr : isAddr = false)
(HRegVal1 : In (readRegName, (SyntaxKind (Array num Data))) (getKindAttr o))
(HRegVal2 : In (dataArray, (existT _ (SyntaxKind (Array idxNum Data)) regV)) o)
(HDisjRegs : key_not_In readRegName (UpdOrMeths_RegsT newUml))
(HANewUml : anewUml =
(UmUpd (readRegName, existT _ _
(evalExpr
(BuildArray (fun i : Fin.t num =>
ReadArray
(Var type _ regV)
(CABit Add (Var type (SyntaxKind _) (evalExpr idx) ::
Const type (natToWord _ (proj1_sig (Fin.to_nat i)))::nil))))))) :: newUml)
(HESemAction : ESemAction cont newUml fret):
ESemAction (ESyncReadReq idxNum num readReqName readRegName dataArray idx Data isAddr cont) anewUml fret
| ESemSyncReadResTrue (idxNum num : nat) (readRespName readRegName dataArray : string) writePort isWriteMask (Data : Kind) (isAddr : bool) (retK : Kind) (fret : type retK)
(regVal : fullType type (SyntaxKind (Array idxNum Data))) (idx : fullType type (SyntaxKind (Bit (Nat.log2_up idxNum))))
(cont : type (Array num Data) -> EActionT type retK)
(HisAddr : isAddr = true)
(HRegVal1 : In (readRegName, existT _ (SyntaxKind (Bit (Nat.log2_up idxNum))) idx) o)
(HRegVal2 : In (dataArray, existT _ (SyntaxKind (Array idxNum Data)) regVal) o)
(contArray : Expr type (SyntaxKind (Array num Data)))
(HContArray : contArray =
BuildArray (fun i : Fin.t num =>
ReadArray
(Var type _ regVal)
(CABit Add (Var type (SyntaxKind _) idx ::
Const type (natToWord _ (proj1_sig (Fin.to_nat i)))::nil))))
(newUml : UpdOrMeths)
(HESemAction : ESemAction (cont (evalExpr contArray)) newUml fret):
ESemAction (ESyncReadRes idxNum num readRespName readRegName dataArray writePort isWriteMask Data isAddr cont) newUml fret
| ESemSyncReadResFalse (idxNum num : nat) (readRespName readRegName dataArray : string) writePort isWriteMask (Data : Kind) (isAddr : bool) (retK : Kind) (fret : type retK)
(regVal : fullType type (SyntaxKind (Array num Data))) (cont : type (Array num Data) -> EActionT type retK)
(HisAddr : isAddr = false)
(HRegVal : In (readRegName, existT _ (SyntaxKind (Array num Data)) regVal) o)
(newUml : UpdOrMeths)
(HESemAction : ESemAction (cont regVal) newUml fret):
ESemAction (ESyncReadRes idxNum num readRespName readRegName dataArray writePort isWriteMask Data isAddr cont) newUml fret.
End EActionT_Semantics.
================================================
FILE: Compiler/CompilerDoubleWrites.v
================================================
Require Import Kami.SyntaxDoubleWrites Kami.Compiler.Compiler Kami.Compiler.CompilerProps Kami.Syntax Kami.Properties Kami.PProperties Kami.PPlusProperties Kami.Lib.EclecticLib Kami.Notations.
Set Implicit Arguments.
Set Asymmetric Patterns.
Section DoubleWritesProof.
Lemma NoDupAppSplit {A : Type} (l l' : list A) :
NoDup (l++l') ->
forall a,
In a l ->
~ In a l'.
Proof.
induction l'.
- intros.
unfold not.
intros.
inversion H1.
- intros.
unfold not.
intros.
specialize (NoDup_remove _ _ _ H) as P0.
destruct P0.
inv H1.
apply H3.
rewrite in_app_iff.
left.
assumption.
specialize (NoDup_remove _ _ _ H) as P0.
destruct P0.
eapply IHl'.
assumption.
apply H0.
apply H4.
Qed.
Lemma getKindAttr_consistent (k : Kind) (a : ActionT type k) (o : RegsT):
forall newRegs readRegs calls retl,
SemActionDoubleWrites o a readRegs newRegs calls retl ->
SubList (getKindAttr newRegs) (getKindAttr o).
Proof.
induction a; simpl in *; intros.
- inv H0; EqDep_subst; eapply H; eauto.
- inv H0; EqDep_subst; eapply H; eauto.
- inv H0; EqDep_subst.
rewrite map_app, SubList_app_l_iff; split.
+ eapply IHa; eauto.
+ eapply H; eauto.
- inv H0; EqDep_subst; eapply H; eauto.
- inv H0; EqDep_subst; eapply H; eauto.
- inv H; EqDep_subst.
repeat intro.
simpl in *.
destruct H; subst; auto.
eapply IHa; eauto.
- inv H0; EqDep_subst.
+ rewrite map_app, SubList_app_l_iff.
split.
* eapply IHa1; eauto.
* eapply H; eauto.
+ rewrite map_app, SubList_app_l_iff.
split.
* eapply IHa2; eauto.
* eapply H; eauto.
- inv H; EqDep_subst.
eapply IHa; eauto.
- inv H; EqDep_subst.
simpl in *.
unfold SubList. intros. inversion H.
Qed.
Lemma CheckOnNewUpds (k : Kind) (a : ActionT type k) (o : RegsT):
forall writeMap upds' calls retl upds old,
SemRegMapExpr writeMap (old, upds) ->
SemCompActionT (compileAction (o,nil) a (Const type true) writeMap) (old, upds') calls retl ->
forall u, In u upds' -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old).
Proof.
induction a; intros; simpl in *; eauto.
(* Meth Call *)
- inv H1; EqDep_subst.
* eapply H. apply H0. apply HSemCompActionT. assumption.
* eapply H. apply H0. apply HSemCompActionT. assumption.
(* Let Expr *)
- inv H1; EqDep_subst.
eapply H. apply H0. apply HSemCompActionT. assumption.
(* Let Action *)
- inv H1; EqDep_subst.
destruct regMap_a.
assert (old = r).
{ eapply SameOldAction.
apply H0.
apply HSemCompActionT_a.
}
rewrite <- H1 in HSemCompActionT_a.
specialize (IHa _ _ _ _ _ _ H0 HSemCompActionT_a).
assert (SemRegMapExpr (VarRegMap type (old, l)) (old,l)) as P0.
{
econstructor.
}
rewrite <- H1 in HSemCompActionT_cont.
specialize (H _ _ _ _ _ _ _ P0 HSemCompActionT_cont).
split.
* apply H. assumption.
* apply H. assumption.
(* Non Det *)
- inv H1; EqDep_subst.
eapply H. apply H0. apply HSemCompActionT. apply H2.
(* Read *)
- inv H1; EqDep_subst.
eapply H. apply H0. apply HSemCompActionT. apply H2.
(* Write *)
- inv H0; simpl in *; EqDep_subst.
assert (val_a = evalExpr (Const type WO)) as P0.
{rewrite (unique_word_0 val_a); auto. }
subst.
inversion HSemCompActionT_a; EqDep_subst.
destruct regMap_a.
assert (r0 = old).
{
- inv HRegMapWf.
inv H0. EqDep_subst.
* specialize (SemVarRegMap
(r0, (hd nil upds0 ++
(r, existT (fullType type) k (evalExpr e)) :: nil) :: tl upds0)) as P0.
eapply SameOldAction.
apply P0.
apply HSemCompActionT_cont.
* discriminate.
}
assert (SemRegMapExpr (VarRegMap type (r0, l)) (r0, l)) as P1.
{ econstructor. }
rewrite <- H0 in HSemCompActionT_cont.
specialize (IHa _ _ _ _ _ _ P1 HSemCompActionT_cont).
rewrite -> H0 in IHa. apply IHa. assumption.
(* If-else *)
- inv H1; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inversion HSemCompActionT_cont; simpl in *; EqDep_subst.
inversion HSemCompActionT_cont0; simpl in *; EqDep_subst.
remember (evalExpr e) as P0.
destruct P0; simpl in *.
* assert (forall b, (evalExpr (Var type (SyntaxKind Bool) b)) = evalExpr (Const type b)) as P4; auto.
specialize (SemCompActionEquivBexpr _ _ _ _ _ (P4 true) HSemCompActionT_a) as P6.
rewrite <- HeqP0 in *; simpl in HSemCompActionT.
destruct regMap_a0.
assert (r = old).
{
* specialize (SemVarRegMap (r, l)) as P0.
eapply SameOldAction.
apply P0.
apply HSemCompActionT.
}
assert (SemRegMapExpr (VarRegMap type (r, l)) (r, l)) as P5.
{ econstructor. }
rewrite <- H1 in HSemCompActionT.
specialize (H _ _ _ _ _ _ _ P5 HSemCompActionT).
rewrite -> H1 in H.
apply H. assumption.
* assert (forall b, (evalExpr (Var type (SyntaxKind Bool) b)) = evalExpr (Const type b)) as P4; auto.
specialize (SemCompActionEquivBexpr _ _ _ _ _ (P4 true) HSemCompActionT_a0) as P6.
destruct regMap_a0.
assert (r = old).
{
* specialize (SemVarRegMap (r, l)) as P0.
eapply SameOldAction.
apply P0.
apply HSemCompActionT.
}
assert (SemRegMapExpr (VarRegMap type (r, l)) (r, l)) as P5.
{ econstructor. }
rewrite <- H1 in HSemCompActionT.
specialize (H _ _ _ _ _ _ _ P5 HSemCompActionT).
rewrite -> H1 in H.
apply H. assumption.
(* Sys *)
- inv H0; EqDep_subst.
eapply IHa. apply H. apply HSemCompActionT. assumption.
(* Ret *)
- inv H0; EqDep_subst.
unfold WfRegMapExpr in HRegMapWf.
destruct HRegMapWf.
apply H2. assumption.
Qed.
Lemma getRegisterValue (k : FullKind) (o : RegsT):
forall r,
In (r, k) (getKindAttr o) ->
exists v,
In (r, existT (fullType type) k v) o.
Proof.
intros. simpl in *.
rewrite in_map_iff in H.
dest. inv H.
destruct x; subst.
destruct s0; subst. simpl in *.
exists f; auto.
Qed.
Lemma FalseSemCompAction (k : Kind) (a : ActionT type k) (o oInit : RegsT) uInit (m : BaseModule):
forall regMap regMapExpr (bexpr : Bool @# type) (WfRegMap : WfRegMapExpr regMapExpr regMap) (HPriorityUpds : PriorityUpds oInit uInit o) ,
getKindAttr o = getKindAttr (getRegisters m) ->
getKindAttr oInit = getKindAttr (getRegisters m) ->
WfActionT (getRegisters m) a ->
evalExpr bexpr = false ->
exists retl,
SemCompActionT (compileAction (oInit,uInit) a bexpr regMapExpr) regMap nil retl.
Proof.
induction a; simpl in *; subst.
- (* Meth Call *)
intros.
inversion H2; EqDep_subst.
specialize (H6 (evalConstT (getDefaultConst (snd s)))).
specialize (H (evalConstT (getDefaultConst (snd s))) _ _ _ WfRegMap HPriorityUpds H0 H1 H6 H3).
destruct H.
exists x.
econstructor 2. eapply H. assumption.
- (* Let expr *)
intros.
inversion H2; EqDep_subst.
specialize (H6 (evalExpr e)).
specialize (H (evalExpr e) _ _ _ WfRegMap HPriorityUpds H0 H1 H6 H3).
destruct H.
exists x.
econstructor. assumption.
- (* Let Action *)
intros.
inversion H2; EqDep_subst.
specialize (IHa _ _ _ WfRegMap HPriorityUpds H0 H1 H7 H3).
destruct IHa.
assert (WfRegMapExpr (VarRegMap type regMap) regMap).
{
unfold WfRegMapExpr in *; split; eauto.
constructor.
destruct WfRegMap. assumption.
}
specialize (H9 x).
specialize (H x _ _ _ H5 HPriorityUpds H0 H1 H9 H3).
destruct H. exists x0.
rewrite <- (app_nil_r (nil : MethsT)).
econstructor; eauto.
- (* Non Det *)
intros.
inversion H2; EqDep_subst.
specialize (H6 (evalConstFullT (getDefaultConstFullKind k))).
specialize (H (evalConstFullT (getDefaultConstFullKind k)) _ _ _ WfRegMap HPriorityUpds H0 H1 H6 H3).
destruct H.
exists x.
econstructor.
apply H.
-(* Read *)
intros.
inversion H2; EqDep_subst.
specialize (getRegisterValue); intros.
change (fun x0 : FullKind => RegInitValT x0) with RegInitValT in H9.
rewrite <- H0 in H9.
specialize (H4 _ _ _ H9).
destruct H4.
specialize (H7 x).
specialize (H x _ _ _ WfRegMap HPriorityUpds H0 H1 H7 H3).
destruct H. exists x0.
econstructor; eauto.
constructor.
-(* Write *)
intros.
assert (WfRegMapExpr (VarRegMap type regMap) regMap).
{
unfold WfRegMapExpr in *; split; eauto.
constructor.
destruct WfRegMap. assumption.
}
inversion H1; EqDep_subst.
specialize (IHa _ _ _ H3 HPriorityUpds H H0 H7 H2).
destruct IHa.
exists x. simpl in *.
rewrite <- (app_nil_r (nil : MethsT)).
econstructor. econstructor. reflexivity.
unfold WfRegMapExpr in *; dest; repeat split; eauto.
destruct regMap.
econstructor 3; eauto.
reflexivity.
assumption.
-(* If-else *)
intros.
assert ((evalExpr (bexpr && !e)%kami_expr = evalExpr bexpr)) as P1.
{ simpl. rewrite -> H3. simpl. destruct (evalExpr e). simpl. reflexivity.
reflexivity. }
assert ((evalExpr (bexpr && e)%kami_expr = false)) as P2.
{ simpl. rewrite -> H3. simpl. reflexivity. }
inversion H2; EqDep_subst.
specialize (IHa1 _ _ _ WfRegMap HPriorityUpds H0 H1 H11 H3).
destruct IHa1.
assert (WfRegMapExpr (VarRegMap type regMap) regMap).
{
unfold WfRegMapExpr in *; split; eauto.
constructor.
destruct WfRegMap. assumption.
}
rewrite -> H3 in P1.
specialize (IHa2 _ _ _ H5 HPriorityUpds H0 H1 H12 P2).
remember (evalExpr e) as P0.
destruct IHa2.
destruct P0.
* specialize (H8 x).
specialize (H x _ _ _ H5 HPriorityUpds H0 H1 H8 P2).
destruct H.
exists x1. rewrite <- (app_nil_r (nil : MethsT)).
do 3 econstructor. simpl in *.
apply SemCompActionEquivBexpr with (bexpr1 := bexpr).
simpl. rewrite -> H3. simpl. reflexivity.
apply H4.
reflexivity.
rewrite <- (app_nil_r (nil : MethsT)).
econstructor.
apply SemCompActionEquivBexpr with (bexpr1 := (bexpr && e)%kami_expr).
simpl. rewrite -> H3. simpl. reflexivity.
apply H6.
reflexivity.
simpl. econstructor. simpl.
rewrite <- HeqP0.
apply SemCompActionEquivBexpr with (bexpr1 := (bexpr && e)%kami_expr).
simpl. rewrite -> H3. simpl. reflexivity.
apply H.
* specialize (H8 x0).
specialize (H x0 _ _ _ H5 HPriorityUpds H0 H1 H8 P2).
destruct H.
exists x1. rewrite <- (app_nil_r (nil : MethsT)).
do 3 econstructor. simpl in *.
apply SemCompActionEquivBexpr with (bexpr1 := bexpr).
simpl. rewrite -> H3. simpl. reflexivity.
apply H4.
reflexivity.
rewrite <- (app_nil_r (nil : MethsT)).
econstructor.
apply SemCompActionEquivBexpr with (bexpr1 := (bexpr && e)%kami_expr).
simpl. rewrite -> H3. simpl. reflexivity.
apply H6.
reflexivity.
simpl. econstructor. simpl.
rewrite <- HeqP0.
apply SemCompActionEquivBexpr with (bexpr1 := (bexpr && e)%kami_expr).
simpl. rewrite -> H3. simpl. reflexivity.
apply H.
- (* Sys *)
intros.
inversion H1; EqDep_subst.
specialize (IHa _ _ _ WfRegMap HPriorityUpds H H0 H5 H2).
destruct IHa.
exists x. econstructor. apply H3.
- (* Ret *)
intros.
inversion H1; EqDep_subst.
exists (evalExpr e).
econstructor. reflexivity.
assumption.
Qed.
Lemma EquivActionNoDupWritesNew (k : Kind) (a : ActionT type k) (o oInit: RegsT) uInit (m : BaseModule)
(HoInitNoDups : NoDup (map fst oInit))
(HuInitNoDups : forall u, In u uInit -> NoDup (map fst u))
(HPriorityUpds : PriorityUpds oInit uInit o)
(HOgetReg : getKindAttr o = getKindAttr (getRegisters m)) :
forall newRegs readRegs calls retl,
SemActionDoubleWrites o a readRegs newRegs calls retl ->
NoDup (map fst newRegs) ->
getKindAttr oInit = getKindAttr (getRegisters m) ->
WfActionT (getRegisters m) a ->
forall old writeMap upds
(HConsistent: getKindAttr o = getKindAttr old)
(HCheck : forall s, In s (map fst newRegs) -> ~ In s (map fst (hd nil upds))),
SemRegMapExpr writeMap (old, upds) ->
(forall u, In u upds -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old)) ->
exists upds',
(upds' = (old, match newRegs with
|nil => upds
|_ :: _ => (hd nil upds ++ newRegs) :: tl upds
end)) /\
SemCompActionT (compileAction (oInit, uInit) a (Const type true) writeMap) upds' calls retl.
Proof.
induction a; subst; intros; simpl in *.
- (* Meth Call *)
inv H0; EqDep_subst.
inv H3; EqDep_subst.
specialize (H7 mret).
specialize (H _ _ _ _ _ HSemAction H1 H2 H7 _ _ _ HConsistent HCheck H4 H5); dest.
exists x. split.
* assumption.
* econstructor; eauto.
- (* Let expr *)
inv H0; EqDep_subst.
inv H3; EqDep_subst.
specialize (H7 (evalExpr e)).
specialize (H _ _ _ _ _ HSemAction H1 H2 H7 _ _ _ HConsistent HCheck H4 H5); dest.
exists x. split.
* assumption.
* econstructor; eauto.
- (* Let Action *)
inv H0; EqDep_subst.
rewrite map_app, NoDup_app_iff in H1; dest.
assert ( forall s, In s (map fst (newRegs0)) -> ~ In s (map fst (hd nil upds))) as P0.
{
intros.
apply HCheck.
rewrite map_app. apply in_or_app.
left. assumption. }
inv H3; EqDep_subst.
specialize (H13 v).
specialize (IHa _ _ _ _ HSemAction H0 H2 H11 _ _ _ HConsistent P0 H4 H5); dest.
destruct x.
assert (SemRegMapExpr (VarRegMap type (l, l0)) (l, l0)).
apply SemVarRegMap.
assert (forall u, In u l0 -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old) ) as P1.
{
split. inv H3; simpl in *; subst.
destruct newRegs0; auto.
simpl in *. apply H5. assumption.
simpl in *. destruct H10; auto. subst.
rewrite map_app. rewrite NoDup_app_iff; simpl in *; repeat split.
* destruct upds; simpl in *. constructor.
eapply H5. left. reflexivity.
* assumption.
* intros;subst.
unfold not. intro. destruct H10.
subst. eapply HCheck. left. reflexivity.
assumption.
eapply HCheck. right. rewrite map_app.
eapply in_or_app. left. apply H10.
assumption.
* intros; subst.
unfold not. intro. destruct H3; subst.
eapply HCheck. left. reflexivity.
assumption.
eapply HCheck. right. rewrite map_app.
eapply in_or_app. left. apply H3.
assumption.
* eapply H5. simpl in *.
destruct upds. inversion H3.
simpl in H6. simpl in *. right. assumption.
* inv H3; subst.
destruct newRegs0. apply H5. assumption.
destruct upds. simpl in *.
destruct H10; [|contradiction]; subst.
specialize getKindAttr_consistent as P1.
rewrite <- HConsistent.
specialize (P1 _ a o (p :: newRegs0) readRegs0 calls0 v HSemAction).
assumption.
simpl in *.
destruct H10; subst.
rewrite map_app. rewrite SubList_app_l_iff; split; auto.
apply H5. left. reflexivity.
specialize getKindAttr_consistent as P1.
rewrite <- HConsistent.
specialize (P1 _ a o (p :: newRegs0) readRegs0 calls0 v HSemAction).
assumption.
apply H5. right. assumption. }
inversion H3; subst; simpl in *.
assert (forall s, In s (map fst (newRegsCont)) -> ~ In s (map fst (hd nil match newRegs0 with
| nil => upds
| _ :: _ => (hd nil upds ++ newRegs0) :: tl upds
end))) as P2.
{
intros. simpl in *. destruct newRegs0.
* unfold not; intros. eapply HCheck.
simpl in *. apply H10. assumption.
* unfold not. intros. eapply H7. apply H10. simpl in H12. rewrite map_app in H12.
apply in_app_or in H12. destruct H12.
+ exfalso.
eapply H7.
apply H10. exfalso.
eapply HCheck. rewrite map_app.
apply in_or_app. right.
apply H10. assumption.
+ assumption.
}
inversion H3; subst. simpl in *.
specialize (H _ _ _ _ _ HSemActionCont H1 H2 H13 _ _ _ HConsistent P2 H9 P1).
dest.
exists x; split.
* inversion H3; subst.
destruct newRegs0. destruct newRegsCont; simpl in *; reflexivity.
simpl in *. destruct newRegsCont. simpl in *. rewrite app_nil_r. reflexivity.
rewrite app_comm_cons. rewrite app_assoc. reflexivity.
* econstructor; eauto.
- (* Non Det *)
inv H0; EqDep_subst.
inv H3; EqDep_subst.
specialize (H7 valueV).
specialize (H _ _ _ _ _ HSemAction H1 H2 H7 _ _ _ HConsistent HCheck H4 H5); dest.
exists x. split.
* assumption.
* econstructor; eauto.
- (* Read *)
inv H0; EqDep_subst.
inv H3; EqDep_subst.
specialize (H8 regV).
specialize (H _ _ _ _ _ HSemAction H1 H2 H8 _ _ _ HConsistent HCheck H4 H5); dest.
exists x. split.
* assumption.
* econstructor; eauto.
apply SemVarRegMap.
- (* Write *)
inv H; EqDep_subst.
inv H0.
inv H2; EqDep_subst.
assert (SemRegMapExpr
(VarRegMap type
(old, (hd nil upds ++ (r, existT (fullType type) k (evalExpr e)) :: nil) :: tl upds))
(old, (hd nil upds ++ (r, existT (fullType type) k (evalExpr e)) :: nil) :: tl upds)) as P0.
{ econstructor; eauto. }
assert ((forall u : RegsT,
hd nil upds ++ (r, existT (fullType type) k (evalExpr e)) :: nil = u \/
In u (tl upds) -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old))) as P1.
{
intros.
destruct H; subst.
- repeat rewrite map_app; simpl.
split.
+ rewrite NoDup_app_iff; simpl in *; repeat split.
* clear - H4.
destruct upds; simpl in *;[constructor|].
eapply H4.
left; reflexivity.
* constructor;[|constructor].
intro; inv H.
* repeat intro.
destruct H0; auto; subst.
eapply HCheck. left; reflexivity.
assumption.
* intros; subst.
destruct H; auto; subst.
+ simpl in *. apply SubList_app_l_iff.
split. simpl in *.
destruct upds; simpl in *; auto.
repeat intro; simpl in *.
contradiction.
apply H4. left. reflexivity.
rewrite <- HConsistent.
unfold SubList. intros.
simpl in *. destruct H; subst; auto. contradiction.
- apply H4. simpl in *.
destruct upds. inversion H.
simpl in H. simpl in *. right. assumption.
}
assert (forall s, In s (map fst newRegs0) ->
~ In s (map fst (hd nil
((hd nil upds ++ (r, existT (fullType type) k (evalExpr e)) :: nil) :: tl upds)))) as P2.
{
repeat intro.
simpl in *.
rewrite map_app in H0.
simpl in *. apply in_app_iff in H0.
destruct H0.
destruct upds; subst. inversion H0.
simpl in *.
eapply HCheck. right. apply H.
assumption.
simpl in *. destruct H0.
subst. apply H6. assumption.
assumption.
}
specialize (IHa _ _ _ _ HSemAction H7 H1 H8 _ _ _ HConsistent P2 P0 P1); dest; simpl in *.
exists x; repeat split; auto.
* destruct newRegs0. assumption.
rewrite -> H. simpl in *.
rewrite <- app_assoc. reflexivity.
* simpl in *. rewrite <- (app_nil_l calls).
econstructor; eauto.
econstructor; eauto.
unfold WfRegMapExpr; repeat split.
++ econstructor. simpl in *.
reflexivity.
apply H3. reflexivity.
++ destruct P1 with u.
simpl in *. assumption. assumption.
++ simpl in *.
destruct H2.
subst.
repeat intro.
rewrite map_app in H; simpl in *.
rewrite in_app_iff in H.
destruct H.
destruct upds.
inv H.
simpl in *.
eapply H4.
left.
reflexivity.
assumption.
inv H.
rewrite <- HConsistent.
assumption.
inv H2.
destruct upds.
simpl in *.
inv H2.
simpl in *.
eapply H4; eauto.
- (* if-else *)
inv H0; EqDep_subst.
inv H3; EqDep_subst.
* rewrite map_app, NoDup_app_iff in H1; dest.
assert (forall s : string, In s (map fst newRegs1) -> ~ In s (map fst (hd nil upds))) as P3.
{
intros.
eapply HCheck.
rewrite map_app. apply in_or_app. left. assumption.
}
specialize (IHa1 _ _ _ _ HAction H0 H2 H12 _ _ _ HConsistent P3 H4 H5); dest.
destruct x.
assert (SemRegMapExpr (VarRegMap type (l, l0)) (l, l0)).
apply SemVarRegMap.
assert (forall u, In u l0 -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old) ) as P4.
{
split. inv H7; simpl in *; subst.
destruct newRegs1; auto.
simpl in *. apply H5. assumption.
simpl in *. destruct H11; auto. subst.
rewrite map_app. rewrite NoDup_app_iff; simpl in *; repeat split.
* destruct upds; simpl in *. constructor.
eapply H5. left. reflexivity.
* assumption.
* intros;subst.
unfold not. intro. destruct H11.
subst. eapply HCheck. left. reflexivity.
assumption.
eapply HCheck. right. rewrite map_app.
eapply in_or_app. left. apply H11.
assumption.
* intros; subst.
unfold not. intro. destruct H7; subst.
eapply HCheck. left. reflexivity.
assumption.
eapply HCheck. right. rewrite map_app.
eapply in_or_app. left. apply H7.
assumption.
* eapply H5. simpl in *.
destruct upds. inversion H7.
simpl in H7. simpl in *. right. assumption.
* inv H7; subst.
destruct newRegs1. apply H5. assumption.
destruct upds. simpl in *.
destruct H11; [|contradiction]; subst.
specialize getKindAttr_consistent as P0.
rewrite <- HConsistent.
specialize (P0 _ a1 o (p :: newRegs1) readRegs1 calls1 r1 HAction).
assumption.
simpl in *.
destruct H11; subst.
rewrite map_app. rewrite SubList_app_l_iff; split; auto.
apply H5. left. reflexivity.
specialize getKindAttr_consistent as P0.
rewrite <- HConsistent.
specialize (P0 _ a1 o (p :: newRegs1) readRegs1 calls1 r1 HAction).
assumption.
apply H5. right. assumption. }
inversion H7; subst; simpl in *.
assert (forall s, In s (map fst (newRegs2)) -> ~ In s (map fst (hd nil (match newRegs1 with
| nil => upds
| _ :: _ => (hd nil upds ++ newRegs1) :: tl upds
end)))) as P5.
{
intros. simpl in *. destruct newRegs1.
* unfold not; intros. eapply HCheck.
simpl in *. apply H11. assumption.
* unfold not. intros. eapply H6. apply H11. simpl in H14. rewrite map_app in H14.
apply in_app_or in H14. destruct H14.
+ exfalso.
eapply H6.
apply H11. exfalso.
eapply HCheck. rewrite map_app.
apply in_or_app. right.
apply H11. assumption.
+ assumption. }
inversion H7; subst. simpl in *.
specialize (H9 r1).
specialize (H _ _ _ _ _ HSemAction H1 H2 H9 _ _ _ HConsistent P5 H10 P4).
dest.
exists x; split.
** destruct newRegs1. simpl in *. assumption.
simpl in *. destruct newRegs2.
simpl in *. rewrite app_nil_r.
assumption.
rewrite <- app_assoc in H. assumption.
** remember (evalExpr e) as P0.
assert (forall bexpr, (evalExpr (Const type true && bexpr)%kami_expr = evalExpr bexpr)) as P1.
{ intro; simpl; auto. }
assert (evalExpr e = evalExpr (Const type true)) as P2.
{ rewrite <- HeqP0. apply HTrue. }
simpl.
specialize (FalseSemCompAction) as P12.
assert (evalExpr (!e)%kami_expr = false) as PF.
{ simpl; auto. simpl. rewrite -> P2. simpl; auto. }
specialize (P1 (!e)%kami_expr). rewrite -> PF in P1.
assert (WfRegMapExpr (VarRegMap type (old, match newRegs1 with
| nil => upds
| _ :: _ => (hd nil upds ++ newRegs1) :: tl upds
end)) (old, match newRegs1 with
| nil => upds
| _ :: _ => (hd nil upds ++ newRegs1) :: tl upds
end)).
{
unfold WfRegMapExpr in *; auto. }
do 3 econstructor.
apply SemCompActionEquivBexpr with (bexpr1 := (Const type true)).
simpl in *. rewrite -> HeqP0 in HTrue. rewrite -> HTrue.
reflexivity. apply H8. reflexivity.
specialize (P12 _ a2 o oInit uInit _ _ _ _ H14 HPriorityUpds HOgetReg H2 H13 P1).
destruct P12.
rewrite <- (app_nil_l calls2).
econstructor 8 with (regMap_a := (old, match newRegs1 with
| nil => upds
| _ :: _ => (hd nil upds ++ newRegs1) :: tl upds
end)) (val_a := x0).
eapply SemCompActionEquivBexpr with (bexpr1 := (Const type true && ! e)%kami_expr); eauto.
reflexivity.
simpl in *. econstructor. simpl in *.
rewrite -> P2. apply H11.
* rewrite map_app, NoDup_app_iff in H1; dest.
assert (forall s : string, In s (map fst newRegs1) -> ~ In s (map fst (hd nil upds))) as P3.
{
intros.
eapply HCheck.
rewrite map_app. apply in_or_app. left. assumption.
}
assert (SemRegMapExpr (VarRegMap type (old, upds)) (old, upds)) as HF.
{ constructor. }
inv H3; EqDep_subst.
specialize (IHa2 _ _ _ _ HAction H0 H2 H16 _ _ _ HConsistent P3 HF H5); dest.
destruct x.
assert (SemRegMapExpr (VarRegMap type (l, l0)) (l, l0)).
apply SemVarRegMap.
assert (forall u, In u l0 -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old) ) as P4.
{
split. inv H3; simpl in *; subst.
destruct newRegs1; auto.
simpl in *. apply H5. assumption.
simpl in *. destruct H10; auto. subst.
rewrite map_app. rewrite NoDup_app_iff; simpl in *; repeat split.
* destruct upds; simpl in *. constructor.
eapply H5. left. reflexivity.
* assumption.
* intros;subst.
unfold not. intro. destruct H10.
subst. eapply HCheck. left. reflexivity.
assumption.
eapply HCheck. right. rewrite map_app.
eapply in_or_app. left. apply H10.
assumption.
* intros; subst.
unfold not. intro. destruct H3; subst.
eapply HCheck. left. reflexivity.
assumption.
eapply HCheck. right. rewrite map_app.
eapply in_or_app. left. apply H3.
assumption.
* eapply H5. simpl in *.
destruct upds. inversion H3.
simpl in H7. simpl in *. right. assumption.
* inv H3; subst.
destruct newRegs1. apply H5. assumption.
destruct upds. simpl in *.
destruct H10; [|contradiction]; subst.
specialize getKindAttr_consistent as P0.
rewrite <- HConsistent.
specialize (P0 _ a2 o (p :: newRegs1) readRegs1 calls1 r1 HAction).
assumption.
simpl in *.
destruct H10; subst.
rewrite map_app. rewrite SubList_app_l_iff; split; auto.
apply H5. left. reflexivity.
specialize getKindAttr_consistent as P0.
rewrite <- HConsistent.
specialize (P0 _ a2 o (p :: newRegs1) readRegs1 calls1 r1 HAction).
assumption.
apply H5. right. assumption. }
inversion H3; subst; simpl in *.
assert (forall s, In s (map fst (newRegs2)) -> ~ In s (map fst (hd nil (match newRegs1 with
| nil => upds
| _ :: _ => (hd nil upds ++ newRegs1) :: tl upds
end)))) as P5.
{
intros. simpl in *. destruct newRegs1.
* unfold not; intros. eapply HCheck.
simpl in *. apply H10. assumption.
* unfold not. intros. eapply H7. apply H10. simpl in H11. rewrite map_app in H11.
apply in_app_or in H11. destruct H11.
+ exfalso.
eapply H7.
apply H10. exfalso.
eapply HCheck. rewrite map_app.
apply in_or_app. right.
apply H10. assumption.
+ assumption.
}
inversion H3; subst. simpl in *.
specialize (H12 r1).
specialize (H _ _ _ _ _ HSemAction H1 H2 H12 _ _ _ HConsistent P5 H9 P4).
dest.
exists x; split.
** destruct newRegs1. simpl in *. assumption.
simpl in *. destruct newRegs2.
simpl in *. rewrite app_nil_r.
assumption.
rewrite <- app_assoc in H. assumption.
** remember (evalExpr e) as P0.
assert (forall bexpr, (evalExpr (Const type true && bexpr)%kami_expr = evalExpr bexpr)) as P1.
{ intro; simpl; auto. }
assert (evalExpr (!e)%kami_expr = evalExpr (Const type true)) as P2.
{simpl. rewrite -> HeqP0 in HFalse. rewrite -> HFalse. auto. }
specialize (FalseSemCompAction) as P12.
assert (evalExpr (!e)%kami_expr = true) as PF.
{ simpl; auto. }
specialize (P1 (!e)%kami_expr). rewrite -> PF in P1.
assert (WfRegMapExpr writeMap (old, upds)).
{
unfold WfRegMapExpr in *; auto. }
rewrite <-(app_nil_l (calls1++calls2)).
assert (evalExpr (Const type true && e)%kami_expr = false).
{
simpl. rewrite -> HFalse in HeqP0; auto. }
specialize (P12 _ a1 o oInit uInit _ _ _ _ H11 HPriorityUpds HOgetReg H2 H15 H13).
destruct P12.
do 2 econstructor; econstructor 8 with (regMap_a := (old, upds)) (val_a := x0).
eapply SemCompActionEquivBexpr with (bexpr1 := (Const type true && e)%kami_expr); eauto.
reflexivity.
simpl in *. econstructor 8 with (regMap_a := (old, match newRegs1 with
| nil => upds
| _ :: _ => (hd nil upds ++ newRegs1) :: tl upds
end)) (val_a := r1) . simpl in *.
apply SemCompActionEquivBexpr with (bexpr1 := (Const type true)).
simpl in *. rewrite -> P2. reflexivity. apply H8.
simpl in *. reflexivity. econstructor. simpl in *.
rewrite -> HFalse in HeqP0. rewrite <- HeqP0. apply H10.
- (* Sys *)
inv H; EqDep_subst.
inv H2; EqDep_subst.
specialize (IHa _ _ _ _ HSemAction H0 H1 H6 _ _ _ HConsistent HCheck H3 H4); dest.
exists x. split.
* assumption.
* econstructor; eauto.
- (* Return *)
inv H; EqDep_subst.
inv H2; EqDep_subst.
exists (old, upds).
split. reflexivity.
destruct upds.
simpl in *. constructor. reflexivity.
unfold WfRegMapExpr. split; auto.
econstructor. reflexivity.
unfold WfRegMapExpr. split; auto.
Qed.
End DoubleWritesProof.
================================================
FILE: Compiler/CompilerProps.v
================================================
Require Import Kami.StateMonad Kami.Syntax Kami.Properties Kami.PProperties Kami.PPlusProperties Kami.Lib.EclecticLib Kami.Notations Kami.Compiler.Compiler.
Import Word.Notations.
Require Import ZArith.
Set Implicit Arguments.
Set Asymmetric Patterns.
Local Coercion BaseRegFile : RegFileBase >-> BaseModule.
(* Section Defs *)
Definition inline_Meths (l : list DefMethT) (xs : list nat) (meth : DefMethT) : DefMethT :=
let (name, sig_body) := meth in
(name,
let (sig, body) := sig_body in
existT _ sig (fun ty arg => fold_left (inlineSingle_pos l) xs (body ty arg))).
Definition inlineSingle_Meth_pos (l : list DefMethT) (meth : DefMethT) (n : nat) : DefMethT :=
match nth_error l n with
| Some f => inlineSingle_Meth f meth
| None => meth
end.
Definition inline_Rules (l : list DefMethT) (xs : list nat) (rule : RuleT) : RuleT :=
let (s, a) := rule in
(s, fun ty => fold_left (inlineSingle_pos l) xs (a ty)).
Definition listRfMethods (lrf : list RegFileBase) : (list DefMethT) :=
(concat (map (fun rf => getRegFileMethods rf) lrf)).
Definition inlineRf_Rules_Flat (lrf : list RegFileBase) (l : list RuleT) :=
map (inline_Rules (listRfMethods lrf) (seq 0 (length (listRfMethods lrf)))) l.
Definition inlineRf_Meths_Flat (lrf : list RegFileBase) (l : list DefMethT) :=
map (inline_Meths (listRfMethods lrf) (seq 0 (length (listRfMethods lrf)))) l.
Definition flatInlineSingleRfNSC (m : BaseModule) (lrf : list RegFileBase) :=
BaseMod (getRegisters m ++ (concat (map (fun rf => getRegFileRegisters rf) lrf)))
(inlineRf_Rules_Flat lrf (getRules m))
((inlineRf_Meths_Flat lrf (getMethods m)) ++ (concat (map (fun rf => getRegFileMethods rf) lrf))).
Definition inlineSingle_Rule_pos (meths : list DefMethT) n (rule : RuleT) :=
match nth_error meths n with
| Some f => (inlineSingle_Rule f rule)
| None => rule
end.
Definition inlineSingle_Meths_posmap (meths : list DefMethT) (currMap : DefMethT -> DefMethT) (n : nat) :=
match nth_error meths n with
| Some f => (fun x => inlineSingle_Meth (currMap f) (currMap x))
| None => currMap
end.
Definition inlineAll_Rules_map (meths : list DefMethT) (rules : list RuleT) :=
map (fold_left (fun rle n => inlineSingle_Rule_pos meths n rle) (seq 0 (length meths))) rules.
Fixpoint subseq_list {A : Type} (l : list A) (xs : list nat) :=
match xs with
| n::xs' => match nth_error l n with
| Some d => d :: (subseq_list l xs')
| None => (subseq_list l xs')
end
| nil => nil
end.
Definition mergeSeparatedSingle (b : BaseModule) (lrf : list RegFileBase) : Mod :=
ConcatMod (Base b) (mergeSeparatedBaseFile lrf).
(* End Defs *)
(* begin misc properties *)
Lemma WfBaseMod_inlineSingle_map ty (m : BaseModule) (HWfMod : WfBaseModule ty m) k (a : ActionT ty k) (n : nat):
forall (lf : list DefMethT),
SubList lf (getMethods m) ->
WfActionT (getRegisters m) a ->
WfActionT (getRegisters m) (apply_nth (map (fun f a' => @inlineSingle ty k a' f) lf) a n).
Proof.
intros.
unfold apply_nth; remember (nth_error _ _) as err0; symmetry in Heqerr0; destruct err0; auto.
apply nth_error_In in Heqerr0; rewrite in_map_iff in Heqerr0; dest.
rewrite <- H1.
apply WfBaseMod_inlineSingle; auto.
Qed.
Lemma WfBaseMod_inlineSome_map ty (m : BaseModule) (HWfMod : WfBaseModule ty m) xs:
forall (lf : list DefMethT) k (a : ActionT ty k),
SubList lf (getMethods m) ->
WfActionT (getRegisters m) a ->
WfActionT (getRegisters m) (fold_left (apply_nth (map (fun f a' => @inlineSingle ty k a' f) lf)) xs a).
Proof.
induction xs; simpl; intros; eauto.
apply IHxs; auto.
apply WfBaseMod_inlineSingle_map; assumption.
Qed.
Lemma subseq_list_app {A : Type} (l : list A) (xs1 xs2 : list nat):
subseq_list l (xs1 ++ xs2) = subseq_list l xs1 ++ subseq_list l xs2.
Proof.
induction xs1; simpl; auto.
remember (nth_error _ _) as err0; symmetry in Heqerr0; destruct err0; auto.
rewrite <-app_comm_cons, IHxs1; reflexivity.
Qed.
Lemma subseq_list_shift {A : Type} (xs : list nat) :
forall (l1 l2 : list A),
(forall n, In n xs -> length l1 <= n) ->
subseq_list (l1 ++ l2) xs = subseq_list l2 (map (fun x => x - (length l1)) xs).
Proof.
induction xs; simpl; auto; intros.
remember (nth_error _ _ ) as err0.
remember (nth_error l2 _ ) as err1.
symmetry in Heqerr0, Heqerr1; destruct err0; rewrite nth_error_app2, Heqerr1 in Heqerr0;
auto; rewrite Heqerr0; auto.
apply f_equal; auto.
Qed.
Lemma subseq_list_all {A : Type} (l : list A) :
subseq_list l (seq 0 (length l)) = l.
Proof.
induction l; auto.
simpl; apply f_equal.
rewrite <- IHl at 3.
assert (a :: l = [a] ++ l) as P0; auto; rewrite P0.
rewrite subseq_list_shift.
- rewrite Reduce_seq; auto.
- intros; rewrite in_seq in *; dest; auto.
Qed.
Lemma existsb_nexists_sync sync l :
existsb (SyncRead_eqb sync) l = false <->
~ In sync l.
Proof.
split; repeat intro.
- assert (exists x, In x l /\ (SyncRead_eqb sync) x = true) as P0.
{ exists sync; split; auto. unfold SyncRead_eqb; repeat rewrite String.eqb_refl; auto. }
rewrite <- existsb_exists in P0; rewrite P0 in *; discriminate.
- remember (existsb _ _) as exb; symmetry in Heqexb; destruct exb; auto.
exfalso; rewrite existsb_exists in Heqexb; dest.
rewrite SyncRead_eqb_eq in *; subst; auto.
Qed.
(* end misc properties *)
Lemma inline_Rules_eq_inlineSome (xs : list nat) :
forall (meths : list DefMethT) (rules : list RuleT),
fold_left (fun newRules n => inlineSingle_Rules_pos meths n newRules) xs rules
= map (inline_Rules meths xs) rules.
Proof.
induction xs; unfold inline_Rules; simpl; intros.
- induction rules; simpl; auto.
apply f_equal2; auto.
destruct a; apply f_equal.
eexists.
- rewrite IHxs.
clear; induction rules; simpl.
+ unfold inlineSingle_Rules_pos; destruct nth_error; auto.
+ rewrite <- IHrules.
unfold inlineSingle_Rules_pos.
remember (nth_error meths a) as nth_err.
destruct nth_err; simpl.
* apply f_equal2; auto.
unfold inlineSingle_pos, inline_Rules, inlineSingle_Rule;
rewrite <- Heqnth_err; simpl.
destruct a0; simpl.
apply f_equal.
eexists.
* unfold inline_Rules; destruct a0.
apply f_equal2; auto; apply f_equal.
unfold inlineSingle_pos at 3; rewrite <- Heqnth_err.
reflexivity.
Qed.
Corollary inlineAll_Rules_in (lm : list DefMethT) :
forall lr,
inlineAll_Rules lm lr = map (inline_Rules lm (seq 0 (length lm))) lr.
Proof.
unfold inlineAll_Rules; intros; rewrite inline_Rules_eq_inlineSome; reflexivity.
Qed.
Lemma inlineSingle_map meths:
forall n,
inlineSingle_Meths_pos meths n = map (inlineSingle_Meths_posmap meths (fun x => x) n) meths.
Proof.
intros.
unfold inlineSingle_Meths_pos, inlineSingle_Meths_posmap; destruct nth_error;[|rewrite map_id]; auto.
Qed.
Lemma inlineSome_map xs :
forall meths,
fold_left inlineSingle_Meths_pos xs meths = map (fold_left (inlineSingle_Meths_posmap meths) xs (fun x => x)) meths.
Proof.
induction xs; simpl; intros;[rewrite map_id; reflexivity|].
rewrite inlineSingle_map.
unfold inlineSingle_Meths_posmap at 1 3; destruct nth_error.
- rewrite IHxs.
rewrite map_map, forall_map; intros.
repeat rewrite <- fold_left_rev_right.
clear.
revert x; induction (rev xs); simpl; auto; intros.
unfold inlineSingle_Meths_posmap at 1 3.
remember (nth_error _ _) as nth_err0.
remember (nth_error meths a) as nth_err1.
destruct nth_err0, nth_err1; auto.
+ symmetry in Heqnth_err1.
apply (map_nth_error (fun x => inlineSingle_Meth d x)) in Heqnth_err1.
rewrite Heqnth_err1 in Heqnth_err0; inv Heqnth_err0.
rewrite IHl; simpl.
apply f_equal2; auto.
+ exfalso.
specialize (nth_error_map (fun x : DefMethT => inlineSingle_Meth d x) (fun x => False) a meths) as P0.
rewrite <- Heqnth_err0, <- Heqnth_err1 in P0; rewrite P0; auto.
+ exfalso.
specialize (nth_error_map (fun x : DefMethT => inlineSingle_Meth d x) (fun x => False) a meths) as P0.
rewrite <- Heqnth_err0, <- Heqnth_err1 in P0; rewrite <- P0; auto.
- rewrite map_id; apply IHxs.
Qed.
Lemma inlineAll_Rules_in' (lm : list DefMethT) :
forall lr,
inlineAll_Rules lm lr = inlineAll_Rules_map lm lr.
Proof.
unfold inlineAll_Rules, inlineAll_Rules_map.
induction (seq 0 (length lm)); simpl; intros.
- rewrite map_id; reflexivity.
- rewrite IHl.
clear; induction lr; simpl.
+ unfold inlineSingle_Rules_pos; destruct nth_error; simpl; auto.
+ unfold inlineSingle_Rules_pos, inlineSingle_Rule_pos at 3.
remember (nth_error lm a) as nth_err.
destruct nth_err; simpl; apply f_equal; rewrite <- IHlr;
unfold inlineSingle_Rules_pos; rewrite <- Heqnth_err; reflexivity.
Qed.
Lemma NeverCall_inlineSingle_pos ty k (a : ActionT ty k) :
forall (l : list DefMethT) (n : nat) (f : DefMethT)
(HNeverCall : forall meth ty,
In meth l ->
forall arg, NeverCallActionT (projT2 (snd meth) ty arg)),
nth_error l n = Some f ->
NoCallActionT [f] (inlineSingle_pos l a n).
Proof.
unfold inlineSingle_pos; intros.
remember (nth_error _ _) as nth_err0; symmetry in Heqnth_err0; destruct nth_err0; auto; inv H.
apply NeverCall_inline; eauto using nth_error_In.
Qed.
Lemma NeverCall_inlineSingle_pos_persistent k ty (a : ActionT ty k) :
forall (l ls : list DefMethT) (n : nat)
(HNeverCall : forall meth ty,
In meth l ->
forall arg, NeverCallActionT (projT2 (snd meth) ty arg)),
NoCallActionT ls a ->
NoCallActionT ls (inlineSingle_pos l a n).
Proof.
unfold inlineSingle_pos; intros.
destruct (nth_error _ _) eqn:err0; auto.
apply NeverCall_inline_persistent; eauto using nth_error_In.
Qed.
Lemma NeverCall_inlineSome_pos_persistent xs:
forall ty k (a : ActionT ty k)
(l ls : list DefMethT)
(HNeverCall : forall meth ty,
In meth l ->
forall arg, NeverCallActionT (projT2 (snd meth) ty arg)),
NoCallActionT ls a ->
NoCallActionT ls (fold_left (inlineSingle_pos l) xs a).
Proof.
induction xs; intros; simpl in *; auto.
eapply IHxs; eauto using NeverCall_inlineSingle_pos_persistent.
Qed.
Lemma NeverCall_inlineSome_pos xs:
forall ty k (a : ActionT ty k)
(l : list DefMethT)
(HNeverCall : forall meth ty,
In meth l ->
forall arg, NeverCallActionT (projT2 (snd meth) ty arg)),
(forall f, In f (subseq_list l xs) ->
NoCallActionT [f] (fold_left (inlineSingle_pos l) xs a)).
Proof.
induction xs; simpl; intros; auto;[contradiction|].
destruct (nth_error _ _) eqn:G; auto.
inv H; auto.
eapply NeverCall_inlineSome_pos_persistent; eauto using NeverCall_inlineSingle_pos.
Qed.
Lemma NeverCall_inlineSome_pos_full xs :
forall ty k (a : ActionT ty k)
(l : list DefMethT)
(HNeverCall : forall meth ty,
In meth l ->
forall arg, NeverCallActionT (projT2 (snd meth) ty arg)),
NoCallActionT (subseq_list l xs) (fold_left (inlineSingle_pos l) xs a).
Proof.
induction xs; eauto using NilNoCall; intros.
simpl; unfold inlineSingle_pos at 2.
destruct (nth_error _ _) eqn:G; eauto.
assert (d::subseq_list l xs = [d] ++ subseq_list l xs) as TMP; auto; rewrite TMP; clear TMP.
apply NoCallActionT_Stitch; auto.
apply NeverCall_inlineSome_pos_persistent; auto.
apply NeverCall_inline; eauto using nth_error_In.
Qed.
Lemma NoSelfCall_ignorable k (a : ActionT type k) :
forall (l1 l2 : list DefMethT) (n : nat),
n < length l1 ->
NoCallActionT l1 a ->
inlineSingle_pos (inlineAll_Meths (l1 ++ l2)) a n = a.
Proof.
unfold inlineSingle_pos; intros;
remember (nth_error (inlineAll_Meths (l1 ++ l2)) n) as nth_err0; destruct nth_err0; auto.
eapply NotCalled_NotInlined; eauto.
symmetry in Heqnth_err0.
apply (map_nth_error (fun x => (fst x, projT1 (snd x)))) in Heqnth_err0.
rewrite <- SameKindAttrs_inlineAll_Meths, map_app, nth_error_app1 in Heqnth_err0.
+ apply (nth_error_In _ _ Heqnth_err0).
+ rewrite map_length; assumption.
Qed.
Lemma SemRegExprVals expr :
forall o1 o2,
SemRegMapExpr expr o1 ->
SemRegMapExpr expr o2 ->
o1 = o2.
Proof.
induction expr; intros; inv H; inv H0; EqDep_subst; auto;
try congruence; specialize (IHexpr _ _ HSemRegMap HSemRegMap0); inv IHexpr; auto.
Qed.
Lemma UpdRegs_same_nil o :
UpdRegs (nil::nil) o o.
Proof.
unfold UpdRegs.
repeat split; auto.
intros.
right; unfold not; split; intros; dest; auto.
destruct H0; subst; auto.
Qed.
Lemma PriorityUpds_Equiv old upds new
(HNoDupOld : NoDup (map fst old))
(HNoDupUpds : forall u, In u upds -> NoDup (map fst u)) :
PriorityUpds old upds new ->
forall new',
PriorityUpds old upds new' ->
SubList new new'.
Proof.
induction 1; intros.
- inv H.
+ apply SubList_refl.
+ discriminate.
- subst.
inv H0; inv HFullU.
repeat intro.
destruct x.
specialize (Hcurr _ _ H0).
specialize (getKindAttr_map_fst _ _ currRegsTCurr0) as P0.
specialize (getKindAttr_map_fst _ _ currRegsTCurr) as P1.
assert (In s (map fst new')).
{ rewrite <- P0, P1, in_map_iff. exists (s, s0); split; auto. }
rewrite in_map_iff in H1; dest.
destruct x; simpl in *; subst.
specialize (Hcurr0 _ _ H2).
specialize (HNoDupUpds _ (or_introl _ (eq_refl))) as P3.
destruct Hcurr, Hcurr0; dest.
+ rewrite <-(KeyMatching3 _ _ _ P3 H3 H1 eq_refl).
assumption.
+ exfalso; apply H3.
rewrite in_map_iff.
exists (s, s0); split; auto.
+ exfalso; apply H1.
rewrite in_map_iff.
exists (s, s2); split; auto.
+ assert (forall u, In u prevUpds0 -> NoDup (map fst u)) as P4; eauto.
specialize (IHPriorityUpds P4 _ prevCorrect _ H5).
rewrite (getKindAttr_map_fst _ _ (prevPrevRegsTrue prevCorrect)) in HNoDupOld.
rewrite (KeyMatching3 _ _ _ HNoDupOld H4 IHPriorityUpds eq_refl) in *.
assumption.
Qed.
Lemma PriorityUpdsCompact upds:
forall old new,
PriorityUpds old upds new -> PriorityUpds old (nil::upds) new.
Proof.
induction upds.
- econstructor 2 with (u := nil) (prevUpds := nil); eauto; repeat constructor.
inv H; eauto.
- intros.
econstructor 2 with (u := nil) (prevUpds := a :: upds); eauto.
inv H; auto.
Qed.
Lemma CompactPriorityUpds upds:
forall old,
NoDup (map fst old) ->
forall new,
PriorityUpds old (nil::upds) new -> PriorityUpds old upds new.
Proof.
induction upds; intros.
- enough (old = new).
{ subst; constructor. }
inv H0; inv HFullU; inv prevCorrect;[|discriminate]; simpl in *.
apply getKindAttr_map_fst in currRegsTCurr.
assert (forall s v, In (s, v) new -> In (s, v) prevRegs).
{ intros.
destruct (Hcurr _ _ H0);[contradiction|dest]; auto.
}
symmetry.
apply KeyMatch; auto.
rewrite currRegsTCurr in H; assumption.
- inv H0; inv HFullU.
enough ( new = prevRegs).
{ rewrite H0; auto. }
apply getKindAttr_map_fst in currRegsTCurr.
specialize (getKindAttr_map_fst _ _ (prevPrevRegsTrue prevCorrect)) as P0.
rewrite currRegsTCurr in H.
eapply KeyMatch; eauto.
+ rewrite <- currRegsTCurr; assumption.
+ intros.
destruct (Hcurr _ _ H0);[contradiction| dest; auto].
Qed.
Lemma CompactPriorityUpds_iff {old} (NoDupsOld : NoDup (map fst old)) upds new:
PriorityUpds old (nil::upds) new <-> PriorityUpds old upds new.
Proof.
split; eauto using CompactPriorityUpds, PriorityUpdsCompact.
Qed.
Lemma inline_Meths_eq_inlineSome (xs : list nat) :
forall (l l' : list DefMethT)
(HDisjMeths : DisjKey l l'),
fold_left (inlineSingle_Flat_pos l') xs l = map (inline_Meths l' xs) l.
Proof.
induction xs; simpl; intros.
- unfold inline_Meths; induction l; simpl in *; auto.
rewrite <-IHl.
+ destruct a, s0, x; simpl.
reflexivity.
+ intro k; specialize (HDisjMeths k); simpl in *; firstorder fail.
- rewrite IHxs.
+ unfold inlineSingle_Flat_pos.
remember (nth_error l' a) as nth_err.
destruct nth_err.
* unfold inline_Meths at 2; simpl.
unfold inlineSingle_pos at 2.
rewrite <- Heqnth_err.
induction l; simpl; auto.
rewrite <- IHl.
-- apply f_equal2; auto.
unfold inline_Meths, inlineSingle_Meth.
destruct a0, s0.
remember (String.eqb _ _ ) as strd; symmetry in Heqstrd.
destruct strd; auto; rewrite String.eqb_eq in *.
exfalso.
specialize (nth_error_In _ _ (eq_sym Heqnth_err)) as P0.
destruct d; subst.
apply (in_map fst) in P0.
clear - HDisjMeths P0.
destruct (HDisjMeths s0); auto; apply H; left; reflexivity.
-- clear - HDisjMeths.
intro k; specialize (HDisjMeths k); simpl in *; firstorder fail.
* unfold inline_Meths at 2; simpl.
unfold inlineSingle_pos at 2.
rewrite <- Heqnth_err.
fold (inline_Meths l' xs).
reflexivity.
+ clear - HDisjMeths.
intro k; specialize (HDisjMeths k).
enough (map fst (inlineSingle_Flat_pos l' l a) = (map fst l)).
{ rewrite H; auto. }
unfold inlineSingle_Flat_pos.
destruct nth_error; auto.
apply inline_preserves_keys_Meth.
Qed.
Lemma getFromEach_getMethods (rf : RegFileBase) :
getMethods rf = getEachRfMethod rf.
Proof.
unfold getEachRfMethod; destruct rf; simpl.
destruct rfRead; simpl; auto.
unfold readSyncRegFile, getSyncReq, getSyncRes; simpl.
destruct isAddr; auto.
Qed.
Lemma inlineSingle_Flat_pos_lengths :
forall xs ls ls',
length (fold_left (inlineSingle_Flat_pos ls') xs ls) = length ls.
Proof.
induction xs; simpl; auto; intros.
rewrite IHxs.
unfold inlineSingle_Flat_pos.
destruct nth_error; auto.
rewrite map_length.
reflexivity.
Qed.
Lemma inlineAll_Meths_RegFile_fold_flat2 n :
forall (l l' : list DefMethT)
(HNeverCall : forall meth ty,
In meth l' ->
(forall arg, NeverCallActionT (projT2 (snd meth) ty arg)))
(Hlen : 0 < n - length l),
fold_left inlineSingle_Meths_pos (seq (length l) (n - (length l))) (l ++ l')
= fold_left (inlineSingle_Flat_pos l') (seq 0 (n - length l)) l ++ l'.
Proof.
intros; induction n.
- simpl; auto.
- assert (length l <= n) as TMP.
{ lia. }
rewrite Nat.sub_succ_l in *; auto.
+ apply lt_n_Sm_le in Hlen.
destruct (le_lt_or_eq _ _ Hlen).
* repeat rewrite seq_eq.
repeat rewrite fold_left_app; simpl.
rewrite IHn; [rewrite <- le_plus_minus; [|lia]|]; auto.
remember (nth_error l' (n - length l)) as nth_err.
destruct nth_err.
-- symmetry in Heqnth_err.
assert (length l <= n) as P1.
{ lia. }
rewrite <-(inlineSingle_Flat_pos_lengths (seq 0 (n - Datatypes.length l)) l l') in Heqnth_err, P1.
erewrite inlineAll_Meths_RegFile_flat2; eauto.
unfold inlineSingle_Flat_pos at 2.
rewrite inlineSingle_Flat_pos_lengths in Heqnth_err.
rewrite Heqnth_err.
reflexivity.
-- unfold inlineSingle_Meths_pos.
remember (nth_error (fold_left (inlineSingle_Flat_pos l') (seq 0 (n - Datatypes.length l)) l ++ l') n) as nth_err2.
destruct nth_err2.
++ exfalso.
assert (nth_error (fold_left (inlineSingle_Flat_pos l') (seq 0 (n - Datatypes.length l)) l ++ l') n <> None) as P1.
{ rewrite <- Heqnth_err2; intro; discriminate. }
rewrite nth_error_Some in P1.
rewrite app_length, inlineSingle_Flat_pos_lengths in P1.
symmetry in Heqnth_err.
rewrite nth_error_None in Heqnth_err.
lia.
++ unfold inlineSingle_Flat_pos.
rewrite <- Heqnth_err; reflexivity.
* rewrite <- H; simpl.
assert (n = length l) as P0.
{ lia. }
rewrite P0 in *; clear TMP.
remember (nth_error l' (length l - length l)) as nth_err.
destruct nth_err.
-- symmetry in Heqnth_err.
erewrite inlineAll_Meths_RegFile_flat2; eauto.
unfold inlineSingle_Flat_pos.
remember (nth_error l' 0) as nth_err2.
destruct nth_err2.
++ rewrite Nat.sub_diag in Heqnth_err.
rewrite Heqnth_err in *.
inv Heqnth_err2.
reflexivity.
++ rewrite Nat.sub_diag in Heqnth_err.
rewrite Heqnth_err in *.
inv Heqnth_err2.
-- unfold inlineSingle_Meths_pos.
remember (nth_error (l ++ l') (Datatypes.length l)) as nth_err2.
destruct nth_err2.
++ exfalso.
assert (nth_error (l ++ l') (length l) <> None).
{ rewrite <- Heqnth_err2; intro; inv H0. }
rewrite nth_error_Some in H0.
symmetry in Heqnth_err.
rewrite nth_error_None in Heqnth_err.
rewrite app_length in H0.
rewrite Nat.sub_diag in Heqnth_err.
lia.
++ unfold inlineSingle_Flat_pos.
rewrite Nat.sub_diag in Heqnth_err.
rewrite <- Heqnth_err.
reflexivity.
Qed.
Lemma inlineAll_Meths_RegFile_fold_flat :
forall (l l' : list DefMethT)
(HNeverCall : forall meth ty,
In meth l' ->
(forall arg, NeverCallActionT (projT2 (snd meth) ty arg))),
fold_left inlineSingle_Meths_pos (seq 0 (length (l ++ l'))) (l ++ l')
= fold_left (inlineSingle_Flat_pos l') (seq 0 (length l'))
(fold_left inlineSingle_Meths_pos (seq 0 (length l)) l) ++ l'.
Proof.
intros.
specialize (Nat.le_add_r (length l) (length l')) as P0.
rewrite app_length, (seq_app' _ P0), fold_left_app, Nat.add_0_l.
rewrite inlineAll_Meths_RegFile_fold_flat1; auto.
destruct (zerop (length l')).
- rewrite e; rewrite minus_plus; simpl.
rewrite length_zero_iff_nil in e; rewrite e, app_nil_r; reflexivity.
- assert (0 < (length l + length l') - length l).
{ rewrite minus_plus; assumption. }
rewrite <- (inlineSome_Meths_pos_length l (seq 0 (Datatypes.length l))) at 1 2 3.
rewrite <- (inlineSome_Meths_pos_length l (seq 0 (Datatypes.length l))) in H.
rewrite inlineAll_Meths_RegFile_fold_flat2; auto.
rewrite (inlineSome_Meths_pos_length l (seq 0 (Datatypes.length l))) in *.
rewrite minus_plus.
rewrite <- (inlineSome_Meths_pos_length l (seq 0 (Datatypes.length l)) ).
reflexivity.
Qed.
Lemma inlineSingle_pos_NeverCall k ty (a : ActionT ty k) n:
forall (l : list DefMethT) (ls : list DefMethT),
(forall meth ty,
In meth l ->
(forall arg, NeverCallActionT (projT2 (snd meth) ty arg))) ->
(forall k, ~In k (map fst l) \/ ~In k (map fst ls)) ->
NoCallActionT ls (inlineSingle_pos l a n) ->
NoCallActionT ls a.
Proof.
unfold inlineSingle_pos; intros; remember (nth_error _ _) as nth_err0; symmetry in Heqnth_err0; destruct nth_err0; auto.
apply nth_error_In in Heqnth_err0.
eapply inline_NeverCall; eauto.
apply (in_map fst) in Heqnth_err0.
destruct (H0 (fst d)); auto.
intro; apply H2; rewrite in_map_iff in *; dest; exists x; inv H3; split; auto.
Qed.
Lemma inlineSome_pos_NeverCall xs :
forall k ty (a : ActionT ty k)
(l : list DefMethT) (ls : list DefMethT),
(forall meth ty,
In meth l ->
(forall arg, NeverCallActionT (projT2 (snd meth) ty arg))) ->
(forall k, ~In k (map fst l) \/ ~In k (map fst ls)) ->
NoCallActionT ls (fold_left (inlineSingle_pos l) xs a) ->
NoCallActionT ls a.
Proof.
induction xs; simpl; intros; auto.
eapply inlineSingle_pos_NeverCall; eauto.
Qed.
Lemma NoCall_Meths_reduction xs :
forall (l l' : list DefMethT)
(HDisjKeys : DisjKey l l')
(HNeverCall : forall meth ty,
In meth l' ->
(forall arg, NeverCallActionT (projT2 (snd meth) ty arg))),
(forall meth ty,
In meth (fold_left (inlineSingle_Flat_pos l') xs l) ->
(forall arg, NoCallActionT l (projT2 (snd meth) ty arg))) ->
(forall meth ty,
In meth l ->
(forall arg, NoCallActionT l (projT2 (snd meth) ty arg))).
Proof.
intros.
rewrite inline_Meths_eq_inlineSome in *; auto.
destruct meth, s0; simpl in *.
specialize (H _ ty (in_map (inline_Meths l' xs) _ _ H0) arg); unfold inline_Meths in *; simpl in *.
eapply inlineSome_pos_NeverCall; eauto.
apply DisjKey_Commutative in HDisjKeys; intro k; specialize (HDisjKeys k); assumption.
Qed.
Lemma NoCall_Rules_reduction :
forall (l : list DefMethT) (lr : list RuleT) (ls : list DefMethT)
(DisjKeys : forall k, ~In k (map fst l) \/ ~In k (map fst ls))
(HNeverCall : forall meth ty,
In meth l ->
(forall arg, NeverCallActionT (projT2 (snd meth) ty arg))),
(forall rule ty,
In rule (inlineAll_Rules l lr) ->
NoCallActionT ls (snd rule ty)) ->
(forall rule ty,
In rule lr ->
NoCallActionT ls (snd rule ty)).
Proof.
intros; destruct rule; simpl in *.
rewrite inlineAll_Rules_in in *.
eapply inlineSome_pos_NeverCall; eauto.
specialize (H _ ty (in_map (inline_Rules l _) _ _ H0)); unfold inline_Rules in *;
simpl in *; apply H.
Qed.
Lemma SameKeys_inlineSome_Meths_map xs :
forall (l l' : list DefMethT),
(map fst (map (inline_Meths l' xs) l)) = map fst l.
Proof.
unfold inline_Meths; induction l; simpl; auto; intros.
setoid_rewrite IHl; apply f_equal2; destruct a; auto.
Qed.
Lemma SameKindAttrs_inlineSome_Meths_map xs :
forall (l l' : list DefMethT),
(getKindAttr (map (inline_Meths l' xs) l)) = getKindAttr l.
Proof.
unfold inline_Meths; induction l; simpl; auto; intros.
setoid_rewrite IHl; apply f_equal2; destruct a, s0; auto.
Qed.
Lemma inlineAll_NoCall_Meths_RegFile_fold_flat :
forall (l l' : list DefMethT)
(HNeverCall : forall meth ty,
In meth l' ->
(forall arg, NeverCallActionT (projT2 (snd meth) ty arg)))
(HDisjMeths : DisjKey l l')
(HNoCall : forall meth ty,
In meth l ->
(forall arg,
NoCallActionT l (projT2 (snd meth) ty arg))),
inlineAll_Meths (l ++ l')
= map (inline_Meths l' (seq 0 (length l'))) l ++ l' /\
(forall meth ty,
In meth (map (inline_Meths l' (seq 0 (length l'))) l) ->
(forall arg,
NoCallActionT ((map (inline_Meths l' (seq 0 (length l'))) l)) (projT2 (snd meth) ty arg))).
Proof.
intros; split.
- unfold inlineAll_Meths; rewrite inlineAll_Meths_RegFile_fold_flat; auto.
erewrite (inlineSome_Meths_pos_NoCalls_ident); eauto; [| apply SubList_refl].
rewrite inline_Meths_eq_inlineSome; auto.
- intros.
rewrite in_map_iff in H; dest; subst; destruct x, s0.
specialize (HNoCall _ ty H0 arg); simpl in *.
eapply NeverCall_inlineSome_pos_persistent; auto.
* specialize (SameKindAttrs_inlineSome_Meths_map (seq 0 (length l')) l l') as P0.
eauto using SignatureReplace_NoCall.
Qed.
Lemma SameKeys_inlineSome_Rules_map xs :
forall (l' : list DefMethT) (l : list RuleT),
(map fst (map (inline_Rules l' xs) l)) = map fst l.
Proof.
unfold inline_Rules; induction l; simpl; auto; intros.
setoid_rewrite IHl; apply f_equal2; destruct a; auto.
Qed.
Lemma inlineAll_NoCall_Rules_RegFile_fold_flat :
forall (l l' : list DefMethT) (lr : list RuleT)
(HNeverCall : forall meth ty,
In meth l' ->
(forall arg, NeverCallActionT (projT2 (snd meth) ty arg)))
(HDisjMeths : DisjKey l l')
(HNoCall : forall rule ty,
In rule lr ->
NoCallActionT l (snd rule ty)),
inlineAll_Rules (l ++ l') lr = map (inline_Rules l' (seq 0 (length l'))) lr /\
(forall rule ty,
In rule (map (inline_Rules l' (seq 0 (length l'))) lr) ->
NoCallActionT l (snd rule ty)).
Proof.
intros; split.
- rewrite inlineAll_Rules_NoCalls; auto.
unfold inlineAll_Rules at 2.
erewrite inlineSome_Rules_pos_NoCalls_ident; eauto using SubList_refl.
apply inlineAll_Rules_in.
- intros; rewrite in_map_iff in *; dest; subst; destruct x; simpl in *.
apply NeverCall_inlineSome_pos_persistent; auto.
apply (HNoCall _ _ H0).
Qed.
Lemma inlineSingle_pos_app_l (l1 l2 : list DefMethT) ty k (a : ActionT ty k) :
forall n,
n < length l1 ->
inlineSingle_pos (l1 ++ l2) a n = inlineSingle_pos l1 a n.
Proof.
intros; unfold inlineSingle_pos.
remember (nth_error (l1 ++ l2) n) as nth_err0.
destruct nth_err0; rewrite nth_error_app1 in Heqnth_err0; auto; rewrite <- Heqnth_err0; reflexivity.
Qed.
Lemma inlineSingle_pos_app_r (l1 l2 : list DefMethT) ty k (a : ActionT ty k) :
forall n,
length l1 <= n ->
inlineSingle_pos (l1 ++ l2) a n = inlineSingle_pos l2 a (n - length l1).
Proof.
intros; unfold inlineSingle_pos.
remember (nth_error (l1 ++ l2) n) as nth_err0.
destruct nth_err0; rewrite nth_error_app2 in Heqnth_err0; auto; rewrite <- Heqnth_err0; reflexivity.
Qed.
Lemma inlineSome_pos_app_l (l1 l2 : list DefMethT) ty k (a : ActionT ty k) n :
n <= length l1 ->
fold_left (inlineSingle_pos (l1 ++ l2)) (seq 0 n) a = fold_left (inlineSingle_pos l1) (seq 0 n) a.
Proof.
induction n; auto; intros.
rewrite seq_eq; repeat rewrite fold_left_app; simpl.
rewrite inlineSingle_pos_app_l; [|lia].
rewrite IHn; auto; lia.
Qed.
Lemma inlineSome_pos_app_r (l1 l2 : list DefMethT) ty k (a : ActionT ty k) n :
fold_left (inlineSingle_pos (l1 ++ l2)) (seq (length l1) n) a
= fold_left (inlineSingle_pos l2) (seq 0 n) a.
Proof.
induction n; auto; intros.
repeat rewrite seq_eq; repeat rewrite fold_left_app; simpl.
rewrite inlineSingle_pos_app_r; [|lia].
rewrite IHn, minus_plus; reflexivity.
Qed.
Lemma inlineSome_pos_app (l1 l2 : list DefMethT) ty k (a : ActionT ty k) :
forall n m,
n = length l1 ->
m = length l2 ->
fold_left (inlineSingle_pos (l1 ++ l2)) (seq 0 (n + m)) a =
fold_left (inlineSingle_pos l2) (seq 0 m) (fold_left (inlineSingle_pos l1) (seq 0 n) a).
Proof.
intros.
assert (n <= length (l1 ++ l2)) as P0.
{ rewrite app_length; lia. }
rewrite H, H0, <- app_length.
rewrite (seq_app' _ P0), fold_left_app, app_length, H, minus_plus, plus_O_n.
rewrite inlineSome_pos_app_r, inlineSome_pos_app_l; auto.
Qed.
Lemma SameKeys_inlineSingle_Flat meths1 meths2 n :
map fst (inlineSingle_Flat_pos meths1 meths2 n) = map fst meths2.
Proof.
unfold inlineSingle_Flat_pos; destruct nth_error; auto.
apply inline_preserves_keys_Meth.
Qed.
Lemma SameKeys_inlineSome_Flat xs :
forall meths1 meths2,
map fst (fold_left (inlineSingle_Flat_pos meths1) xs meths2) = map fst meths2.
Proof.
induction xs; simpl; auto; intros.
rewrite IHxs, SameKeys_inlineSingle_Flat; reflexivity.
Qed.
Lemma SameKindAttrs_inlineSingle_Flat meths1 meths2 n :
getKindAttr (inlineSingle_Flat_pos meths1 meths2 n) = getKindAttr meths2.
Proof.
unfold inlineSingle_Flat_pos; destruct nth_error; auto.
apply inline_preserves_KindAttrs_Meth.
Qed.
Lemma SameKindAttrs_inlineSome_Flat xs :
forall meths1 meths2,
getKindAttr (fold_left (inlineSingle_Flat_pos meths1) xs meths2) = getKindAttr meths2.
Proof.
induction xs; simpl; auto; intros.
rewrite IHxs, SameKindAttrs_inlineSingle_Flat; reflexivity.
Qed.
Lemma UpdOrMeths_RegsT_app (uml1 uml2 : UpdOrMeths) :
UpdOrMeths_RegsT (uml1 ++ uml2) = UpdOrMeths_RegsT uml1 ++ UpdOrMeths_RegsT uml2.
Proof.
induction uml1; simpl; auto.
destruct a; simpl; auto.
rewrite IHuml1; reflexivity.
Qed.
Lemma UpdOrMeths_MethsT_app (uml1 uml2 : UpdOrMeths) :
UpdOrMeths_MethsT (uml1 ++ uml2) = UpdOrMeths_MethsT uml1 ++ UpdOrMeths_MethsT uml2.
Proof.
induction uml1; simpl; auto.
destruct a; simpl; auto.
rewrite IHuml1; reflexivity.
Qed.
Lemma SemCompActionEEquivWMap (k : Kind) (ea : EActionT type k):
forall o calls retl bexpr v' v expr1 expr2,
SemRegMapExpr expr1 v ->
SemRegMapExpr expr2 v ->
SemCompActionT (EcompileAction o ea bexpr expr1) v' calls retl ->
SemCompActionT (EcompileAction o ea bexpr expr2) v' calls retl.
Proof.
induction ea; intros; simpl in *; eauto.
- inv H2; EqDep_subst; [econstructor 1 | econstructor 2]; eauto.
- inv H2; EqDep_subst; econstructor; eauto.
- inv H2; EqDep_subst; econstructor; eauto.
- inv H2; EqDep_subst; econstructor; eauto.
- inv H2; EqDep_subst; econstructor; eauto.
- inv H1; simpl in *; EqDep_subst; rewrite unifyWO in *.
inv HSemCompActionT_a; EqDep_subst.
econstructor; eauto.
inv HRegMapWf.
repeat econstructor; auto.
inv H1; EqDep_subst; [econstructor 2| econstructor 3]; eauto;
erewrite SemRegExprVals; eauto.
- inv H2; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; simpl in *; EqDep_subst.
inv HSemCompActionT_cont0; simpl in *; EqDep_subst.
repeat (econstructor; eauto).
- inv H1; EqDep_subst; econstructor; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
inv HRegMapWf; constructor; auto.
erewrite SemRegExprVals; eauto.
- inv H2; EqDep_subst; econstructor; eauto.
rewrite (SemRegExprVals H0 HWriteMap); assumption.
- inv H1; EqDep_subst;[econstructor 10 | econstructor 11]; eauto; inv HUpdate; inv H1;
EqDep_subst; econstructor; eauto.
+ econstructor 2; eauto.
erewrite SemRegExprVals; eauto.
+ econstructor 3; eauto.
erewrite SemRegExprVals; eauto.
+ econstructor 2; eauto.
erewrite SemRegExprVals; eauto.
+ econstructor 3; eauto.
erewrite SemRegExprVals; eauto.
- inv H1; EqDep_subst; inv HWriteMap; inv H1; EqDep_subst.
+ repeat (econstructor; eauto).
erewrite SemRegExprVals; eauto.
+ do 2 (econstructor; eauto).
econstructor 3; eauto.
erewrite SemRegExprVals; eauto.
+ do 3 (econstructor; eauto).
erewrite SemRegExprVals; eauto.
+ do 2 (econstructor; eauto).
econstructor 3; eauto.
erewrite SemRegExprVals; eauto.
- inv H2; EqDep_subst;[econstructor 14 | econstructor 15]; eauto;
rewrite (SemRegExprVals H0 HWriteMap); eauto.
Qed.
Lemma SemCompActionEEquivBexpr (k : Kind) (ea : EActionT type k):
forall o calls retl expr1 v' (bexpr1 bexpr2 : Bool @# type),
evalExpr bexpr1 = evalExpr bexpr2 ->
SemCompActionT (EcompileAction o ea bexpr1 expr1) v' calls retl ->
SemCompActionT (EcompileAction o ea bexpr2 expr1) v' calls retl.
Proof.
induction ea; intros; simpl in *; eauto.
- inv H1; EqDep_subst; [econstructor 1| econstructor 2]; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
- inv H0; simpl in *; EqDep_subst.
econstructor; eauto.
rewrite (unifyWO val_a) in HSemCompActionT_a.
inv HSemCompActionT_a; EqDep_subst.
econstructor; eauto.
inv HRegMapWf; destruct regMap_a.
split; auto.
destruct (bool_dec (evalExpr bexpr2) true).
inv H0; EqDep_subst.
+ econstructor 2; eauto.
+ congruence.
+ inv H0; EqDep_subst.
* congruence.
* econstructor 3; eauto.
- inv H1; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; simpl in *; EqDep_subst.
do 3 econstructor.
+ eapply IHea1 with (bexpr1 := (Var type (SyntaxKind Bool)
(evalExpr bexpr1 && evalExpr e))); eauto.
simpl; rewrite H0; reflexivity.
+ reflexivity.
+ econstructor.
* eapply IHea2 with (bexpr1 := (Var type (SyntaxKind Bool)
(evalExpr (bexpr2 && ! e)%kami_expr))); eauto.
simpl; rewrite <- H0; eauto.
* reflexivity.
* econstructor; simpl.
eapply H; eauto.
- inv H0; EqDep_subst.
econstructor; eauto.
- inv H1; EqDep_subst.
econstructor; eauto.
- inv H0; EqDep_subst.
econstructor; eauto.
+ unfold WfRegMapExpr in *; dest; split; auto.
inv H0; EqDep_subst.
* econstructor; rewrite H in *; eauto.
* econstructor 3; rewrite H in *; eauto.
+ econstructor 11; eauto.
unfold WfRegMapExpr in *; dest; split; auto.
inv H0; EqDep_subst.
* econstructor; rewrite H in *; eauto.
* econstructor 3; rewrite H in *; eauto.
- inv H0; EqDep_subst.
econstructor; eauto.
+ unfold WfRegMapExpr in *; dest; split; auto.
inv H0; EqDep_subst.
* econstructor; rewrite H in *; eauto.
* econstructor 3; rewrite H in *; eauto.
+ econstructor 13; eauto.
unfold WfRegMapExpr in *; dest; split; auto.
inv H0; EqDep_subst.
* econstructor; rewrite H in *; eauto.
* econstructor 3; rewrite H in *; eauto.
- inv H1; EqDep_subst; [econstructor | econstructor 15]; eauto.
Qed.
Lemma SemCompActionEquivBexpr (k : Kind) (a : ActionT type k):
forall o calls retl expr1 v' (bexpr1 bexpr2 : Bool @# type),
evalExpr bexpr1 = evalExpr bexpr2 ->
SemCompActionT (compileAction o a bexpr1 expr1) v' calls retl ->
SemCompActionT (compileAction o a bexpr2 expr1) v' calls retl.
Proof.
induction a; intros; simpl in *; eauto.
- inv H1; EqDep_subst; [econstructor 1| econstructor 2]; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
- inv H1; EqDep_subst; econstructor; eauto.
- inv H0; simpl in *; EqDep_subst.
econstructor; eauto.
rewrite (unifyWO val_a) in HSemCompActionT_a.
inv HSemCompActionT_a; EqDep_subst.
econstructor; eauto.
inv HRegMapWf; destruct regMap_a.
split; auto.
destruct (bool_dec (evalExpr bexpr2) true).
inv H0; EqDep_subst.
+ econstructor 2; eauto.
+ congruence.
+ inv H0; EqDep_subst.
* congruence.
* econstructor 3; eauto.
- inv H1; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; simpl in *; EqDep_subst.
do 3 econstructor.
+ eapply IHa1 with (bexpr1 := (Var type (SyntaxKind Bool)
(evalExpr (bexpr2 && e)%kami_expr))); eauto.
simpl; rewrite <- H0; eauto.
+ reflexivity.
+ econstructor.
* eapply IHa2 with (bexpr1 := (Var type (SyntaxKind Bool)
(evalExpr (bexpr2 && ! e)%kami_expr)));eauto.
simpl; rewrite <-H0; eauto.
* reflexivity.
* econstructor; simpl.
eapply H; eauto.
- inv H0; EqDep_subst.
econstructor; eauto.
Qed.
Lemma EpredFalse_UpdsNil k ea :
forall (bexpr: Bool @# type) o u regMap1 regMap2 calls val
(HNbexpr : evalExpr bexpr = false) rexpr (HRegMap : SemRegMapExpr rexpr regMap1),
@SemCompActionT k (EcompileAction (o, u) ea bexpr rexpr) regMap2 calls val ->
regMap1 = regMap2 /\ calls = nil.
Proof.
induction ea; intros.
- inv H0; EqDep_subst;[congruence|eauto].
- inv H0; EqDep_subst; eauto.
- inv H0; EqDep_subst; eauto.
specialize (IHea _ _ _ _ _ _ _ HNbexpr _ HRegMap HSemCompActionT_a); dest.
rewrite H0 in HRegMap.
specialize (H _ _ _ _ _ _ _ _ HNbexpr _ (SemVarRegMap _) HSemCompActionT_cont); dest.
split; subst; auto.
- inv H0; EqDep_subst; eauto.
- inv H0; EqDep_subst; eauto.
- inv H; simpl in *; EqDep_subst; eauto.
rewrite (unifyWO val_a) in HSemCompActionT_a.
inv HSemCompActionT_a; EqDep_subst.
inv HRegMapWf; inv H; EqDep_subst;[congruence|].
specialize (IHea _ _ _ _ _ _ _ HNbexpr _ (SemVarRegMap _) HSemCompActionT_cont); dest.
rewrite (SemRegExprVals HRegMap HSemRegMap); auto.
- inv H0; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; EqDep_subst.
apply Eqdep.EqdepTheory.inj_pair2 in H4; subst; simpl in *.
assert (forall (b : Expr type (SyntaxKind Bool)),
(evalExpr (Var type (SyntaxKind Bool) (evalExpr bexpr && evalExpr b)) = false)).
{ intros; simpl; rewrite HNbexpr; auto. }
specialize (IHea1 _ _ _ _ _ _ _ (H0 e) _ HRegMap HSemCompActionT_a); dest.
specialize (IHea2 _ _ _ _ _ _ _ (H0 (!e)%kami_expr) _ (SemVarRegMap _) HSemCompActionT_a0); dest.
specialize (H _ _ _ _ _ _ _ _ HNbexpr _ (SemVarRegMap _) HSemCompActionT); dest.
subst; auto.
- inv H; EqDep_subst; eauto.
- inv H; EqDep_subst.
inv HRegMapWf.
rewrite (SemRegExprVals HRegMap H); auto.
- inv H0; EqDep_subst; eauto;
eapply H with (rexpr := VarRegMap type writeMapTy); eauto;
assert (sth: regMap1 = writeMapTy) by
(eapply SemRegExprVals; eauto);
subst;
econstructor.
- inv H; EqDep_subst; eauto; unfold WfRegMapExpr in *; dest;
inv H; EqDep_subst; [rewrite HNbexpr in *; discriminate| | rewrite HNbexpr in *; discriminate | ];
specialize (IHea _ _ _ _ _ _ _ HNbexpr _ (SemVarRegMap _) HSemCompActionT); dest; subst;
rewrite (SemRegExprVals HSemRegMap HRegMap); split; auto.
- inv H; EqDep_subst; eauto; unfold WfRegMapExpr in *; dest;
inv H; EqDep_subst; [rewrite HNbexpr in *; discriminate| | rewrite HNbexpr in *; discriminate | ];
specialize (IHea _ _ _ _ _ _ _ HNbexpr _ (SemVarRegMap _) HSemCompActionT); dest; subst;
rewrite (SemRegExprVals HSemRegMap HRegMap); split; auto.
- inv H0; EqDep_subst; eauto;
eapply H with (rexpr := VarRegMap type writeMapTy); eauto; unfold WfRegMapExpr in *; dest;
assert (sth: regMap1 = writeMapTy) by
(eapply SemRegExprVals; eauto);
subst;
econstructor.
Qed.
Lemma predFalse_UpdsNil k a:
forall (bexpr: Bool @# type) o u regMap1 regMap2 calls val
(HNbexpr : evalExpr bexpr = false) rexpr (HRegMap : SemRegMapExpr rexpr regMap1),
@SemCompActionT k (compileAction (o, u) a bexpr rexpr) regMap2 calls val ->
regMap1 = regMap2 /\ calls = nil.
Proof.
induction a; intros.
- inv H0; EqDep_subst;[congruence|eauto].
- inv H0; EqDep_subst; eauto.
- inv H0; EqDep_subst; eauto.
specialize (IHa _ _ _ _ _ _ _ HNbexpr _ HRegMap HSemCompActionT_a); dest.
rewrite H0 in HRegMap.
specialize (H _ _ _ _ _ _ _ _ HNbexpr _ (SemVarRegMap _) HSemCompActionT_cont); dest.
split; subst; auto.
- inv H0; EqDep_subst; eauto.
- inv H0; EqDep_subst; eauto.
- inv H; simpl in *; EqDep_subst; eauto.
rewrite (unifyWO val_a) in HSemCompActionT_a.
inv HSemCompActionT_a; EqDep_subst.
inv HRegMapWf; inv H; EqDep_subst;[congruence|].
specialize (IHa _ _ _ _ _ _ _ HNbexpr _ (SemVarRegMap _) HSemCompActionT_cont); dest.
rewrite (SemRegExprVals HRegMap HSemRegMap); auto.
- inv H0; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; EqDep_subst.
apply Eqdep.EqdepTheory.inj_pair2 in H4; subst; simpl in *.
assert (forall (b : Expr type (SyntaxKind Bool)),
(evalExpr (Var type (SyntaxKind Bool) (evalExpr bexpr && evalExpr b)) = false)).
{ intros; simpl; rewrite HNbexpr; auto. }
specialize (IHa1 _ _ _ _ _ _ _ (H0 e) _ HRegMap HSemCompActionT_a); dest.
specialize (IHa2 _ _ _ _ _ _ _ (H0 (!e)%kami_expr) _ (SemVarRegMap _) HSemCompActionT_a0); dest.
specialize (H _ _ _ _ _ _ _ _ HNbexpr _ (SemVarRegMap _) HSemCompActionT); dest.
subst; auto.
- inv H; EqDep_subst; eauto.
- inv H; EqDep_subst.
inv HRegMapWf.
rewrite (SemRegExprVals HRegMap H); auto.
Qed.
Lemma ESameOldAction (k : Kind) (ea : EActionT type k) :
forall oInit uInit writeMap old upds wOld wUpds calls retl bexpr
(HSemRegMap : SemRegMapExpr writeMap (wOld, wUpds)),
@SemCompActionT k (EcompileAction (oInit, uInit) ea bexpr writeMap) (old, upds) calls retl ->
wOld = old.
Proof.
induction ea; intros; simpl in *.
- inv H0; EqDep_subst; simpl in *; eapply H; eauto.
- inv H0; EqDep_subst; simpl in *.
eapply H; eauto.
- inv H0; EqDep_subst; simpl in *.
destruct regMap_a.
specialize (H _ _ _ _ _ _ _ _ _ _ _ (SemVarRegMap _) HSemCompActionT_cont); subst.
specialize (IHea _ _ _ _ _ _ _ _ _ _ HSemRegMap HSemCompActionT_a); assumption.
- inv H0; EqDep_subst; simpl in *.
eapply H; eauto.
- inv H0; EqDep_subst; simpl in *.
eapply H; eauto.
- inv H; simpl in *; EqDep_subst.
rewrite (unifyWO val_a) in HSemCompActionT_a.
inv HSemCompActionT_a; EqDep_subst.
destruct regMap_a; unfold WfRegMapExpr in *; dest.
inv H; EqDep_subst.
+ specialize (IHea _ _ _ _ _ _ _ _ _ _ (SemVarRegMap _) HSemCompActionT_cont).
specialize (SemRegExprVals HSemRegMap HSemRegMap0) as TMP; inv TMP.
reflexivity.
+ specialize (IHea _ _ _ _ _ _ _ _ _ _ (SemVarRegMap _) HSemCompActionT_cont).
specialize (SemRegExprVals HSemRegMap HSemRegMap0) as TMP; inv TMP.
reflexivity.
- inv H0; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; simpl in *; EqDep_subst.
destruct regMap_a, regMap_a0.
specialize (H _ _ _ _ _ _ _ _ _ _ _ (SemVarRegMap _) HSemCompActionT).
simpl in *.
specialize (IHea1 _ _ _ _ _ _ _ _ _ _ HSemRegMap HSemCompActionT_a).
specialize (IHea2 _ _ _ _ _ _ _ _ _ _ (SemVarRegMap _) HSemCompActionT_a0).
subst; reflexivity.
- inv H; EqDep_subst; simpl in *.
eapply IHea; eauto.
- inv H; EqDep_subst.
unfold WfRegMapExpr in *; dest.
specialize (SemRegExprVals H HSemRegMap) as TMP; inv TMP.
reflexivity.
- inv H0; EqDep_subst.
eapply H with (writeMap := VarRegMap type writeMapTy); eauto;
assert (sth: writeMapTy = (wOld, wUpds)) by
(eapply SemRegExprVals; eauto);
subst;
econstructor.
- inv H; EqDep_subst; unfold WfRegMapExpr in *; destruct regMapVal; dest;
specialize (IHea _ _ _ _ _ _ _ _ _ _ (SemVarRegMap _) HSemCompActionT); subst;
inv H; EqDep_subst; specialize (SemRegExprVals HSemRegMap HSemRegMap0) as TMP; inv TMP; reflexivity.
- inv H; EqDep_subst; unfold WfRegMapExpr in *; destruct regMapVal; dest;
specialize (IHea _ _ _ _ _ _ _ _ _ _ (SemVarRegMap _) HSemCompActionT); subst;
inv H; EqDep_subst; specialize (SemRegExprVals HSemRegMap HSemRegMap0) as TMP; inv TMP; reflexivity.
- inv H0; EqDep_subst;
eapply H with (writeMap := VarRegMap type writeMapTy); eauto;
assert (sth: writeMapTy = (wOld, wUpds)) by
(eapply SemRegExprVals; eauto);
subst;
econstructor.
Qed.
Lemma EEquivActions k ea:
forall writeMap o old upds oInit uInit
(HoInitNoDups : NoDup (map fst oInit))
(HuInitNoDups : forall u, In u uInit -> NoDup (map fst u))
(HPriorityUpds : PriorityUpds oInit uInit o)
(HConsistent : getKindAttr o = getKindAttr old)
(WfMap : WfRegMapExpr writeMap (old, upds)),
forall calls retl upds',
@SemCompActionT k (EcompileAction (oInit, uInit) ea (Const type true) writeMap) upds' calls retl ->
(forall u, In u (snd upds') -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old)) /\
exists uml,
upds' = (old, match (UpdOrMeths_RegsT uml) with
|nil => upds
|_ :: _ => (hd nil upds ++ (UpdOrMeths_RegsT uml)) :: tl upds
end) /\
calls = (UpdOrMeths_MethsT uml) /\
ESemAction o ea uml retl.
Proof.
induction ea; subst; intros; simpl in *.
- inv H0; EqDep_subst;[|discriminate].
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists (UmMeth (meth, existT SignT s (evalExpr e, ret))::x); repeat split; simpl; subst; auto.
econstructor; eauto.
- inv H0; EqDep_subst.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists x; repeat split; auto.
econstructor; eauto.
- inv H0; EqDep_subst.
specialize (IHea _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT_a); dest.
assert (WfRegMapExpr (VarRegMap type regMap_a) regMap_a) as WfMap0.
{ unfold WfRegMapExpr; split;[econstructor|].
destruct regMap_a; inv H1; intros.
apply (H0 _ H1).
}
rewrite H1 in *.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap0 _ _ _ HSemCompActionT_cont); dest.
split; auto.
exists (x++x0); rewrite UpdOrMeths_RegsT_app, UpdOrMeths_MethsT_app; repeat split; auto.
+ destruct (UpdOrMeths_RegsT x0); simpl in *; auto.
* rewrite app_nil_r; assumption.
* destruct (UpdOrMeths_RegsT x); simpl in *; auto.
rewrite app_comm_cons, app_assoc; assumption.
+ subst; auto.
+ econstructor; eauto.
rewrite H4 in H; simpl in *.
clear - H.
destruct (UpdOrMeths_RegsT x0), (UpdOrMeths_RegsT x); eauto using DisjKey_nil_r, DisjKey_nil_l; simpl in *.
specialize (H _ (or_introl _ eq_refl)); simpl in *; dest.
repeat rewrite map_app in H.
intro k.
destruct (In_dec string_dec k (map fst (p0::r0))); auto.
right; intro.
destruct (NoDup_app_Disj string_dec _ _ H k); auto.
apply H2; rewrite in_app_iff; right; auto.
- inv H0; EqDep_subst.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists x; repeat split; auto.
econstructor; eauto.
- inv H0; EqDep_subst.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists x.
repeat split; simpl; auto.
econstructor; eauto.
inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
- inv H; simpl in *; EqDep_subst.
rewrite (unifyWO val_a) in HSemCompActionT_a.
inv HSemCompActionT_a; EqDep_subst.
destruct HRegMapWf, WfMap, regMap_a.
inv H;[|discriminate]; EqDep_subst.
specialize (SemRegExprVals H1 HSemRegMap) as P0; inv P0.
assert (WfRegMapExpr (VarRegMap type (r0, (hd nil upds0 ++ (r, existT (fullType type) k (evalExpr e)) :: nil) :: tl upds0))
(r0, (hd nil upds0 ++ (r, existT (fullType type) k (evalExpr e)) :: nil) :: tl upds0)) as WfMap0.
{ split; auto. constructor. }
specialize (IHea _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap0 _ _ _ HSemCompActionT_cont);
dest; simpl in *; split; auto.
exists ((UmUpd (r, existT (fullType type) k (evalExpr e))):: x); repeat split; auto.
+ simpl; destruct (UpdOrMeths_RegsT x); simpl in *; auto.
rewrite <- app_assoc in H3. rewrite <-app_comm_cons in H3.
simpl in H3; auto.
+ simpl; econstructor; eauto.
* rewrite H3 in H.
destruct (UpdOrMeths_RegsT x); simpl in *; rewrite HConsistent; eapply H; simpl; eauto;
repeat rewrite map_app, in_app_iff; [right | left]; simpl; auto.
* repeat intro.
rewrite H3 in H.
destruct (UpdOrMeths_RegsT x); simpl in *; auto.
destruct H7; subst; simpl in *; specialize (H _ (or_introl eq_refl)); dest; repeat rewrite map_app, NoDup_app_iff in H; simpl in *; dest.
-- apply (H7 r); clear.
rewrite in_app_iff; simpl; right; left; reflexivity.
left; reflexivity.
-- apply (H8 r); clear - H7.
++ rewrite in_app_iff; right; left; reflexivity.
++ right; rewrite in_map_iff; exists (r, v); split; auto.
- inv H0; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; EqDep_subst.
remember (evalExpr e) as P0.
apply Eqdep.EqdepTheory.inj_pair2 in H4.
rewrite H4 in *.
clear H4; simpl in *.
rewrite HeqP0 in HSemCompActionT_a, HSemCompActionT_a0.
destruct P0; rewrite <- HeqP0 in *; simpl in *.
+ assert (forall b, (evalExpr (Var type (SyntaxKind Bool) b) = (evalExpr (Const type b)))) as Q0; auto.
specialize (SemCompActionEEquivBexpr _ _ _ _ _ (Q0 false) HSemCompActionT_a0) as Q1.
specialize (SemCompActionEEquivBexpr _ _ _ _ _ (Q0 true) HSemCompActionT_a) as Q2.
specialize (IHea1 _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ Q2); dest.
assert (evalExpr (Const type false) = false) as Q3; auto.
destruct (EpredFalse_UpdsNil _ _ _ _ Q3 (SemVarRegMap regMap_a) Q1).
assert (WfRegMapExpr (VarRegMap type regMap_a0) regMap_a0) as P7.
{ unfold WfRegMapExpr; split; [constructor|]. subst; eauto. }
rewrite <- H4 in P7 at 2.
rewrite H1 in P7.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent P7 _ _ _ HSemCompActionT); dest.
split; auto.
exists (x ++ x0); rewrite UpdOrMeths_RegsT_app, UpdOrMeths_MethsT_app; repeat split; auto.
* destruct (UpdOrMeths_RegsT x0); simpl; auto.
-- rewrite app_nil_r; auto.
-- destruct (UpdOrMeths_RegsT x); simpl in *; auto.
rewrite app_comm_cons, app_assoc; assumption.
* subst; reflexivity.
* econstructor; eauto.
rewrite H6 in H; destruct (UpdOrMeths_RegsT x), (UpdOrMeths_RegsT x0); intro; simpl in *; auto.
clear - H.
specialize (H _ (or_introl _ (eq_refl))); dest.
rewrite map_app in H.
destruct (NoDup_app_Disj string_dec _ _ H k0); auto.
left; intro; apply H1.
rewrite map_app, in_app_iff; auto.
+ assert (forall b, (evalExpr (Var type (SyntaxKind Bool) b) =
(evalExpr (Const type b)))) as Q0; auto.
remember WfMap as WfMap0.
inv WfMap0.
assert (evalExpr (Var type (SyntaxKind Bool) false) = false) as Q1; auto.
destruct (EpredFalse_UpdsNil _ _ _ _ Q1 H0 HSemCompActionT_a).
assert (WfRegMapExpr (VarRegMap type regMap_a) (old, upds)) as WfMap0.
{ rewrite <- H2.
clear - WfMap.
unfold WfRegMapExpr in *; dest; repeat split;[constructor| |]; eapply H0; eauto.
}
specialize (SemCompActionEEquivBexpr _ _ _ _ _ (Q0 true) HSemCompActionT_a0) as Q2.
specialize (IHea2 _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap0 _ _ _ Q2); dest.
assert (WfRegMapExpr (VarRegMap type regMap_a0) regMap_a0) as P7.
{ unfold WfRegMapExpr; split; [constructor|]. subst; eauto. }
rewrite H5 in P7 at 2.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent P7 _ _ _ HSemCompActionT); dest.
split; auto.
exists (x ++ x0); rewrite UpdOrMeths_RegsT_app, UpdOrMeths_MethsT_app; repeat split; auto.
* destruct (UpdOrMeths_RegsT x0); simpl; auto.
-- rewrite app_nil_r; auto.
-- destruct (UpdOrMeths_RegsT x); simpl in *; auto.
rewrite app_comm_cons, app_assoc; assumption.
* subst; reflexivity.
* econstructor 8; eauto.
rewrite H8 in H; destruct (UpdOrMeths_RegsT x), (UpdOrMeths_RegsT x0); intro; simpl in *; auto.
clear - H.
specialize (H _ (or_introl _ (eq_refl))); dest.
rewrite map_app in H.
destruct (NoDup_app_Disj string_dec _ _ H k0); auto.
left; intro; apply H1.
rewrite map_app, in_app_iff; auto.
- inv H; EqDep_subst.
specialize (IHea _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists x.
repeat split; auto.
econstructor; eauto.
- inv H; EqDep_subst.
inv WfMap; inv HRegMapWf.
specialize (SemRegExprVals H H1) as TMP; subst; simpl in *.
split; auto.
exists nil.
repeat split; auto.
constructor; auto.
- inv H0; EqDep_subst.
apply (SemCompActionEEquivWMap _ _ _ (SemVarRegMap _) HWriteMap) in HSemCompActionT.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest.
split; auto.
exists x.
repeat split; auto.
econstructor; eauto.
inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
- inv H; EqDep_subst; destruct regMapVal; simpl in *.
+ unfold WfRegMapExpr in *; dest.
inv H; EqDep_subst; [|discriminate].
specialize (SemRegExprVals H1 HSemRegMap) as TMP; inv TMP.
assert (WfRegMapExpr (VarRegMap type
(r,
(hd [] upds0 ++
[(dataArray,
existT (fullType type) (SyntaxKind (Array idxNum Data))
(evalExpr
(fold_left
(fun (newArr : Expr type (SyntaxKind (Array idxNum Data))) (i : Fin.t num) =>
(IF ReadArrayConst mask0 i then newArr @[ idx + Const type (natToWord (Nat.log2_up idxNum) (proj1_sig (to_nat i))) <- ReadArrayConst val i] else newArr)%kami_expr)
(getFins num) (Var type (SyntaxKind (Array idxNum Data)) regVal))))]) :: tl upds0))
(r,
(hd [] upds0 ++
[(dataArray,
existT (fullType type) (SyntaxKind (Array idxNum Data))
(evalExpr
(fold_left
(fun (newArr : Expr type (SyntaxKind (Array idxNum Data))) (i : Fin.t num) =>
(IF ReadArrayConst mask0 i then newArr @[ idx + Const type (natToWord (Nat.log2_up idxNum)(proj1_sig (to_nat i))) <- ReadArrayConst val i] else newArr)%kami_expr)
(getFins num) (Var type (SyntaxKind (Array idxNum Data)) regVal))))]) :: tl upds0)) as P0.
{ unfold WfRegMapExpr in *; dest; split; auto; constructor. }
specialize (IHea _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent P0 _ _ _ HSemCompActionT); dest; split; auto.
exists (UmUpd (dataArray,
existT (fullType type) (SyntaxKind (Array idxNum Data))
(evalExpr
(fold_left
(fun (newArr : Expr type (SyntaxKind (Array idxNum Data))) (i : Fin.t num) =>
(IF ReadArrayConst mask0 i then newArr @[ idx + Const type (natToWord (Nat.log2_up idxNum)(proj1_sig (to_nat i))) <- ReadArrayConst val i] else newArr)%kami_expr)
(getFins num) (Var type (SyntaxKind (Array idxNum Data)) regVal))))::x).
repeat split; auto.
* simpl in *.
clear - H3.
destruct (UpdOrMeths_RegsT x); auto.
rewrite <- app_assoc in H3; simpl in *; assumption.
* econstructor; eauto.
-- inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
-- rewrite H3 in H.
clear - H.
destruct (UpdOrMeths_RegsT x); repeat intro; auto.
specialize (H _ (or_introl eq_refl)).
simpl in H; repeat rewrite map_app in H; simpl in *.
rewrite NoDup_app_iff in H; dest; apply (H3 dataArray); destruct H0; subst; simpl; auto.
++ rewrite in_app_iff; right; simpl; left; auto.
++ rewrite in_app_iff; right; simpl; left; auto.
++ right; rewrite in_map_iff; exists (dataArray, v); auto.
+ unfold WfRegMapExpr in *; dest.
inv H; EqDep_subst; [|discriminate].
specialize (SemRegExprVals H1 HSemRegMap) as TMP; inv TMP.
assert (WfRegMapExpr (VarRegMap type
(r,
(hd [] upds0 ++
[(dataArray,
existT (fullType type) (SyntaxKind (Array idxNum Data))
(evalExpr
(fold_left
(fun (newArr : Expr type (SyntaxKind (Array idxNum Data))) (i : Fin.t num) =>
(newArr @[ idx + Const type (natToWord (Nat.log2_up idxNum) (proj1_sig (to_nat i))) <- ReadArrayConst val i])%kami_expr) (getFins num)
(Var type (SyntaxKind (Array idxNum Data)) regVal))))]) :: tl upds0))
(r,
(hd [] upds0 ++
[(dataArray,
existT (fullType type) (SyntaxKind (Array idxNum Data))
(evalExpr
(fold_left
(fun (newArr : Expr type (SyntaxKind (Array idxNum Data))) (i : Fin.t num) =>
(newArr @[ idx + Const type (natToWord (Nat.log2_up idxNum)(proj1_sig (to_nat i))) <- ReadArrayConst val i])%kami_expr) (getFins num)
(Var type (SyntaxKind (Array idxNum Data)) regVal))))]) :: tl upds0)) as P0.
{ unfold WfRegMapExpr in *; dest; split; auto; constructor. }
specialize (IHea _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent P0 _ _ _ HSemCompActionT); dest; split; auto.
exists (UmUpd (dataArray,
existT (fullType type) (SyntaxKind (Array idxNum Data))
(evalExpr
(fold_left
(fun (newArr : Expr type (SyntaxKind (Array idxNum Data))) (i : Fin.t num) =>
(newArr @[ idx + Const type (natToWord (Nat.log2_up idxNum)(proj1_sig (to_nat i))) <- ReadArrayConst val i])%kami_expr) (getFins num)
(Var type (SyntaxKind (Array idxNum Data)) regVal))))::x).
repeat split; auto.
* simpl in *.
clear - H3.
destruct (UpdOrMeths_RegsT x); auto.
rewrite <- app_assoc in H3; simpl in *; assumption.
* econstructor 13; eauto.
-- inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
-- rewrite H3 in H.
clear - H.
destruct (UpdOrMeths_RegsT x); repeat intro; auto.
specialize (H _ (or_introl eq_refl)).
simpl in H; repeat rewrite map_app in H; simpl in *.
rewrite NoDup_app_iff in H; dest; apply (H3 dataArray); destruct H0; subst; simpl; auto.
++ rewrite in_app_iff; right; simpl; left; auto.
++ rewrite in_app_iff; right; simpl; left; auto.
++ right; rewrite in_map_iff; exists (dataArray, v); auto.
- inv H; EqDep_subst.
+ unfold WfRegMapExpr in *; dest.
inv H; EqDep_subst; [|discriminate].
specialize (SemRegExprVals H1 HSemRegMap) as TMP; inv TMP.
assert (WfRegMapExpr (VarRegMap type
(old0,
(hd [] upds0 ++
[(readReg,
existT (fullType type) (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr (Var type (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr idx))))])
:: tl upds0))
(old0,
(hd [] upds0 ++
[(readReg,
existT (fullType type) (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr (Var type (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr idx))))])
:: tl upds0)) as P0.
{ unfold WfRegMapExpr in *; dest; split; auto; constructor. }
specialize (IHea _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent P0 _ _ _ HSemCompActionT); dest; split; auto.
exists (UmUpd (readReg, existT (fullType type) (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr (Var type (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr idx))))::x).
repeat split; auto.
* simpl in *.
clear - H3.
destruct (UpdOrMeths_RegsT x); auto.
rewrite <- app_assoc in H3; simpl in *; assumption.
* econstructor; eauto.
-- rewrite H3 in H.
rewrite HConsistent.
clear - H.
simpl in *.
destruct (UpdOrMeths_RegsT x); simpl in *; specialize (H _ (or_introl eq_refl)); dest;
apply H0; repeat rewrite map_app, in_app_iff; [right| left; right]; left; auto.
-- rewrite H3 in H.
clear - H.
simpl in *.
destruct (UpdOrMeths_RegsT x); simpl in *; specialize (H _ (or_introl eq_refl)); dest; repeat intro; auto.
repeat rewrite map_app in H; simpl in *.
rewrite NoDup_app_iff in H; dest.
apply (H3 readReg); destruct H1; subst; simpl; auto.
++ rewrite in_app_iff; right; simpl; left; auto.
++ rewrite in_app_iff; right; simpl; left; auto.
++ right; rewrite in_map_iff; exists (readReg, v); auto.
+ unfold WfRegMapExpr in *; dest.
inv H; EqDep_subst; [|discriminate].
specialize (SemRegExprVals H1 HSemRegMap) as TMP; inv TMP.
assert (WfRegMapExpr (VarRegMap type
(old0,
(hd [] upds0 ++
[(readReg,
existT (fullType type) (SyntaxKind (Array num Data))
(evalExpr
(BuildArray
(fun i : Fin.t num =>
(Var type (SyntaxKind (Array idxNum Data)) regV @[
Var type (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr idx) + Const type (natToWord (Nat.log2_up idxNum)(proj1_sig (to_nat i)))])%kami_expr))))])
:: tl upds0))
(old0,
(hd [] upds0 ++
[(readReg,
existT (fullType type) (SyntaxKind (Array num Data))
(evalExpr
(BuildArray
(fun i : Fin.t num =>
(Var type (SyntaxKind (Array idxNum Data)) regV @[
Var type (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr idx) + Const type (natToWord (Nat.log2_up idxNum) (proj1_sig (to_nat i)))])%kami_expr))))])
:: tl upds0)) as P0.
{ unfold WfRegMapExpr in *; dest; split; auto; constructor. }
specialize (IHea _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent P0 _ _ _ HSemCompActionT); dest; split; auto.
exists (UmUpd (readReg, existT (fullType type) (SyntaxKind (Array num Data))
(evalExpr
(BuildArray
(fun i : Fin.t num =>
(Var type (SyntaxKind (Array idxNum Data)) regV @[
Var type (SyntaxKind (Bit (Nat.log2_up idxNum))) (evalExpr idx) + Const type (natToWord (Nat.log2_up idxNum)
(proj1_sig (to_nat i)))])%kami_expr))))::x).
repeat split; auto.
* simpl in *.
clear - H3.
destruct (UpdOrMeths_RegsT x); auto.
rewrite <- app_assoc in H3; simpl in *; assumption.
* econstructor 15; eauto.
-- rewrite H3 in H.
rewrite HConsistent.
clear - H.
simpl in *.
destruct (UpdOrMeths_RegsT x); simpl in *; specialize (H _ (or_introl eq_refl)); dest;
apply H0; repeat rewrite map_app, in_app_iff; [right| left; right]; left; auto.
-- inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
-- rewrite H3 in H.
clear - H.
simpl in *.
destruct (UpdOrMeths_RegsT x); simpl in *; specialize (H _ (or_introl eq_refl)); dest; repeat intro; auto.
repeat rewrite map_app in H; simpl in *.
rewrite NoDup_app_iff in H; dest.
apply (H3 readReg); destruct H1; subst; simpl; auto.
++ rewrite in_app_iff; right; simpl; left; auto.
++ rewrite in_app_iff; right; simpl; left; auto.
++ right; rewrite in_map_iff; exists (readReg, v); auto.
- inv H0; EqDep_subst.
+ apply (SemCompActionEEquivWMap _ _ _ (SemVarRegMap _) HWriteMap) in HSemCompActionT.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest.
split; auto.
exists x.
repeat split; auto.
econstructor; eauto.
* inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
* inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
+ apply (SemCompActionEEquivWMap _ _ _ (SemVarRegMap _) HWriteMap) in HSemCompActionT.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest.
split; auto.
exists x.
repeat split; auto.
econstructor 17; eauto.
* inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
Qed.
Lemma ESemAction_NoDup_Upds k (ea : EActionT type k) :
forall o uml retl,
ESemAction o ea uml retl ->
NoDup (map fst (UpdOrMeths_RegsT uml)).
Proof.
induction ea; intros.
- inv H0; EqDep_subst; simpl; eauto.
- inv H0; EqDep_subst; simpl; eauto.
- inv H0; EqDep_subst; simpl; eauto.
rewrite UpdOrMeths_RegsT_app, map_app, NoDup_app_iff; repeat split; repeat intro; eauto.
+ specialize (HDisjRegs a); firstorder fail.
+ specialize (HDisjRegs a); firstorder fail.
- inv H0; EqDep_subst; simpl; eauto.
- inv H0; EqDep_subst; simpl; eauto.
- inv H; EqDep_subst; simpl.
constructor; eauto.
intro; rewrite in_map_iff in H; dest; destruct x; subst; simpl in *.
eapply HDisjRegs; eauto.
- inv H0; EqDep_subst; rewrite UpdOrMeths_RegsT_app, map_app, NoDup_app_iff;
repeat split; repeat intro; eauto; specialize (HDisjRegs a); tauto.
- inv H; EqDep_subst; simpl; eauto.
- inv H; EqDep_subst; simpl; constructor.
- inv H0; EqDep_subst; simpl; eauto.
- inv H; EqDep_subst; simpl; constructor; eauto; intro;
rewrite in_map_iff in H; dest; destruct x; subst; simpl in *; eapply HDisjRegs; eauto.
- inv H; EqDep_subst; simpl; constructor; eauto; intro;
rewrite in_map_iff in H; dest; destruct x; subst; simpl in *; eapply HDisjRegs; eauto.
- inv H0; EqDep_subst; eauto.
Qed.
Lemma ESemAction_SubList_Upds k (ea : EActionT type k) :
forall o uml retl,
ESemAction o ea uml retl ->
SubList (getKindAttr (UpdOrMeths_RegsT uml)) (getKindAttr o).
Proof.
induction ea; intros.
- inv H0; EqDep_subst; simpl; eauto.
- inv H0; EqDep_subst; simpl; eauto.
- inv H0; EqDep_subst; simpl; eauto.
rewrite UpdOrMeths_RegsT_app, map_app, SubList_app_l_iff; split; eauto.
- inv H0; EqDep_subst; simpl; eauto.
- inv H0; EqDep_subst; simpl; eauto.
- inv H; EqDep_subst; simpl.
repeat intro; inv H; auto.
eapply IHea; eauto.
- inv H0; EqDep_subst; simpl; eauto;
rewrite UpdOrMeths_RegsT_app, map_app, SubList_app_l_iff;
split; eauto.
- inv H; EqDep_subst; simpl; eauto.
- inv H; EqDep_subst; simpl; repeat intro; contradiction.
- inv H0; EqDep_subst; simpl; eauto.
- inv H; EqDep_subst; simpl; eauto; repeat intro; inv H.
+ rewrite in_map_iff;
exists (dataArray, existT (fullType type) (SyntaxKind (Array idxNum Data)) regV);
split; auto.
+ eapply IHea; eauto.
+ rewrite in_map_iff;
exists (dataArray, existT (fullType type) (SyntaxKind (Array idxNum Data)) regV);
split; auto.
+ eapply IHea; eauto.
- inv H; EqDep_subst; simpl; eauto; repeat intro; inv H; auto; eapply IHea; eauto.
- inv H0; EqDep_subst; eauto.
Qed.
Lemma Extension_Compiles1 {k : Kind} (a : ActionT type k) :
forall o calls retl expr v' bexpr,
SemCompActionT (compileAction o a bexpr expr) v' calls retl ->
SemCompActionT (EcompileAction o (Action_EAction a) bexpr expr) v' calls retl.
Proof.
induction a; simpl; intros; auto.
- inv H0; EqDep_subst; [econstructor| econstructor 2]; eauto.
- inv H0; EqDep_subst; econstructor; auto.
- inv H0; EqDep_subst; econstructor; eauto.
- inv H0; EqDep_subst; econstructor; eauto.
- inv H0; EqDep_subst; econstructor; eauto.
- inv H; simpl in *; EqDep_subst; econstructor; eauto.
- inv H0; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; simpl in *; EqDep_subst.
repeat econstructor; eauto.
- inv H; EqDep_subst; econstructor; eauto.
Qed.
Lemma Extension_Compiles2 {k : Kind} (a : ActionT type k) :
forall o calls retl expr v' bexpr,
SemCompActionT (EcompileAction o (Action_EAction a) bexpr expr) v' calls retl ->
SemCompActionT (compileAction o a bexpr expr) v' calls retl.
Proof.
induction a; simpl; intros; auto.
- inv H0; EqDep_subst; [econstructor| econstructor 2]; eauto.
- inv H0; EqDep_subst; econstructor; auto.
- inv H0; EqDep_subst; econstructor; eauto.
- inv H0; EqDep_subst; econstructor; eauto.
- inv H0; EqDep_subst; econstructor; eauto.
- inv H; simpl in *; EqDep_subst; econstructor; eauto.
- inv H0; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; simpl in *; EqDep_subst.
repeat econstructor; eauto.
- inv H; EqDep_subst; econstructor; eauto.
Qed.
Corollary Extension_Compiles_iff {k : Kind} (a : ActionT type k) :
forall o calls retl expr v' bexpr,
SemCompActionT (EcompileAction o (Action_EAction a) bexpr expr) v' calls retl <->
SemCompActionT (compileAction o a bexpr expr) v' calls retl.
Proof.
split; intro; eauto using Extension_Compiles1, Extension_Compiles2.
Qed.
Lemma FalseSemCompAction_Ext k (a : ActionT type k) :
forall writeMap o old upds oInit uInit (bexpr : Bool @# type) m
(HPriorityUpds : PriorityUpds oInit uInit o)
(HConsistent : getKindAttr o = getKindAttr old)
(WfMap : WfRegMapExpr writeMap (old, upds))
(HRegConsist : getKindAttr o = getKindAttr (getRegisters m))
(HWf : WfActionT (getRegisters m) a)
(HFalse : evalExpr bexpr = false),
exists retl,
@SemCompActionT k (compileAction (oInit, uInit) a bexpr writeMap) (old, upds) nil retl.
Proof.
induction a; simpl in *; intros.
- inv HWf; EqDep_subst.
specialize (H _ _ _ _ _ _ _ _ _ HPriorityUpds HConsistent WfMap HRegConsist (H2 (evalConstT (getDefaultConst (snd s)))) HFalse); dest.
exists x.
econstructor 2; eauto.
- inv HWf; EqDep_subst.
specialize (H _ _ _ _ _ _ _ _ _ HPriorityUpds HConsistent WfMap HRegConsist (H2 (evalExpr e)) HFalse); dest.
exists x.
econstructor; eauto.
- inv HWf; EqDep_subst.
specialize (IHa _ _ _ _ _ _ _ _ HPriorityUpds HConsistent WfMap HRegConsist H3 HFalse); dest.
assert (WfRegMapExpr (VarRegMap type (old, upds)) (old, upds)) as P0.
{ unfold WfRegMapExpr in *; dest; split; auto. constructor. }
specialize (H _ _ _ _ _ _ _ _ _ HPriorityUpds HConsistent P0 HRegConsist (H5 x) HFalse); dest.
exists x0.
econstructor; eauto.
reflexivity.
- inv HWf; EqDep_subst.
specialize (H _ _ _ _ _ _ _ _ _ HPriorityUpds HConsistent WfMap HRegConsist (H2 (evalConstFullT (getDefaultConstFullKind k))) HFalse); dest.
exists x.
econstructor; eauto.
- inv HWf; EqDep_subst.
change (fun x0 : FullKind => RegInitValT x0) with RegInitValT in H5.
rewrite <- HRegConsist in H5.
rewrite in_map_iff in H5; dest; inv H0.
destruct x, s0; simpl in *.
specialize (H _ _ _ _ _ _ _ _ _ HPriorityUpds HConsistent WfMap HRegConsist (H3 f) HFalse); dest.
exists x0.
econstructor; eauto.
constructor.
- inv HWf; EqDep_subst.
assert (WfRegMapExpr (VarRegMap type (old, upds)) (old, upds)) as P0.
{ unfold WfRegMapExpr in *; dest; split; auto; constructor. }
specialize (IHa _ _ _ _ _ _ _ _ HPriorityUpds HConsistent P0 HRegConsist H2 HFalse); dest.
exists x.
econstructor; eauto.
+ econstructor; eauto.
unfold WfRegMapExpr in *; dest; split; auto.
* econstructor 3; auto.
+ reflexivity.
- inv HWf; EqDep_subst.
remember (evalExpr e) as e_val.
assert (WfRegMapExpr (VarRegMap type (old, upds)) (old, upds)) as P0.
{ unfold WfRegMapExpr in *; dest; split; auto; constructor. }
assert (evalExpr (bexpr && e)%kami_expr = false) as P1.
{ simpl; rewrite HFalse, andb_false_l; reflexivity. }
assert (evalExpr (bexpr && !e)%kami_expr = false) as P2.
{ simpl; rewrite HFalse, andb_false_l; reflexivity. }
specialize (IHa1 _ _ _ _ _ _ _ _ HPriorityUpds HConsistent WfMap HRegConsist H7 P1); dest.
specialize (IHa2 _ _ _ _ _ _ _ _ HPriorityUpds HConsistent P0 HRegConsist H8 P2); dest.
destruct e_val.
+ specialize (H _ _ _ _ _ _ _ _ _ HPriorityUpds HConsistent P0 HRegConsist (H4 x) HFalse); dest.
exists x1.
do 2 econstructor; eauto.
econstructor; eauto using SemCompActionEquivBexpr; [reflexivity|].
econstructor; eauto using SemCompActionEquivBexpr; [reflexivity|].
econstructor; simpl; rewrite <- Heqe_val.
assumption.
+ specialize (H _ _ _ _ _ _ _ _ _ HPriorityUpds HConsistent P0 HRegConsist (H4 x0) HFalse); dest.
exists x1.
do 2 econstructor; eauto.
econstructor; eauto using SemCompActionEquivBexpr; [reflexivity|].
econstructor; eauto using SemCompActionEquivBexpr; [reflexivity|].
econstructor; simpl; rewrite <- Heqe_val.
assumption.
- inv HWf; EqDep_subst.
specialize (IHa _ _ _ _ _ _ _ _ HPriorityUpds HConsistent WfMap HRegConsist H1 HFalse); dest.
exists x.
econstructor; eauto.
- inv HWf; EqDep_subst.
exists (evalExpr e).
econstructor; eauto.
Qed.
Lemma ActionsEEquivWeak k a:
forall writeMap o old upds oInit uInit m
(HoInitNoDups : NoDup (map fst oInit))
(HuInitNoDups : forall u, In u uInit -> NoDup (map fst u))
(HPriorityUpds : PriorityUpds oInit uInit o)
(HConsistent : getKindAttr o = getKindAttr old)
(WfMap : WfRegMapExpr writeMap (old, upds))
(HRegConsist : getKindAttr o = getKindAttr (getRegisters m))
(HWf : WfActionT (getRegisters m) a),
forall uml retl upds' calls,
upds' = (old, match (UpdOrMeths_RegsT uml) with
|nil => upds
|_ :: _ => (hd nil upds ++ (UpdOrMeths_RegsT uml)) :: tl upds
end) ->
calls = (UpdOrMeths_MethsT uml) ->
DisjKey (hd nil upds) (UpdOrMeths_RegsT uml) ->
ESemAction o (Action_EAction a) uml retl ->
@SemCompActionT k (EcompileAction (oInit, uInit) (Action_EAction a) (Const type true) writeMap) upds' calls retl.
Proof.
induction a; intros; subst; simpl in *.
- inv H3; inv HWf; EqDep_subst; simpl.
econstructor; eauto.
- inv H3; inv HWf; EqDep_subst; simpl.
econstructor; eauto.
- specialize (ESemAction_NoDup_Upds H3) as P0;
specialize (ESemAction_SubList_Upds H3) as P1.
inv H3; inv HWf; EqDep_subst; rewrite UpdOrMeths_RegsT_app, UpdOrMeths_MethsT_app.
econstructor; eauto.
eapply IHa; eauto.
+ intro k0; specialize (H2 k0).
rewrite UpdOrMeths_RegsT_app, map_app, in_app_iff in H2.
destruct H2; auto.
+ eapply H; eauto.
* unfold WfRegMapExpr; repeat split; [constructor| |]; unfold WfRegMapExpr in *; dest;
rewrite UpdOrMeths_RegsT_app in *; destruct (UpdOrMeths_RegsT newUml); simpl in *.
-- apply (H3 _ H0).
-- destruct H0; subst; [rewrite map_app|]; simpl.
++ rewrite NoDup_app_iff; repeat split; repeat intro; auto.
** destruct upds; [constructor| simpl; apply (H3 _ (or_introl eq_refl))].
** rewrite map_app in P0; inv P0.
rewrite in_app_iff in H6.
rewrite NoDup_app_iff in H7; dest.
constructor; [firstorder fail|]; auto.
** specialize (H2 a1); simpl in *; rewrite map_app, in_app_iff in H2.
clear - H2 H0 H5.
firstorder fail.
** specialize (H2 a1); simpl in *; rewrite map_app, in_app_iff in H2.
clear - H2 H0 H5.
firstorder fail.
++ apply H3; clear - H0; destruct upds; simpl in *; auto.
-- apply (H3 _ H0).
-- destruct H0; subst; [rewrite map_app|]; simpl.
++ rewrite SubList_app_l_iff; split; repeat intro.
** destruct upds; simpl in *;
[contradiction| apply (H3 _ (or_introl eq_refl)); assumption].
** rewrite HConsistent in P1; apply P1; simpl in *.
rewrite map_app, in_app_iff.
clear - H0; firstorder fail.
++ eapply H3; destruct upds; simpl in *; eauto.
* clear.
destruct (UpdOrMeths_RegsT newUml); simpl; auto.
destruct (UpdOrMeths_RegsT newUmlCont); simpl;
[rewrite app_nil_r| rewrite <-app_assoc]; auto.
* destruct (UpdOrMeths_RegsT newUml); simpl; auto.
-- intro k0; specialize (H2 k0).
rewrite UpdOrMeths_RegsT_app, map_app, in_app_iff in H2.
clear - H2; firstorder fail.
-- intro k0; specialize (H2 k0); specialize (HDisjRegs k0).
clear - H2 HDisjRegs.
rewrite UpdOrMeths_RegsT_app, map_app, in_app_iff in *; firstorder fail.
- inv H3; inv HWf; EqDep_subst; econstructor; eauto.
- inv H3; inv HWf; EqDep_subst; econstructor; eauto.
constructor.
- inv H2; inv HWf; EqDep_subst.
unfold WfRegMapExpr in *; dest.
econstructor; eauto.
+ econstructor; eauto.
unfold WfRegMapExpr; split; eauto.
* econstructor; eauto.
* simpl; intros.
destruct H2; subst; split.
-- rewrite map_app, NoDup_app_iff; repeat split; repeat intro; auto.
++ destruct upds; simpl; [constructor| apply (H0 _ (or_introl eq_refl))].
++ simpl; constructor; [intro; contradiction| constructor].
++ destruct H4; auto; subst.
specialize (H1 r); simpl in *.
clear - H1 H2; firstorder fail.
++ destruct H2; auto; subst.
specialize (H1 r); simpl in *.
clear - H1 H4; firstorder fail.
-- rewrite map_app, SubList_app_l_iff; split; simpl.
++ repeat intro.
destruct upds; [contradiction| apply (H0 _ (or_introl eq_refl))]; auto.
++ repeat intro; destruct H2;[subst |contradiction].
rewrite HConsistent in HRegVal; assumption.
-- destruct upds; [contradiction| apply (H0 _ (or_intror H2))].
-- destruct upds; [contradiction| apply (H0 _ (or_intror H2))].
+ reflexivity.
+ simpl; eapply IHa; eauto.
* split; [constructor| intros]; split.
-- inv H2; simpl in *; [rewrite map_app, NoDup_app_iff; repeat split; repeat intro|].
++ destruct upds; [constructor| simpl; apply (H0 _ (or_introl eq_refl))].
++ simpl; repeat constructor; auto.
++ specialize (H1 a0); clear - H1 H2 H4; firstorder fail.
++ specialize (H1 a0); clear - H1 H2 H4; firstorder fail.
++ destruct upds; [inv H4| apply (H0 _ (or_intror _ H4))].
-- inv H2; repeat intro; simpl in *.
++ rewrite map_app, in_app_iff in H2; simpl in H2.
destruct H2; [ destruct upds; [contradiction|]| destruct H2; [|contradiction]];
subst.
** apply (H0 _ (or_introl _ (eq_refl))); assumption.
** rewrite HConsistent in HRegVal; assumption.
++ destruct upds; [contradiction| apply (H0 _ (or_intror _ H4)); assumption].
* simpl; destruct (UpdOrMeths_RegsT newUml); auto.
rewrite <-app_assoc; reflexivity.
* intro k0; simpl; rewrite map_app, in_app_iff.
specialize (H1 k0); simpl in *.
clear - H1 HDisjRegs.
destruct H1; auto.
destruct (string_dec r k0); subst.
-- right; intro.
rewrite in_map_iff in H0; dest; destruct x; subst; simpl in *.
apply (HDisjRegs s0); assumption.
-- left; intro; firstorder fail.
- inv H3; inv HWf; EqDep_subst; do 2 econstructor;[econstructor|].
+ assert (evalExpr (Const type true) =
evalExpr (Var type (SyntaxKind Bool)
(evalExpr (Const type true && e)%kami_expr))) as P0; auto.
eapply SemCompActionEEquivBexpr; eauto.
eapply IHa1 with (old := old) (o := o); auto.
* apply WfMap.
* apply HRegConsist.
* assumption.
* instantiate (1 := newUml1).
intro; specialize (H2 k0); clear - H2; rewrite UpdOrMeths_RegsT_app, map_app, in_app_iff in H2; firstorder fail.
* apply HEAction.
+ rewrite UpdOrMeths_MethsT_app; reflexivity.
+ assert (evalExpr (Const type true && !e)%kami_expr = false) as P0.
{ simpl; rewrite HTrue; reflexivity. }
assert (WfRegMapExpr (VarRegMap type (old, match UpdOrMeths_RegsT newUml1 with
| [] => upds
| _ :: _ => (hd [] upds ++ UpdOrMeths_RegsT newUml1) :: tl upds
end))
(old, match UpdOrMeths_RegsT newUml1 with
| [] => upds
| _ :: _ => (hd [] upds ++ UpdOrMeths_RegsT newUml1) :: tl upds
end)) as P1.
{ unfold WfRegMapExpr in *; dest; split; auto; [constructor|].
intros; split.
- specialize (ESemAction_NoDup_Upds HEAction) as P1.
rewrite UpdOrMeths_RegsT_app in H2.
destruct (UpdOrMeths_RegsT newUml1).
+ apply H1; auto.
+ inv H3; [| destruct upds; [contradiction| apply H1; right; assumption]].
rewrite map_app, NoDup_app_iff; repeat split; auto.
* destruct upds;[constructor| apply H1; left; reflexivity].
* repeat intro; specialize (H2 a); rewrite map_app, in_app_iff in H2;clear - H2 H3 H4; firstorder fail.
* repeat intro; specialize (H2 a); rewrite map_app, in_app_iff in H2;clear - H2 H3 H4; firstorder fail.
- specialize (ESemAction_SubList_Upds HEAction) as P1.
destruct (UpdOrMeths_RegsT newUml1).
+ apply H1; auto.
+ inv H3; [|destruct upds; [contradiction| apply H1; right; assumption]].
repeat intro; rewrite map_app, in_app_iff in *; inv H3;[| rewrite HConsistent in *; auto].
destruct upds; [contradiction|].
apply (H1 r0 (in_eq _ _)); assumption.
}
specialize (FalseSemCompAction_Ext _ _ HPriorityUpds HConsistent P1 HRegConsist H13 P0) as P2; dest.
rewrite <- Extension_Compiles_iff in H0.
econstructor.
* eapply SemCompActionEEquivBexpr with (bexpr1 := (Const type true && ! e)%kami_expr); eauto.
* reflexivity.
* rewrite UpdOrMeths_RegsT_app.
econstructor; simpl; rewrite HTrue.
eapply H; eauto.
-- destruct (UpdOrMeths_RegsT newUml1); simpl; auto.
destruct (UpdOrMeths_RegsT newUml2); [rewrite app_nil_r | rewrite app_comm_cons, app_assoc]; simpl; auto.
-- rewrite UpdOrMeths_RegsT_app in *.
destruct (UpdOrMeths_RegsT newUml1); simpl in *; auto.
clear - H2 HDisjRegs.
intro k; specialize (H2 k); specialize (HDisjRegs k); simpl in *; rewrite map_app, in_app_iff in *.
firstorder fail.
+ assert (evalExpr (Const type true && e)%kami_expr = false) as P0.
{ simpl; rewrite HFalse; reflexivity. }
specialize (FalseSemCompAction_Ext _ _ HPriorityUpds HConsistent WfMap HRegConsist H12 P0) as P2; dest.
rewrite <- Extension_Compiles_iff in H0.
econstructor 8; eauto.
* eapply SemCompActionEEquivBexpr with (bexpr1 := (Const type true && e)%kami_expr);
eauto.
* reflexivity.
* rewrite UpdOrMeths_RegsT_app, UpdOrMeths_MethsT_app.
assert (WfRegMapExpr (VarRegMap type (old, upds)) (old, upds)) as P1.
{ unfold WfRegMapExpr in *; dest; split; auto; constructor. }
econstructor; simpl.
-- assert (evalExpr (Const type true) = evalExpr (Var type (SyntaxKind Bool)
(negb (evalExpr e)))) as P2.
{ simpl; rewrite HFalse; auto. }
apply (SemCompActionEEquivBexpr _ _ _ _ _ P2).
eapply IHa2 with (o := o) (old := old) (upds := upds) (uml := newUml1); eauto.
clear - H2; intro k; specialize (H2 k); rewrite UpdOrMeths_RegsT_app, map_app, in_app_iff in H2.
firstorder fail.
-- reflexivity.
-- econstructor; simpl; rewrite HFalse.
eapply H with (upds := match UpdOrMeths_RegsT newUml1 with
| [] => upds
| _ :: _ => (hd [] upds ++ UpdOrMeths_RegsT newUml1) :: tl upds
end); eauto.
++ rewrite UpdOrMeths_RegsT_app in *.
specialize (ESemAction_NoDup_Upds HEAction) as P3.
specialize (ESemAction_SubList_Upds HEAction) as P4.
unfold WfRegMapExpr in *; dest; split; [constructor| intros; split].
** destruct (UpdOrMeths_RegsT newUml1);[apply H6; assumption| inv H7; [| apply H6; destruct upds;[contradiction| right; assumption]]].
rewrite map_app, NoDup_app_iff; repeat split; repeat intro; auto.
--- destruct upds; [constructor| apply H6; left; reflexivity].
--- clear - H2 H7 H8; specialize (H2 a); rewrite map_app, in_app_iff in H2.
firstorder fail.
--- clear - H2 H7 H8; specialize (H2 a); rewrite map_app, in_app_iff in H2.
firstorder fail.
** destruct (UpdOrMeths_RegsT newUml1);[apply H6; assumption| inv H7; [| apply H6; destruct upds;[contradiction| right; assumption]]].
rewrite HConsistent in P4.
repeat intro; rewrite map_app, in_app_iff in H7; inv H7.
--- destruct upds; [contradiction|].
apply (H6 r0 (in_eq _ _)); assumption.
--- apply P4; assumption.
++ rewrite UpdOrMeths_RegsT_app in *.
destruct (UpdOrMeths_RegsT newUml1); simpl in *; auto.
destruct (UpdOrMeths_RegsT newUml2); simpl in *; [rewrite app_nil_r| rewrite <-app_assoc, app_comm_cons; simpl];auto.
++ rewrite UpdOrMeths_RegsT_app in *.
destruct (UpdOrMeths_RegsT newUml1); simpl in *; auto.
clear - H2 HDisjRegs.
intro k; specialize (H2 k); specialize (HDisjRegs k); simpl in *; rewrite map_app, in_app_iff in *.
firstorder fail.
- inv H2; inv HWf; EqDep_subst; econstructor; eauto.
- inv H2; inv HWf; EqDep_subst; econstructor; eauto.
Qed.
Corollary ECompCongruence k (ea : EActionT type k) (a : ActionT type k) :
forall writeMap o old upds oInit uInit m
(HoInitNoDups : NoDup (map fst oInit))
(HuInitNoDups : forall u, In u uInit -> NoDup (map fst u))
(HPriorityUpds : PriorityUpds oInit uInit o)
(HConsistent : getKindAttr o = getKindAttr old)
(WfMap : WfRegMapExpr writeMap (old, upds))
(HRegConsist : getKindAttr o = getKindAttr (getRegisters m))
(HWf : WfActionT (getRegisters m) a),
(forall uml retl, ESemAction o ea uml retl -> ESemAction o (Action_EAction a) uml retl) ->
forall upds' calls retl,
@SemCompActionT k (EcompileAction (oInit, uInit) ea (Const type true) writeMap) upds' calls retl ->
@SemCompActionT k (EcompileAction (oInit, uInit) (Action_EAction a) (Const type true) writeMap) upds' calls retl.
Proof.
intros.
apply (EEquivActions _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap) in H0; dest.
specialize (H _ _ H3).
eapply ActionsEEquivWeak; eauto.
rewrite H1 in H0; simpl in *.
destruct (UpdOrMeths_RegsT x); [intro; right; intro; contradiction|].
specialize (H0 _ (or_introl eq_refl)); dest; rewrite map_app, NoDup_app_iff in H0; dest.
intro; specialize (H6 k0); specialize (H7 k0).
destruct (in_dec string_dec k0 (map fst (hd [] upds))); auto.
Qed.
Lemma EquivActions k a:
forall
writeMap o old upds oInit uInit
(HoInitNoDups : NoDup (map fst oInit))
(HuInitNoDups : forall u, In u uInit -> NoDup (map fst u))
(HPriorityUpds : PriorityUpds oInit uInit o)
(HConsistent : getKindAttr o = getKindAttr old)
(WfMap : WfRegMapExpr writeMap (old, upds)),
forall calls retl upds',
@SemCompActionT k (compileAction (oInit, uInit) a (Const type true) writeMap) upds' calls retl ->
(forall u, In u (snd upds') -> NoDup (map fst u) /\ SubList (getKindAttr u) (getKindAttr old)) /\
exists newRegs readRegs,
upds' = (old, match newRegs with
|nil => upds
|_ :: _ => (hd nil upds ++ newRegs) :: tl upds
end) /\
SemAction o a readRegs newRegs calls retl.
Proof.
induction a; subst; intros; simpl in *.
- inv H0; EqDep_subst;[|discriminate].
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists x, x0; split; auto.
econstructor; eauto.
- inv H0; EqDep_subst.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists x, x0; split; auto.
econstructor; eauto.
- inv H0; EqDep_subst.
specialize (IHa _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT_a); dest.
assert (WfRegMapExpr (VarRegMap type regMap_a) regMap_a) as WfMap0.
{ unfold WfRegMapExpr; split;[econstructor|].
destruct regMap_a; inv H1; intros.
apply (H0 _ H1).
}
rewrite H1 in *.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap0 _ _ _ HSemCompActionT_cont); dest.
split; auto.
exists (x++x1), (x0++x2); split.
+ destruct x1; simpl in *; auto.
* rewrite app_nil_r; assumption.
* destruct x; simpl in *; auto.
rewrite app_comm_cons, app_assoc; assumption.
+ econstructor; eauto.
rewrite H3 in H; simpl in *.
clear - H.
destruct x, x1; eauto using DisjKey_nil_r, DisjKey_nil_l; simpl in *.
specialize (H _ (or_introl _ eq_refl)); simpl in *; dest.
repeat rewrite map_app in H.
intro k.
destruct (In_dec string_dec k (map fst (p0::x1))); auto.
left; intro.
destruct (NoDup_app_Disj string_dec _ _ H k); auto.
apply H2; rewrite in_app_iff; right; auto.
- inv H0; EqDep_subst.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists x, x0; split; auto.
econstructor; eauto.
- inv H0; EqDep_subst.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ HSemCompActionT); dest; split; auto.
exists x, ((r, existT _ k regVal) :: x0).
split; auto.
econstructor; eauto.
inv HReadMap.
apply (PriorityUpds_Equiv HoInitNoDups HuInitNoDups HUpdatedRegs HPriorityUpds); auto.
- inv H; simpl in *; EqDep_subst.
rewrite (unifyWO val_a) in HSemCompActionT_a.
inv HSemCompActionT_a; EqDep_subst.
destruct HRegMapWf, WfMap, regMap_a.
inv H;[|discriminate]; EqDep_subst.
specialize (SemRegExprVals H1 HSemRegMap) as P0; inv P0.
assert (WfRegMapExpr (VarRegMap type (r0, (hd nil upds0 ++ (r, existT (fullType type) k (evalExpr e)) :: nil) :: tl upds0))
(r0, (hd nil upds0 ++ (r, existT (fullType type) k (evalExpr e)) :: nil) :: tl upds0)) as WfMap0.
{ split; auto. constructor. }
specialize (IHa _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap0 _ _ _ HSemCompActionT_cont);
dest; simpl in *; split; auto.
exists ((r, existT (fullType type) k (evalExpr e)) :: nil ++ x), x0; split.
+ destruct x; simpl in *; auto.
rewrite <- app_assoc in H3. rewrite <-app_comm_cons in H3.
simpl in H3; auto.
+ rewrite H3 in H; simpl in *; destruct x; econstructor; eauto; simpl in *; specialize (H _ (or_introl _ eq_refl)); dest.
* rewrite map_app, <-HConsistent in H6; simpl in *.
apply (H6 (r, k)).
rewrite in_app_iff; right; left; reflexivity.
* repeat intro; inv H7.
* rewrite map_app, <-HConsistent in H6; simpl in *.
apply (H6 (r, k)).
rewrite map_app; repeat rewrite in_app_iff; simpl; auto.
* repeat intro.
repeat rewrite map_app in H; simpl in *.
destruct H7; subst; destruct (NoDup_app_Disj string_dec _ _ H r) as [P0|P0]; apply P0.
-- rewrite in_app_iff; simpl; auto.
-- simpl; auto.
-- rewrite in_app_iff; simpl; auto.
-- simpl; right; rewrite in_map_iff.
exists (r, v); simpl; auto.
- inv H0; simpl in *; EqDep_subst.
inv HSemCompActionT; simpl in *; EqDep_subst.
inv HSemCompActionT0; simpl in *; EqDep_subst.
inv HSemCompActionT_cont; EqDep_subst.
inv HSemCompActionT_cont0; EqDep_subst.
remember (evalExpr e) as P0.
apply Eqdep.EqdepTheory.inj_pair2 in H4.
rewrite H4 in *.
clear H4; simpl in *.
destruct P0; rewrite <- HeqP0 in *; simpl in *.
+ assert (evalExpr (Var type (SyntaxKind Bool) true) = evalExpr (Const type true)) as P4; auto.
assert (evalExpr (Var type (SyntaxKind Bool) false) = false) as P5; auto.
specialize (SemCompActionEquivBexpr _ _ _ _ _ P4 HSemCompActionT_a) as P6.
specialize (IHa1 _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap _ _ _ P6); dest.
destruct (predFalse_UpdsNil _ _ _ _ P5 (SemVarRegMap regMap_a) HSemCompActionT_a0).
assert (WfRegMapExpr (VarRegMap type regMap_a0) regMap_a0) as P7.
{ unfold WfRegMapExpr; split; [constructor|]. subst; eauto. }
rewrite <- H3 in P7 at 2.
rewrite H1 in P7.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent P7 _ _ _ HSemCompActionT); dest.
split; auto.
exists (x++x1), (x0++x2).
destruct x; simpl; split; auto.
* rewrite H4.
econstructor; eauto.
apply DisjKey_nil_l.
* destruct x1; [rewrite app_nil_r|]; simpl in *; auto.
rewrite <-app_assoc, <-app_comm_cons in H5; assumption.
* rewrite H4; simpl.
econstructor; eauto.
rewrite H5 in H; simpl in *.
clear - H.
destruct x1; simpl in *; [apply DisjKey_nil_r|].
specialize (H _ (or_introl _ (eq_refl))); dest.
rewrite map_app in H.
intro.
destruct (NoDup_app_Disj string_dec _ _ H k); auto.
left; intro; apply H1.
rewrite map_app, in_app_iff; auto.
+ assert (evalExpr (Var type (SyntaxKind Bool) true) = evalExpr (Const type true)) as P4; auto.
assert (evalExpr (Var type (SyntaxKind Bool) false) = false) as P5; auto.
specialize (SemCompActionEquivBexpr _ _ _ _ _ P4 HSemCompActionT_a0) as P6.
remember WfMap as WfMap0.
inv WfMap0.
destruct (predFalse_UpdsNil _ _ _ _ P5 H0 HSemCompActionT_a).
assert (WfRegMapExpr (VarRegMap type regMap_a) (old, upds)) as WfMap0.
{ rewrite <- H2.
clear - WfMap.
unfold WfRegMapExpr in *; dest; repeat split;[constructor| |]; eapply H0; eauto.
}
specialize (IHa2 _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent WfMap0 _ _ _ P6); dest.
assert (WfRegMapExpr (VarRegMap type regMap_a0) regMap_a0) as P7.
{ unfold WfRegMapExpr; split; [constructor|]. subst; eauto. }
rewrite H5 in P7 at 2.
specialize (H _ _ _ _ _ _ _ HoInitNoDups HuInitNoDups HPriorityUpds HConsistent P7 _ _ _ HSemCompActionT); dest.
split; auto.
exists (x++x1), (x0++x2).
destruct x; simpl; split; auto.
* rewrite H3; simpl.
econstructor 8; eauto.
apply DisjKey_nil_l.
* destruct x1;[rewrite app_nil_r|]; simpl in *; auto.
rewrite <-app_assoc,
gitextract_xcclyzzt/ ├── .gitignore ├── All.v ├── AllDefn.v ├── AllNotations.v ├── Compiler/ │ ├── Compiler.v │ ├── CompilerDoubleWrites.v │ ├── CompilerProps.v │ ├── CompilerSimple.v │ ├── CompilerSimpleProps.v │ ├── CompilerSimpleSem.v │ ├── Rtl.v │ ├── Test.v │ └── UnverifiedIncompleteCompiler.v ├── Extraction.v ├── GallinaModules/ │ ├── AuxLemmas.v │ ├── AuxTactics.v │ └── Relations.v ├── Guard.v ├── LICENSE ├── Lib/ │ ├── EclecticLib.v │ ├── Fold.v │ ├── HexNotation.v │ ├── HexNotationWord.v │ ├── NatStr.v │ ├── VectorFacts.v │ ├── Word.v │ └── WordProperties.v ├── LibStruct.v ├── Makefile ├── Notations.v ├── NotationsTest.v ├── PPlusProperties.v ├── PProperties.v ├── Properties.v ├── README.adoc ├── Rewrites/ │ ├── Notations_rewrites.v │ ├── ReflectionImpl.v │ ├── ReflectionOrig.v │ ├── ReflectionPre.v │ ├── ReflectionSoundTheorems1.v │ ├── ReflectionSoundTheorems2.v │ └── ReflectionSoundTopTheorems.v ├── SignatureMatch.v ├── Simulator/ │ ├── CoqSim/ │ │ ├── Eval.v │ │ ├── HaskellTypes.v │ │ ├── Misc.v │ │ ├── RegisterFile.v │ │ ├── Simulator.v │ │ └── TransparentProofs.v │ ├── NativeTest.v │ └── README.adoc ├── StateMonad.v ├── Syntax.v ├── SyntaxDoubleWrites.v ├── Tactics.v ├── Tutorial/ │ ├── ExtractEx.v │ ├── GallinaActionEx.v │ ├── PhoasEx.v │ ├── SyntaxEx.v │ └── TacticsEx.v ├── Utila.v ├── WfActionT.v ├── WfMod_Helper.v ├── _CoqProject ├── fixHaskell.sh └── kami.el
Condensed preview — 66 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (2,078K chars).
[
{
"path": ".gitignore",
"chars": 294,
"preview": "*.cache\nLib/.*.aux\nLib/*.v.d\n*.v.d\n*.glob\nLib/*.glob\n*.vo\n*.vok\n*.vos\nLib/*.vo\n*.aux\nTarget.hs\n../Target.hs\n*.hi\n*.o\nCom"
},
{
"path": "All.v",
"chars": 136,
"preview": "Require Export Kami.AllNotations.\n(* N.b.: this module exports notations or things dependent on them *)\nRequire Export K"
},
{
"path": "AllDefn.v",
"chars": 251,
"preview": "Require Export Kami.Lib.Word Kami.Lib.HexNotationWord Kami.Lib.Fold Kami.Lib.EclecticLib Kami.Utila RecordUpdate.RecordS"
},
{
"path": "AllNotations.v",
"chars": 145,
"preview": "Require Export Kami.AllDefn.\nRequire Export Kami.Notations.\nRequire Export Kami.LibStruct.\nExport Kami.Lib.Word.Notation"
},
{
"path": "Compiler/Compiler.v",
"chars": 62035,
"preview": "Require Import Kami.StateMonad Kami.Syntax Kami.Properties Kami.PProperties Kami.PPlusProperties Kami.Notations Kami.Lib"
},
{
"path": "Compiler/CompilerDoubleWrites.v",
"chars": 34303,
"preview": "Require Import Kami.SyntaxDoubleWrites Kami.Compiler.Compiler Kami.Compiler.CompilerProps Kami.Syntax Kami.Properties Ka"
},
{
"path": "Compiler/CompilerProps.v",
"chars": 252178,
"preview": "Require Import Kami.StateMonad Kami.Syntax Kami.Properties Kami.PProperties Kami.PPlusProperties Kami.Lib.EclecticLib Ka"
},
{
"path": "Compiler/CompilerSimple.v",
"chars": 8429,
"preview": "Require Import Kami.Syntax Kami.Compiler.Compiler.\nRequire Import Kami.Notations.\n\nSection Simple.\n\n Variable ty : Kind"
},
{
"path": "Compiler/CompilerSimpleProps.v",
"chars": 4718,
"preview": "Require Import Kami.Syntax Kami.PPlusProperties.\nRequire Import Kami.Notations.\nRequire Import Kami.Compiler.CompilerSim"
},
{
"path": "Compiler/CompilerSimpleSem.v",
"chars": 17297,
"preview": "Require Import Kami.All Kami.Compiler.Compiler.\nRequire Import Kami.Notations.\nRequire Import Kami.Compiler.CompilerSimp"
},
{
"path": "Compiler/Rtl.v",
"chars": 668,
"preview": "Require Import Kami.Syntax String.\n\nSet Implicit Arguments.\nSet Asymmetric Patterns.\n\nDefinition VarType := (string * op"
},
{
"path": "Compiler/Test.v",
"chars": 20569,
"preview": "Require Import Kami.Extraction.\nRequire Import BinNat.\nImport FinFun.Fin2Restrict.\nRequire Import Kami.AllNotations.\n\nCl"
},
{
"path": "Compiler/UnverifiedIncompleteCompiler.v",
"chars": 18442,
"preview": "Require Import Kami.Syntax Kami.Notations RecordUpdate.RecordSet Kami.Compiler.Rtl Kami.StateMonad.\n\n\nSet Implicit Argum"
},
{
"path": "Extraction.v",
"chars": 8235,
"preview": "Require Export List String Ascii BinInt BinNat.\nRequire Export Kami.Syntax Kami.Compiler.CompilerSimple Kami.Compiler.Co"
},
{
"path": "GallinaModules/AuxLemmas.v",
"chars": 26102,
"preview": "Require Import Kami.All.\nRequire Import Kami.GallinaModules.Relations.\n\nDefinition doUpdReg (u : RegsT) (r : RegT) : Reg"
},
{
"path": "GallinaModules/AuxTactics.v",
"chars": 29827,
"preview": "Require Import Kami.All.\nRequire Import Kami.GallinaModules.AuxLemmas.\nRequire Import Kami.GallinaModules.Relations.\n\n(*"
},
{
"path": "GallinaModules/Relations.v",
"chars": 1162,
"preview": "Require Import Kami.All.\n\nDefinition EffectfulRelation {k: Kind} (R: RegsT -> RegsT -> Prop) (a_i a_s: ActionT type k): "
},
{
"path": "Guard.v",
"chars": 9950,
"preview": "Require Import Kami.Syntax Kami.Notations.\nSet Asymmetric Patterns.\nSet Implicit Arguments.\n\nSection ty.\n Variable ty: "
},
{
"path": "LICENSE",
"chars": 11309,
"preview": "Apache License\n Version 2.0, January 2004\n http://www.apache.org/licens"
},
{
"path": "Lib/EclecticLib.v",
"chars": 108400,
"preview": "Require Import String Coq.Lists.List Omega Fin Eqdep Bool Coq.ZArith.Zdiv Lia.\nRequire Import Coq.Arith.Even.\nRequire Im"
},
{
"path": "Lib/Fold.v",
"chars": 19733,
"preview": "Require Import Recdef List Omega Div2.\n\nImport ListNotations.\n\nSet Implicit Arguments.\nSet Asymmetric Patterns.\n\nLocal "
},
{
"path": "Lib/HexNotation.v",
"chars": 2538,
"preview": "(* Adapted from http://poleiro.info/posts/2013-04-03-parse-errors-as-type-errors.html,\n https://github.com/arthuraa/po"
},
{
"path": "Lib/HexNotationWord.v",
"chars": 631,
"preview": "Require Export Kami.Lib.Word.\nRequire Export Kami.Lib.HexNotation.\nOpen Scope word_scope.\n\nNotation \"'Ox' a\" := (NToWord"
},
{
"path": "Lib/NatStr.v",
"chars": 14545,
"preview": "Require Import Kami.Syntax.\n\nSection nat_string.\n Unset Implicit Arguments.\n\n (*\n Accepts two arguments: radix and "
},
{
"path": "Lib/VectorFacts.v",
"chars": 6345,
"preview": "Require Coq.Vectors.Vector.\nImport Vectors.VectorDef.VectorNotations.\n\nSet Implicit Arguments.\nSet Asymmetric Patterns.\n"
},
{
"path": "Lib/Word.v",
"chars": 8342,
"preview": "Require Import Coq.ZArith.BinIntDef Coq.ZArith.BinInt Coq.ZArith.Zdiv Psatz.\n\n\nDefinition minimize_eq_proof{A: Type}(eq_"
},
{
"path": "Lib/WordProperties.v",
"chars": 40140,
"preview": "Require Import Coq.ZArith.BinIntDef Coq.ZArith.BinInt Coq.ZArith.Zdiv Eqdep.\nRequire Import Kami.Lib.Word.\nRequire Impor"
},
{
"path": "LibStruct.v",
"chars": 3313,
"preview": "Require Import Kami.Syntax Kami.Notations.\n\n(* TODO: move to KamiStdLib? *)\nDefinition extractArbitraryRange ty sz (inst"
},
{
"path": "Makefile",
"chars": 366,
"preview": "VS:=$(shell find . -type f -name '*.v')\n\n.PHONY: coq clean force\n\ncoq: Makefile.coq.all $(VS)\n\t$(MAKE) -f Makefile.coq.a"
},
{
"path": "Notations.v",
"chars": 24776,
"preview": "Require Import Kami.Syntax Kami.Lib.EclecticLib Kami.Tactics.\nRequire Import Kami.Lib.NatStr.\nRequire Import RecordUpdat"
},
{
"path": "NotationsTest.v",
"chars": 5556,
"preview": "Require Import Kami.Syntax Kami.Notations Kami.Tactics.\nSection mod_test.\n Variable a: string.\n Local Notation \"^ x\" :"
},
{
"path": "PPlusProperties.v",
"chars": 378690,
"preview": "Require Import Kami.Syntax.\nRequire Import Kami.Properties Kami.PProperties.\nImport ListNotations.\nRequire Import Coq.So"
},
{
"path": "PProperties.v",
"chars": 107001,
"preview": "Require Import Kami.Syntax.\nRequire Import Kami.Properties.\nImport ListNotations.\nRequire Import Coq.Sorting.Permutation"
},
{
"path": "Properties.v",
"chars": 255380,
"preview": "Require Import Kami.Syntax Kami.Lib.Fold.\nImport Word.Notations.\nImport ListNotations.\nRequire Import Coq.Sorting.Permut"
},
{
"path": "README.adoc",
"chars": 5499,
"preview": ":toc:\n\n= Kami -- A Coq-based DSL for specifying and proving hardware designs\n\n== What is Kami?\nKami is an umbrella term "
},
{
"path": "Rewrites/Notations_rewrites.v",
"chars": 22591,
"preview": "(*\n * Notations_rewrites.v\n *\n * Rewriting rules useful for Notation definitions\n *)\nRequire Import Kami.AllNotations.\nR"
},
{
"path": "Rewrites/ReflectionImpl.v",
"chars": 44275,
"preview": "Require Import Kami.Notations.\nRequire Import Kami.Syntax.\nRequire Import List.\nRequire Import Kami.Rewrites.Notations_r"
},
{
"path": "Rewrites/ReflectionOrig.v",
"chars": 27253,
"preview": "Require Import Kami.Notations.\nRequire Import Kami.Syntax.\nRequire Import List.\nRequire Import Kami.Rewrites.Notations_r"
},
{
"path": "Rewrites/ReflectionPre.v",
"chars": 118698,
"preview": "Require Import Kami.Notations.\nRequire Import Kami.Syntax.\nRequire Import List.\nRequire Import Kami.Rewrites.Notations_r"
},
{
"path": "Rewrites/ReflectionSoundTheorems1.v",
"chars": 20853,
"preview": "Require Import Kami.Notations.\nRequire Import Kami.Syntax.\nRequire Import List.\nRequire Import Kami.Rewrites.Notations_r"
},
{
"path": "Rewrites/ReflectionSoundTheorems2.v",
"chars": 4998,
"preview": "Require Import Kami.Notations.\nRequire Import Kami.Syntax.\nRequire Import List.\nRequire Import Kami.Rewrites.Notations_r"
},
{
"path": "Rewrites/ReflectionSoundTopTheorems.v",
"chars": 5716,
"preview": "Require Import Kami.Notations.\nRequire Import Kami.Syntax.\nRequire Import List.\nRequire Import Kami.Rewrites.Notations_r"
},
{
"path": "SignatureMatch.v",
"chars": 7440,
"preview": "Require Import Kami.Syntax.\nRequire Import Kami.WfActionT.\n\nInductive SigFailure :=\n| NativeMismatch : SigFailure\n| Sign"
},
{
"path": "Simulator/CoqSim/Eval.v",
"chars": 9121,
"preview": "Require Import Compare_dec List String Streams FinFun.\nImport ListNotations Fin2Restrict.\n\nRequire Import Kami.AllNotati"
},
{
"path": "Simulator/CoqSim/HaskellTypes.v",
"chars": 8220,
"preview": "Require Extraction.\nRequire Import String Fin.\nRequire Import Kami.All.\nRequire Import Kami.Simulator.CoqSim.Misc.\n\nExtr"
},
{
"path": "Simulator/CoqSim/Misc.v",
"chars": 5680,
"preview": "Require Import Fin Bool Kami.Lib.EclecticLib String Ascii List Streams.\nImport ListNotations.\n\nFixpoint Fin n :=\n match"
},
{
"path": "Simulator/CoqSim/RegisterFile.v",
"chars": 13242,
"preview": "Require Import String.\nRequire Import FinFun.\n\nRequire Import Kami.AllNotations.\nRequire Import Kami.Syntax.\n\nRequire Im"
},
{
"path": "Simulator/CoqSim/Simulator.v",
"chars": 14386,
"preview": "Require Import Streams.\n\n\nRequire Import Kami.Simulator.CoqSim.Misc.\nRequire Import Kami.Simulator.CoqSim.TransparentPro"
},
{
"path": "Simulator/CoqSim/TransparentProofs.v",
"chars": 3670,
"preview": "Require Import Kami.AllNotations.\n\nLemma Bool_eqb_refl2 : forall b, Bool.eqb b b = true.\nProof.\n destruct b; simpl; aut"
},
{
"path": "Simulator/NativeTest.v",
"chars": 1858,
"preview": "Require Import Kami.All.\nRequire Import String.\n\nSection TestNative.\n\nLocal Open Scope kami_expr.\nLocal Open Scope kami_"
},
{
"path": "Simulator/README.adoc",
"chars": 3353,
"preview": "== How to use the Haskell Simulator\n\n[arabic]\n. Make sure you have Haskell and GHC installed. You will need the\nfollowin"
},
{
"path": "StateMonad.v",
"chars": 1024,
"preview": "Require Import List.\n\nSet Implicit Arguments.\nSet Asymmetric Patterns.\n\nDefinition State (s a: Type) := s -> (a * s).\n\nD"
},
{
"path": "Syntax.v",
"chars": 92598,
"preview": "Require Export Bool Ascii String Fin List FunctionalExtensionality Psatz PeanoNat.\nRequire Export Kami.Lib.VectorFacts K"
},
{
"path": "SyntaxDoubleWrites.v",
"chars": 5310,
"preview": "Require Export Bool Ascii String List FunctionalExtensionality Psatz PeanoNat.\nRequire Export Kami.Lib.Word Kami.Lib.Vec"
},
{
"path": "Tactics.v",
"chars": 10075,
"preview": "Require Import Kami.Lib.EclecticLib Kami.Syntax Kami.Properties.\n\nLtac struct_get_field_ltac packet name :=\n let val :="
},
{
"path": "Tutorial/ExtractEx.v",
"chars": 458,
"preview": "Require Import Kami.All.\nRequire Import Kami.Tutorial.TacticsEx.\n\n(* Example of how to extract a module to be used by th"
},
{
"path": "Tutorial/GallinaActionEx.v",
"chars": 2179,
"preview": "Require Import Kami.AllNotations.\n\nSection Ex.\n (* The usual boiler plate *)\n Local Open Scope kami_expr.\n Local Open"
},
{
"path": "Tutorial/PhoasEx.v",
"chars": 4724,
"preview": "Require Import String List.\nSet Implicit Arguments.\nSet Asymmetric Patterns.\n\n(* A simple language to write a sequence o"
},
{
"path": "Tutorial/SyntaxEx.v",
"chars": 18700,
"preview": "Require Import Kami.AllNotations.\n\n(* In order to write a Kami module, one first opens a section using the same name as "
},
{
"path": "Tutorial/TacticsEx.v",
"chars": 4015,
"preview": "Require Import Kami.AllNotations.\n\nSection Named.\n Variable sz: nat.\n Variable name: string.\n Local Notation \"@^ x\" :"
},
{
"path": "Utila.v",
"chars": 50303,
"preview": "(*\n This library contains useful functions for generating Kami\n expressions.\n *)\nRequire Import Kami.Syntax Kami.Notat"
},
{
"path": "WfActionT.v",
"chars": 17616,
"preview": "Require Export Bool Ascii String Fin List FunctionalExtensionality Psatz PeanoNat.\nRequire Export Kami.Syntax.\n\nInductiv"
},
{
"path": "WfMod_Helper.v",
"chars": 8399,
"preview": "(*\n * Helper theorems and tactics for verifying WfMod properties\n *)\nRequire Import Kami.AllNotations.\nRequire Import Ka"
},
{
"path": "_CoqProject",
"chars": 51,
"preview": "-Q . Kami -Q ../coq-record-update/src RecordUpdate\n"
},
{
"path": "fixHaskell.sh",
"chars": 3979,
"preview": "#!/usr/bin/env bash\n\nmkdir -p $1\n\ncmd=\"ghc $GHCFLAGS -j -O1 --make ./FixLits.hs\"\n\necho $cmd\n\n$cmd\n\necho \"Fixing Literals"
},
{
"path": "kami.el",
"chars": 1860,
"preview": ";; Syntax hightlighting and indentation for Kami code.\n;; Author : Murali Vijayaraghavan\n;; Organization : SiFive\n\n(setq"
}
]
About this extraction
This page contains the full source code of the sifive/Kami GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 66 files (1.9 MB), approximately 606.4k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.