From e3fa3d7bfeb5ef8f0af4dfd0e5e283bcb173609c Mon Sep 17 00:00:00 2001 From: George Mamais Date: Sun, 4 Aug 2024 13:05:32 +0300 Subject: [PATCH 01/35] ICD improvements --- BackendAst/DAstACN.fs | 96 +++++++++++++++++++----------------- BackendAst/GenerateAcnIcd.fs | 22 ++++++++- 2 files changed, 71 insertions(+), 47 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index 09b6d17f6..bb22f0e8a 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -1745,7 +1745,8 @@ type private SequenceChildResult = { existVar: string option props: SequenceChildProps typeKindEncoding: TypeEncodingKind option - icdComments : string list + //icdComments : string list + icdResult : ((IcdRow list) * (IcdTypeAss list)) } with member this.joinedBodies (lm:LanguageMacros) (codec:CommonTypes.Codec): string option = this.stmts |> List.choose (fun s -> s.body) |> nestChildItems lm codec @@ -1846,47 +1847,40 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi | true -> [] | false -> [{IcdRow.fieldName = "Presence Mask"; comments = [$"Presence bit mask"]; sPresent="always";sType=IcdPlainType "bit mask"; sConstraint=None; minLengthInBits = sPresenceBitIndexMap.Count.AsBigInt ;maxLengthInBits=sPresenceBitIndexMap.Count.AsBigInt;sUnits=None; rowType = IcdRowType.LengthDeterminantRow; idxOffset = None}] - let icdFnc fieldName sPresent comments = - let chRows0, compositeChildren0 = - children |> - List.map(fun c -> - match c with - | Asn1Child c -> - let optionality = - match c.Optionality with - | None -> "always" - | Some(AlwaysAbsent ) -> "never" - | Some(AlwaysPresent) -> "always" - | Some(Optional opt) -> - match opt.acnPresentWhen with - | None -> $"when bit %d{sPresenceBitIndexMap[c.Name.Value]} is set in the uPER bit mask" - | Some(PresenceWhenBool relPath) -> $"when %s{relPath.AsString} is true" - | Some(PresenceWhenBoolExpression acnExp) -> - let dummyScope = {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} - let retExp = acnExpressionToBackendExpression o dummyScope acnExp - $"when %s{retExp}" - let comments = c.Comments |> Seq.toList - let childIcdTas = c.Type.icdTas - //let isRef = match c.Type.Kind with ReferenceType _ -> true | _ -> false - match c.Type.icdTas with - | Some childIcdTas -> - match childIcdTas.canBeEmbedded with - | true -> - let chRows, _ = childIcdTas.createRowsFunc c.Name.Value optionality comments - chRows, [] - | false -> - let sType = TypeHash childIcdTas.hash - [{IcdRow.fieldName = c.Name.Value; comments = comments; sPresent=optionality;sType=sType; sConstraint=None; minLengthInBits = c.Type.acnMinSizeInBits; maxLengthInBits=c.Type.acnMaxSizeInBits;sUnits=None; rowType = IcdRowType.LengthDeterminantRow; idxOffset = None}], [childIcdTas] - | None -> - [], [] - | AcnChild c -> - let icdRow = createAcnChildIcdFunction c c.Name.Value (c.Comments |> Seq.toList) - [icdRow], []) |> - List.unzip - let chRows = chRows0 |> List.collect id - let compositeChildren = compositeChildren0 |> List.collect id - uperPresenceMask@chRows |> List.mapi(fun i r -> {r with idxOffset = Some (i+1)}), compositeChildren - let icd = {IcdArgAux.canBeEmbedded = false; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} + + let icd_asn1_child (c:Asn1Child) (extra_comments:string list) : ((IcdRow list) * (IcdTypeAss list)) = + let optionality = + match c.Optionality with + | None -> "always" + | Some(AlwaysAbsent ) -> "never" + | Some(AlwaysPresent) -> "always" + | Some(Optional opt) -> + match opt.acnPresentWhen with + | None -> $"when bit %d{sPresenceBitIndexMap[c.Name.Value]} is set in the uPER bit mask" + | Some(PresenceWhenBool relPath) -> $"when %s{relPath.AsString} is true" + | Some(PresenceWhenBoolExpression acnExp) -> + let dummyScope = {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} + let retExp = acnExpressionToBackendExpression o dummyScope acnExp + $"when %s{retExp}" + let comments = (c.Comments |> Seq.toList)@extra_comments + let childIcdTas = c.Type.icdTas + //let isRef = match c.Type.Kind with ReferenceType _ -> true | _ -> false + match c.Type.icdTas with + | Some childIcdTas -> + match childIcdTas.canBeEmbedded with + | true -> + let chRows, _ = childIcdTas.createRowsFunc c.Name.Value optionality comments + chRows, [] + | false -> + let sType = TypeHash childIcdTas.hash + [{IcdRow.fieldName = c.Name.Value; comments = comments; sPresent=optionality;sType=sType; sConstraint=None; minLengthInBits = c.Type.acnMinSizeInBits; maxLengthInBits=c.Type.acnMaxSizeInBits;sUnits=None; rowType = IcdRowType.LengthDeterminantRow; idxOffset = None}], [childIcdTas] + | None -> + [], [] + + let icd_acn_child (c:AcnChild) (extra_comments:string list) : ((IcdRow list) * (IcdTypeAss list))= + let icdRow = createAcnChildIcdFunction c c.Name.Value ((c.Comments |> Seq.toList)@extra_comments) + [icdRow], [] + let funcBody (us:State) (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = @@ -2064,13 +2058,14 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi else childTpeKind let typeInfo = {uperMaxSizeBits=child.uperMaxSizeInBits; acnMaxSizeBits=child.acnMaxSizeInBits; typeKind=tpeKind} let props = {sel=Some (childSel.joined lm.lg); uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits; typeInfo=typeInfo} - let res = {stmts=stmts; resultExpr=childResultExpr; existVar=existVar; props=props; typeKindEncoding=tpeKind;icdComments=icdComments} + let icdResult = icd_asn1_child child icdComments + let res = {stmts=stmts; resultExpr=childResultExpr; existVar=existVar; props=props; typeKindEncoding=tpeKind;icdResult=icdResult} let newAcc = {us=ns3; childIx=s.childIx + 1I; uperAccBits=s.uperAccBits + child.uperMaxSizeInBits; acnAccBits=s.acnAccBits + child.acnMaxSizeInBits} res, newAcc | AcnChild acnChild -> //handle updates let childP = {CallerScope.modName = p.modName; arg= Selection.valueEmptyPath (getAcnDeterminantName acnChild.id)} - + let updateStatement, ns1 = match codec with | Encode -> @@ -2108,7 +2103,8 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi // Note: uperMaxSizeBits and uperAccBits here do not make sense since we are in ACN let typeInfo = {uperMaxSizeBits=0I; acnMaxSizeBits=child.acnMaxSizeInBits; typeKind=childTpeKind} let props = {sel=Some (childP.arg.joined lm.lg); uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits; typeInfo=typeInfo} - let res = {stmts=stmts; resultExpr=None; existVar=None; props=props; typeKindEncoding=childTpeKind; icdComments=icdComments} + let icdResult = icd_acn_child acnChild icdComments + let res = {stmts=stmts; resultExpr=None; existVar=None; props=props; typeKindEncoding=childTpeKind; icdResult=icdResult} let newAcc = {us=ns2; childIx=s.childIx + 1I; uperAccBits=s.uperAccBits; acnAccBits=s.acnAccBits + acnChild.Type.acnMaxSizeInBits} res, newAcc // find acn inserted fields, which are not NULL types and which have no dependency. @@ -2169,6 +2165,13 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let resultExpr = p.arg.asIdentifier Some resultExpr, [lm.uper.sequence_build resultExpr (typeDefinition.longTypedefName2 lm.lg.hasModules) (existSeq@childrenResultExpr)] | _ -> None, [] + + let icdFnc fieldName sPresent comments = + let chRows0, compositeChildren0 = childrenStatements00 |> List.map (fun s -> s.icdResult) |> List.unzip + let chRows = chRows0 |> List.collect id + let compositeChildren = compositeChildren0 |> List.collect id + uperPresenceMask@chRows |> List.mapi(fun i r -> {r with idxOffset = Some (i+1)}), compositeChildren + let icd = {IcdArgAux.canBeEmbedded = false; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} let seqContent = (saveInitialBitStrmStatements@childrenStatements@(post_encoding_function |> Option.toList)@seqBuild) |> nestChildItems lm codec match existsAcnChildWithNoUpdates with @@ -2443,12 +2446,15 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF let td = lm.lg.getTypeDefinition t.FT_TypeDefinition let getNewSType (r:IcdRow) = + (* let newType = match r.sType with | TypeHash hash -> TypeHash hash | IcdPlainType plainType when r.rowType = FieldRow -> IcdPlainType (td.asn1Name + "(" + plainType + ")") | IcdPlainType plainType -> IcdPlainType plainType {r with sType = newType} + *) + r let icdFnc,extraComment, name = match o.encodingOptions with diff --git a/BackendAst/GenerateAcnIcd.fs b/BackendAst/GenerateAcnIcd.fs index 6fdf0bfd9..0c0eda6d1 100644 --- a/BackendAst/GenerateAcnIcd.fs +++ b/BackendAst/GenerateAcnIcd.fs @@ -690,7 +690,25 @@ let PrintTasses2 stgFileName (r:AstRoot) : string list = | None -> None) |> Seq.toList - +let printTasses3 stgFileName (r:DAst.AstRoot) : string list = + let pdus = r.args.icdPdus |> Option.map Set.ofList + seq { + for f in r.Files do + for m in f.Modules do + for tas in m.TypeAssignments do + match pdus.IsNone || pdus.Value.Contains tas.Name.Value with + | true -> + match tas.Type.icdTas with + | Some icdTas -> + let icdTassesHash = getMySelfAndChildren r icdTas + yield! icdTassesHash + | None -> () + | false -> () + } |> Seq.distinct + |> Seq.choose(fun hash -> + match r.icdHashes.TryFind hash with + | Some chIcdTas -> Some (emitTas2 stgFileName r (fun _ -> []) (selectTypeWithSameHash chIcdTas)) + | None -> None) |> Seq.toList let PrintAsn1FileInColorizedHtml (stgFileName:string) (r:AstRoot) (f:Asn1File) = //let tryCreateRefType = CreateAsn1AstFromAntlrTree.CreateRefTypeContent @@ -769,7 +787,7 @@ let PrintAsn1FileInColorizedHtml (stgFileName:string) (r:AstRoot) (f:Asn1File) = let DoWork (r:AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (stgFileName:string) (asn1HtmlStgFileMacros:string option) outFileName = let files1 = r.Files |> Seq.map (fun f -> PrintTasses stgFileName f r ) - let files1b = PrintTasses2 stgFileName r + let files1b = printTasses3 stgFileName r let bAcnParamsMustBeExplained = true let asn1HtmlMacros = match asn1HtmlStgFileMacros with From 426cec5f064ce1e341ba60e300476a9a3deb41b7 Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Fri, 23 Aug 2024 16:57:09 +0200 Subject: [PATCH 02/35] rename checkByteArrayBitContent to byteArrayBitContentSame --- .../scala/asn1scala/asn1jvm_Bitstream.scala | 23 ++++++++++--------- asn1scala/stainless.conf | 6 ++--- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 325c68805..b3fdd64e1 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -1096,7 +1096,7 @@ case class BitStream private [asn1scala]( bGot == bit && r2Got == this && r2Got.bitIndex == this.bitIndex - // && checkByteArrayBitContent(Array(b.toUByte), vGot, bitNr, 0 , 1) + // && byteArrayBitContentSame(Array(b.toUByte), vGot, bitNr, 0 , 1) } ) @@ -1466,7 +1466,7 @@ case class BitStream private [asn1scala]( val (r1, r2) = reader(beforeAppend, this) val vGot = r1.readBits(to - i) assert(to - i == 0) - check(checkByteArrayBitContent(srcBuffer, vGot, i, 0, to - i)) + check(byteArrayBitContentSame(srcBuffer, vGot, i, 0, to - i)) }) }.ensuring( _ => @@ -1528,8 +1528,8 @@ case class BitStream private [asn1scala]( val (readerrr, _) = reader(w1, w2) assert(bitStreamReadBitsIntoList(readerrr, nBits) == byteArrayBitContentToList(srcBuffer, from, nBits)) // Should work - lemmaSameBitContentListThenCheckByteArrayBitContent(srcBuffer, vGot, from, 0, nBits) - assert(checkByteArrayBitContent(srcBuffer, vGot, from, 0, nBits) ) + lemmaSameBitContentListThenbyteArrayBitContentSame(srcBuffer, vGot, from, 0, nBits) + assert(byteArrayBitContentSame(srcBuffer, vGot, from, 0, nBits) ) }) }.ensuring(_ => @@ -1538,7 +1538,8 @@ case class BitStream private [asn1scala]( srcBuffer == old(srcBuffer) &&& BitStream.invariant(currentBit, currentByte, buf.length) &&& w1.buf.length == w2.buf.length - &&& BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits + &&& BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == + BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits &&& w1.isPrefixOf(w2) &&& { @@ -1546,7 +1547,7 @@ case class BitStream private [asn1scala]( validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) val vGot = r1.readBits(nBits) - checkByteArrayBitContent(srcBuffer, vGot, from, 0, nBits) + byteArrayBitContentSame(srcBuffer, vGot, from, 0, nBits) } ) @@ -1634,7 +1635,7 @@ case class BitStream private [asn1scala]( */ @ghost @pure - def checkByteArrayBitContent(arr1: Array[UByte], arr2: Array[UByte], from1: Long, from2: Long, nBits: Long): Boolean = { + def byteArrayBitContentSame(arr1: Array[UByte], arr2: Array[UByte], from1: Long, from2: Long, nBits: Long): Boolean = { require(from1 >= 0) require(from2 >= 0) require(nBits >= 0) @@ -1657,13 +1658,13 @@ case class BitStream private [asn1scala]( if b1 != b2 then false else - checkByteArrayBitContent(arr1, arr2, from1 + 1, from2 + 1, nBits - 1) + byteArrayBitContentSame(arr1, arr2, from1 + 1, from2 + 1, nBits - 1) } @opaque @ghost @pure - def lemmaSameBitContentListThenCheckByteArrayBitContent(arr1: Array[UByte], arr2: Array[UByte], fromArr1: Long, fromArr2: Long, nBits: Long): Unit = { + def lemmaSameBitContentListThenbyteArrayBitContentSame(arr1: Array[UByte], arr2: Array[UByte], fromArr1: Long, fromArr2: Long, nBits: Long): Unit = { require(fromArr1 >= 0) require(fromArr2 >= 0) require(nBits >= 0) @@ -1675,8 +1676,8 @@ case class BitStream private [asn1scala]( decreases(nBits) if nBits > 0 then - lemmaSameBitContentListThenCheckByteArrayBitContent(arr1, arr2, fromArr1 + 1, fromArr2 + 1, nBits - 1) - } ensuring(_ => checkByteArrayBitContent(arr1, arr2, fromArr1, fromArr2, nBits)) + lemmaSameBitContentListThenbyteArrayBitContentSame(arr1, arr2, fromArr1 + 1, fromArr2 + 1, nBits - 1) + } ensuring(_ => byteArrayBitContentSame(arr1, arr2, fromArr1, fromArr2, nBits)) diff --git a/asn1scala/stainless.conf b/asn1scala/stainless.conf index 1910527d6..b0919113d 100644 --- a/asn1scala/stainless.conf +++ b/asn1scala/stainless.conf @@ -1,8 +1,8 @@ # The settings below correspond to the various # options listed by `stainless --help` -vc-cache = false -debug = ["smt"] +vc-cache = true +# debug = ["smt"] timeout = 1200 check-models = false print-ids = false @@ -13,4 +13,4 @@ solvers = "smt-cvc5,smt-z3,smt-cvc4" check-measures = yes infer-measures = true simplifier = "ol" -no-colors = true +no-colors = false From d0b904e5688b472634972420e34b55147cdc1f81 Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Fri, 23 Aug 2024 17:00:52 +0200 Subject: [PATCH 03/35] rename 2 functions of bistream --- .../scala/asn1scala/asn1jvm_Bitstream.scala | 104 +++++++++--------- .../main/scala/asn1scala/asn1jvm_Codec.scala | 26 ++--- .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 18 +-- 3 files changed, 74 insertions(+), 74 deletions(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index b3fdd64e1..14df5f2d8 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -334,17 +334,17 @@ object BitStream { // TODO: "loopPrefixLemma" is a bad name, it's not the same "prefix lemma" as the others!!! @ghost @pure @opaque @inlineOnce - def readNLeastSignificantBitsLoopPrefixLemma(bs: BitStream, nBits: Int, i: Int, acc: Long): Unit = { + def readNLSBBitsMSBFirstLoopPrefixLemma(bs: BitStream, nBits: Int, i: Int, acc: Long): Unit = { require(0 <= i && i < nBits && nBits <= 64) require(BitStream.validate_offset_bits(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong, nBits - i)) require((acc & onesLSBLong(nBits - i)) == 0L) require((acc & onesLSBLong(nBits)) == acc) decreases(nBits - i) - val (bsFinal, vGot1) = bs.readNLeastSignificantBitsLoopPure(nBits, i, acc) + val (bsFinal, vGot1) = bs.readNLSBBitsMSBFirstLoopPure(nBits, i, acc) val readBit = bs.readBitPure()._2 val bs2 = bs.withMovedBitIndex(1) val newAcc = acc | (if readBit then 1L << (nBits - 1 - i) else 0) - val (bs2Final, vGot2) = bs2.readNLeastSignificantBitsLoopPure(nBits, i + 1, newAcc) + val (bs2Final, vGot2) = bs2.readNLSBBitsMSBFirstLoopPure(nBits, i + 1, newAcc) { () @@ -354,7 +354,7 @@ object BitStream { } @ghost @pure @opaque @inlineOnce - def readNLeastSignificantBitsLoopPrefixLemma2(bs1: BitStream, bs2: BitStream, nBits: Int, i: Int, acc: Long): Unit = { + def readNLSBBitsMSBFirstLoopPrefixLemma2(bs1: BitStream, bs2: BitStream, nBits: Int, i: Int, acc: Long): Unit = { require(bs1.buf.length == bs2.buf.length) require(0 <= i && i < nBits && nBits <= 64) require(BitStream.validate_offset_bits(bs1.buf.length.toLong, bs1.currentByte.toLong, bs1.currentBit.toLong, nBits - i)) @@ -369,8 +369,8 @@ object BitStream { decreases(nBits - i) val bs2Reset = bs2.resetAt(bs1) - val (bsFinal1, vGot1) = bs1.readNLeastSignificantBitsLoopPure(nBits, i, acc) - val (bsFinal2, vGot2) = bs2Reset.readNLeastSignificantBitsLoopPure(nBits, i, acc) + val (bsFinal1, vGot1) = bs1.readNLSBBitsMSBFirstLoopPure(nBits, i, acc) + val (bsFinal2, vGot2) = bs2Reset.readNLSBBitsMSBFirstLoopPure(nBits, i, acc) { val (bs1Rec, gotB1) = bs1.readBitPure() @@ -385,9 +385,9 @@ object BitStream { val accRec = acc | (if gotB1 then 1L << (nBits - 1 - i) else 0) assert(BitStream.bitIndex(bs1Rec.buf.length, bs1Rec.currentByte, bs1Rec.currentBit ) == BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) validateOffsetBitsContentIrrelevancyLemma(bs1, bs1Rec.buf, 1) - readNLeastSignificantBitsLoopPrefixLemma2(bs1Rec, bs2Rec, nBits, i + 1, accRec) - val (_, vRecGot1) = bs1Rec.readNLeastSignificantBitsLoopPure(nBits, i + 1, accRec) - val (_, vRecGot2) = bs2Rec.readNLeastSignificantBitsLoopPure(nBits, i + 1, accRec) + readNLSBBitsMSBFirstLoopPrefixLemma2(bs1Rec, bs2Rec, nBits, i + 1, accRec) + val (_, vRecGot1) = bs1Rec.readNLSBBitsMSBFirstLoopPure(nBits, i + 1, accRec) + val (_, vRecGot2) = bs2Rec.readNLSBBitsMSBFirstLoopPure(nBits, i + 1, accRec) assert(vRecGot1 == vRecGot2) assert(vGot1 == vRecGot1) assert(vGot2 == vRecGot2) @@ -401,7 +401,7 @@ object BitStream { } @ghost @pure @opaque @inlineOnce - def readNLeastSignificantBitsPrefixLemma(bs1: BitStream, bs2: BitStream, nBits: Int): Unit = { + def readNLSBBitsMSBFirstPrefixLemma(bs1: BitStream, bs2: BitStream, nBits: Int): Unit = { require(bs1.buf.length == bs2.buf.length) require(0 <= nBits && nBits <= 64) require(BitStream.validate_offset_bits(bs1.buf.length.toLong, bs1.currentByte.toLong, bs1.currentBit.toLong, nBits)) @@ -413,19 +413,19 @@ object BitStream { )) val bs2Reset = bs2.resetAt(bs1) - val (bsFinal1, vGot1) = bs1.readNLeastSignificantBitsPure(nBits) - val (bsFinal2, vGot2) = bs2Reset.readNLeastSignificantBitsPure(nBits) + val (bsFinal1, vGot1) = bs1.readNLSBBitsMSBFirstPure(nBits) + val (bsFinal2, vGot2) = bs2Reset.readNLSBBitsMSBFirstPure(nBits) { if (nBits > 0) - readNLeastSignificantBitsLoopPrefixLemma2(bs1, bs2, nBits, 0, 0) + readNLSBBitsMSBFirstLoopPrefixLemma2(bs1, bs2, nBits, 0, 0) }.ensuring { _ => vGot1 == vGot2 && BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) } } @ghost @pure @opaque @inlineOnce - def readNLeastSignificantBitsLoopNextLemma(bs: BitStream, nBits: Int, i: Int, acc1: Long): Unit = { + def readNLSBBitsMSBFirstLoopNextLemma(bs: BitStream, nBits: Int, i: Int, acc1: Long): Unit = { require(0 <= i && i < nBits && nBits <= 64) require(1 <= nBits) require(BitStream.validate_offset_bits(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong, nBits - i)) @@ -433,22 +433,22 @@ object BitStream { require((acc1 & onesLSBLong(nBits)) == acc1) decreases(nBits - i) - val (bsFinal1, vGot1) = bs.readNLeastSignificantBitsLoopPure(nBits, i, acc1) + val (bsFinal1, vGot1) = bs.readNLSBBitsMSBFirstLoopPure(nBits, i, acc1) val (bs2, bit) = bs.readBitPure() val mask = if bit then 1L << (nBits - 1 - i) else 0 val acc2 = (acc1 | mask) & onesLSBLong(nBits - 1) - val (bsFinal2, vGot2) = bs2.readNLeastSignificantBitsLoopPure(nBits - 1, i, acc2) + val (bsFinal2, vGot2) = bs2.readNLSBBitsMSBFirstLoopPure(nBits - 1, i, acc2) { if (i >= nBits - 2) () else { val acc1Rec = acc1 | mask - readNLeastSignificantBitsLoopNextLemma(bs2, nBits, i + 1, acc1Rec) - val (bsFinal1Rec, vGot1Rec) = bs2.readNLeastSignificantBitsLoopPure(nBits, i + 1, acc1Rec) + readNLSBBitsMSBFirstLoopNextLemma(bs2, nBits, i + 1, acc1Rec) + val (bsFinal1Rec, vGot1Rec) = bs2.readNLSBBitsMSBFirstLoopPure(nBits, i + 1, acc1Rec) val (bs2Rec, bitRec) = bs2.readBitPure() val maskRec = if bitRec then 1L << (nBits - 2 - i) else 0 val acc2Rec = (acc1Rec | maskRec) & onesLSBLong(nBits - 1) - val (bsFinal2Rec, vGot2Rec) = bs2Rec.readNLeastSignificantBitsLoopPure(nBits - 1, i + 1, acc2Rec) + val (bsFinal2Rec, vGot2Rec) = bs2Rec.readNLSBBitsMSBFirstLoopPure(nBits - 1, i + 1, acc2Rec) assert((vGot1Rec & onesLSBLong(nBits - 1)) == vGot2Rec) assert(bsFinal1Rec == bsFinal2Rec) @@ -467,49 +467,49 @@ object BitStream { } @ghost @pure @opaque @inlineOnce - def readNLeastSignificantBitsLeadingZerosLemma(bs: BitStream, nBits: Int, leadingZeros: Int): Unit = { + def readNLSBBitsMSBFirstLeadingZerosLemma(bs: BitStream, nBits: Int, leadingZeros: Int): Unit = { require(0 <= leadingZeros && leadingZeros <= nBits && nBits <= 64) require(BitStream.validate_offset_bits(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong, nBits)) - require(bs.readNLeastSignificantBitsPure(leadingZeros)._2 == 0L) + require(bs.readNLSBBitsMSBFirstPure(leadingZeros)._2 == 0L) decreases(leadingZeros) - val (bsFinal1, vGot1) = bs.readNLeastSignificantBitsPure(nBits) - val (bsFinal2, vGot2) = bs.withMovedBitIndex(leadingZeros).readNLeastSignificantBitsPure(nBits - leadingZeros) + val (bsFinal1, vGot1) = bs.readNLSBBitsMSBFirstPure(nBits) + val (bsFinal2, vGot2) = bs.withMovedBitIndex(leadingZeros).readNLSBBitsMSBFirstPure(nBits - leadingZeros) { - readNLeastSignificantBitsLeadingBitsLemma(bs, false, nBits, leadingZeros) + readNLSBBitsMSBFirstLeadingBitsLemma(bs, false, nBits, leadingZeros) }.ensuring { _ => vGot1 == vGot2 && bsFinal1 == bsFinal2 } } @ghost @pure @opaque @inlineOnce - def readNLeastSignificantBitsLeadingBitsLemma(bs: BitStream, bit: Boolean, nBits: Int, leadingBits: Int): Unit = { + def readNLSBBitsMSBFirstLeadingBitsLemma(bs: BitStream, bit: Boolean, nBits: Int, leadingBits: Int): Unit = { require(0 <= leadingBits && leadingBits <= nBits && nBits <= 64) require(BitStream.validate_offset_bits(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong, nBits)) - require(bs.readNLeastSignificantBitsPure(leadingBits)._2 == bitLSBLong(bit, leadingBits)) + require(bs.readNLSBBitsMSBFirstPure(leadingBits)._2 == bitLSBLong(bit, leadingBits)) decreases(leadingBits) - val (bsFinal1, vGot1) = bs.readNLeastSignificantBitsPure(nBits) - val (bsFinal2, vGot2) = bs.withMovedBitIndex(leadingBits).readNLeastSignificantBitsPure(nBits - leadingBits) + val (bsFinal1, vGot1) = bs.readNLSBBitsMSBFirstPure(nBits) + val (bsFinal2, vGot2) = bs.withMovedBitIndex(leadingBits).readNLSBBitsMSBFirstPure(nBits - leadingBits) { if (leadingBits == 0) () else { val (bsRec, gotBit) = bs.readBitPure() assert(gotBit == bit) - readNLeastSignificantBitsLoopNextLemma(bs, leadingBits, 0, 0L) - readNLeastSignificantBitsLeadingBitsLemma(bsRec, bit, nBits - 1, leadingBits - 1) + readNLSBBitsMSBFirstLoopNextLemma(bs, leadingBits, 0, 0L) + readNLSBBitsMSBFirstLeadingBitsLemma(bsRec, bit, nBits - 1, leadingBits - 1) eqBufAndBitIndexImpliesEq(bs.withMovedBitIndex(leadingBits), bsRec.withMovedBitIndex(leadingBits - 1)) - val (bsFinal1Rec, vGot1Rec) = bsRec.readNLeastSignificantBitsPure(nBits - 1) - val (bsFinal2Rec, vGot2Rec) = bsRec.withMovedBitIndex(leadingBits - 1).readNLeastSignificantBitsPure(nBits - leadingBits) + val (bsFinal1Rec, vGot1Rec) = bsRec.readNLSBBitsMSBFirstPure(nBits - 1) + val (bsFinal2Rec, vGot2Rec) = bsRec.withMovedBitIndex(leadingBits - 1).readNLSBBitsMSBFirstPure(nBits - leadingBits) assert(bsFinal1Rec == bsFinal2Rec) assert(vGot1Rec == ((bitLSBLong(bit, leadingBits - 1) << (nBits - leadingBits)) | vGot2Rec)) assert(bsFinal2 == bsFinal2Rec) assert(vGot2 == vGot2Rec) - readNLeastSignificantBitsLoopNextLemma(bs, nBits, 0, 0L) + readNLSBBitsMSBFirstLoopNextLemma(bs, nBits, 0, 0L) assert(bsFinal1Rec == bsFinal1) assert(vGot1 == (vGot1Rec | (if (bit) 1L << (nBits - 1) else 0L))) check(vGot1 == ((bitLSBLong(bit, leadingBits) << (nBits - leadingBits)) | vGot2)) @@ -529,7 +529,7 @@ object BitStream { // val (bs1Final, ok) = bs.checkBitsLoopPure(nBits, bit, from) // require(ok) // val acc = if (bit) onesLSBLong(from) << (nBits - from) else 0 - // val (bs2Final, vGot) = bs.readNLeastSignificantBitsLoopPure(nBits, from, acc) + // val (bs2Final, vGot) = bs.readNLSBBitsMSBFirstLoopPure(nBits, from, acc) // { // if (from == nBits) () @@ -1289,11 +1289,11 @@ case class BitStream private [asn1scala]( * After bit 24, bit 23 and so on get added * */ - def appendNLeastSignificantBits(v: Long, nBits: Int): Unit = { + def appendLSBBitsMSBFirst(v: Long, nBits: Int): Unit = { require(nBits >= 0 && nBits <= NO_OF_BITS_IN_LONG) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) require((v & onesLSBLong(nBits)) == v) - appendNLeastSignificantBitsLoop(v, nBits, 0) + appendLSBBitsMSBFirstLoop(v, nBits, 0) }.ensuring { _ => val w1 = old(this) val w2 = this @@ -1301,12 +1301,12 @@ case class BitStream private [asn1scala]( && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) - val (r2Got, vGot) = r1.readNLeastSignificantBitsPure(nBits) + val (r2Got, vGot) = r1.readNLSBBitsMSBFirstPure(nBits) vGot == v && r2Got == r2 } } - def appendNLeastSignificantBitsLoop(v: Long, nBits: Int, i: Int): Unit = { + def appendLSBBitsMSBFirstLoop(v: Long, nBits: Int, i: Int): Unit = { require(0 <= i && i <= nBits && nBits <= 64) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) require((v & onesLSBLong(nBits)) == v) @@ -1317,7 +1317,7 @@ case class BitStream private [asn1scala]( @ghost val oldThis1 = snapshot(this) appendBit(b) @ghost val oldThis2 = snapshot(this) - appendNLeastSignificantBitsLoop(v, nBits, i + 1) + appendLSBBitsMSBFirstLoop(v, nBits, i + 1) ghostExpr { lemmaIsPrefixTransitive(oldThis1, oldThis2, this) @@ -1330,15 +1330,15 @@ case class BitStream private [asn1scala]( val zeroed = v & ~onesLSBLong(nBits - i) validateOffsetBitsContentIrrelevancyLemma(oldThis1, this.buf, nBits - i) - val (r3Got_13, resGot_13) = r1_13.readNLeastSignificantBitsLoopPure(nBits, i, zeroed) + val (r3Got_13, resGot_13) = r1_13.readNLSBBitsMSBFirstLoopPure(nBits, i, zeroed) val upd = zeroed | (if bitGot then 1L << (nBits - 1 - i) else 0) validateOffsetBitsContentIrrelevancyLemma(oldThis2, this.buf, nBits - i - 1) - val (r3Got_23, resGot_23) = r2_23.readNLeastSignificantBitsLoopPure(nBits, i + 1, upd) + val (r3Got_23, resGot_23) = r2_23.readNLSBBitsMSBFirstLoopPure(nBits, i + 1, upd) assert(r3Got_23 == r3_23) - readNLeastSignificantBitsLoopPrefixLemma(r1_13, nBits, i, zeroed) + readNLSBBitsMSBFirstLoopPrefixLemma(r1_13, nBits, i, zeroed) check(r1_13 == r3_13.withMovedBitIndex(BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit) - BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) )) check(r2_23 == r3_23.withMovedBitIndex(BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit) - BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) )) @@ -1362,7 +1362,7 @@ case class BitStream private [asn1scala]( val (r1, r2) = reader(w1, w2) val zeroed = v & ~onesLSBLong(nBits - i) validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits - i) - val (r2Got, vGot) = r1.readNLeastSignificantBitsLoopPure(nBits, i, zeroed) + val (r2Got, vGot) = r1.readNLSBBitsMSBFirstLoopPure(nBits, i, zeroed) vGot == v && r2Got == r2 } } @@ -2206,29 +2206,29 @@ case class BitStream private [asn1scala]( } /** - * Counter Operation to appendNLeastSignificantBits + * Counter Operation to appendLSBBitsMSBFirst * @param nBits number of bits to read [0-64] * @return value that holds nBits from bitstream * * Remarks: * The last bit from the bitstream will get written into the LSB */ - def readNLeastSignificantBits(nBits: Int): Long = { + def readNLSBBitsMSBFirst(nBits: Int): Long = { require(nBits >= 0 && nBits <= 64) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) - readNLeastSignificantBitsLoop(nBits, 0, 0L) + readNLSBBitsMSBFirstLoop(nBits, 0, 0L) }.ensuring(_ => buf == old(this).buf && BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits) @ghost @pure - def readNLeastSignificantBitsPure(nBits: Int): (BitStream, Long) = { + def readNLSBBitsMSBFirstPure(nBits: Int): (BitStream, Long) = { require(nBits >= 0 && nBits <= 64) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) val cpy = snapshot(this) - val res = cpy.readNLeastSignificantBits(nBits) + val res = cpy.readNLSBBitsMSBFirst(nBits) (cpy, res) } - def readNLeastSignificantBitsLoop(nBits: Int, i: Int, acc: Long): Long = { + def readNLSBBitsMSBFirstLoop(nBits: Int, i: Int, acc: Long): Long = { require(0 <= i && i <= nBits && nBits <= 64) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) require((acc & onesLSBLong(nBits - i)) == 0L) // The nBits - i LSBs must be 0 @@ -2239,7 +2239,7 @@ case class BitStream private [asn1scala]( } else { val bit = readBit() val newAcc = acc | (if bit then 1L << (nBits - 1 - i) else 0) - readNLeastSignificantBitsLoop(nBits, i + 1, newAcc) + readNLSBBitsMSBFirstLoop(nBits, i + 1, newAcc) } }.ensuring { res => buf == old(this).buf && @@ -2250,13 +2250,13 @@ case class BitStream private [asn1scala]( } @ghost @pure - def readNLeastSignificantBitsLoopPure(nBits: Int, i: Int, acc: Long): (BitStream, Long) = { + def readNLSBBitsMSBFirstLoopPure(nBits: Int, i: Int, acc: Long): (BitStream, Long) = { require(0 <= i && i <= nBits && nBits <= 64) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) require((acc & onesLSBLong(nBits - i)) == 0L) // The nBits - i LSBs must be 0 require((acc & onesLSBLong(nBits)) == acc) val cpy = snapshot(this) - val res = cpy.readNLeastSignificantBitsLoop(nBits, i, acc) + val res = cpy.readNLSBBitsMSBFirstLoop(nBits, i, acc) (cpy, res) } diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index a68eca4e6..3adb97ce5 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -111,7 +111,7 @@ object Codec { val (c1_2, nBytes1) = c1.bitStream.readBytePure() val (c2_2, nBytes2) = c2Reset.bitStream.readBytePure() assert(nBytes1 == nBytes2) - readNLeastSignificantBitsPrefixLemma(c1_2, c2_2, nBytes1.unsignedToInt * 8) + readNLSBBitsMSBFirstPrefixLemma(c1_2, c2_2, nBytes1.unsignedToInt * 8) }.ensuring { _ => l1 == l2 && BitStream.bitIndex(c1Res.bitStream.buf.length, c1Res.bitStream.currentByte, c1Res.bitStream.currentBit) == BitStream.bitIndex(c2Res.bitStream.buf.length, c2Res.bitStream.currentByte, c2Res.bitStream.currentBit) } @@ -135,7 +135,7 @@ object Codec { val (c2Res, l2) = c2Reset.decodeConstrainedPosWholeNumberPure(min, max) { - readNLeastSignificantBitsPrefixLemma(c1.bitStream, c2.bitStream, nBits) + readNLSBBitsMSBFirstPrefixLemma(c1.bitStream, c2.bitStream, nBits) }.ensuring { _ => l1 == l2 && BitStream.bitIndex(c1Res.bitStream.buf.length, c1Res.bitStream.currentByte, c1Res.bitStream.currentBit) == BitStream.bitIndex(c2Res.bitStream.buf.length, c2Res.bitStream.currentByte, c2Res.bitStream.currentBit) } @@ -196,7 +196,7 @@ case class Codec(bitStream: BitStream) { @opaque @inlineOnce def encodeUnsignedInteger(v: ULong): Unit = { require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,GetBitCountUnsigned(v))) - appendNLeastSignificantBits(v.toRaw, GetBitCountUnsigned(v)) + appendLSBBitsMSBFirst(v.toRaw, GetBitCountUnsigned(v)) } .ensuring { _ => val w1 = old(this) val w2 = this @@ -221,7 +221,7 @@ case class Codec(bitStream: BitStream) { require(nBits >= 0 && nBits <= NO_OF_BITS_IN_LONG) require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nBits)) - ULong.fromRaw(readNLeastSignificantBits(nBits)) + ULong.fromRaw(readNLSBBitsMSBFirst(nBits)) }.ensuring(_ => buf == old(this).buf && BitStream.bitIndex(this.bitStream.buf.length, this.bitStream.currentByte, this.bitStream.currentBit) == BitStream.bitIndex(old(this).bitStream.buf.length, old(this).bitStream.currentByte, old(this).bitStream.currentBit) + nBits) @ghost @pure @@ -264,7 +264,7 @@ case class Codec(bitStream: BitStream) { @ghost val nEncValBits = GetBitCountUnsigned(encVal) - appendNLeastSignificantBits(encVal, nRangeBits) + appendLSBBitsMSBFirst(encVal, nRangeBits) else ghostExpr { lemmaIsPrefixRefl(bitStream) @@ -355,7 +355,7 @@ case class Codec(bitStream: BitStream) { //SAMassert(nRangeBits >= nEncValBits) //SAMassert(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nRangeBits)) - appendNLeastSignificantBits(encVal, nRangeBits) + appendLSBBitsMSBFirst(encVal, nRangeBits) // else // ghostExpr { // lemmaIsPrefixRefl(bitStream) @@ -408,7 +408,7 @@ case class Codec(bitStream: BitStream) { else val nRangeBits = GetBitCountUnsigned(range.toRawULong) assert(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nRangeBits)) - val decVal = readNLeastSignificantBits(nRangeBits) + val decVal = readNLSBBitsMSBFirst(nRangeBits) // assert(min + decVal <= max) // TODO: Invalid @@ -507,7 +507,7 @@ case class Codec(bitStream: BitStream) { // encode length appendByte(nBytes.toRawUByte) // encode value - appendNLeastSignificantBits(encV.toRaw, nBytes * NO_OF_BITS_IN_BYTE) + appendLSBBitsMSBFirst(encV.toRaw, nBytes * NO_OF_BITS_IN_BYTE) }.ensuring(_ => buf.length == old(this).buf.length && BitStream.bitIndex(this.bitStream.buf.length, this.bitStream.currentByte, this.bitStream.currentBit) == BitStream.bitIndex(old(this).bitStream.buf.length, old(this).bitStream.currentByte, old(this).bitStream.currentBit) + GetLengthForEncodingUnsigned(stainless.math.wrapping(v - min).toRawULong) * 8L + 8L) @@ -536,7 +536,7 @@ case class Codec(bitStream: BitStream) { val v: ULong = if(!(nBits >= 0 && nBits <= 64) || !BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, nBits)){ 0L.toRawULong } else { - readNLeastSignificantBits(nBits).toRawULong + readNLSBBitsMSBFirst(nBits).toRawULong } // SAM: here the post condition should be obvious, as ULong are always positive. But we can have @@ -569,7 +569,7 @@ case class Codec(bitStream: BitStream) { /* encode length */ appendByte(nBytes.toRawUByte) /* encode number */ - appendNLeastSignificantBits(encV, nBytes * NO_OF_BITS_IN_BYTE) + appendLSBBitsMSBFirst(encV, nBytes * NO_OF_BITS_IN_BYTE) } /** @@ -593,7 +593,7 @@ case class Codec(bitStream: BitStream) { val v = if(!(nBits >= 0 && nBits <= 64) || !BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, nBits)){ 0L.toRawULong } else { - readNLeastSignificantBits(nBits).toRawULong + readNLSBBitsMSBFirst(nBits).toRawULong } val res: ULong = ULong.fromRaw(v + min) // For some reasons, the scala compiler chokes on this being returned res @@ -625,7 +625,7 @@ case class Codec(bitStream: BitStream) { @ghost val this2 = snapshot(this) // encode number - appendNLeastSignificantBits(v & onesLSBLong(nBits), nBits) + appendLSBBitsMSBFirst(v & onesLSBLong(nBits), nBits) /* ghostExpr { validTransitiveLemma(this1.bitStream, this2.bitStream, this.bitStream) @@ -675,7 +675,7 @@ case class Codec(bitStream: BitStream) { // check bitstream precondition //SAM assert(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nBytes)) //SAM assert(0 <= nBytes && nBytes <= 8) - val read = readNLeastSignificantBits(nBits) + val read = readNLSBBitsMSBFirst(nBits) val res = if (read == 0 || nBits == 0 || nBits == 64 || (read & (1L << (nBits - 1))) == 0L) read else onesMSBLong(64 - nBits) | read // Sign extension diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 356335299..3cb66f74a 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -264,15 +264,15 @@ case class ACN(base: Codec) { validateOffsetImpliesMoveBits(r1_1.base.bitStream, diff) assert(r2_2 == r1_1.withMovedBitIndex(diff)) // TODO: Exported symbol not working - // val (r2Got_2, vGot_2) = r2_2.readNLeastSignificantBitsLoopPure(nBits, 0, 0L) - val (r2Got_2, vGot_2) = r2_2.base.bitStream.readNLeastSignificantBitsLoopPure(nBits, 0, 0L) + // val (r2Got_2, vGot_2) = r2_2.readNLSBBitsMSBFirstLoopPure(nBits, 0, 0L) + val (r2Got_2, vGot_2) = r2_2.base.bitStream.readNLSBBitsMSBFirstLoopPure(nBits, 0, 0L) assert(vGot_2 == intVal.toRaw) - val (r3Got_3, vGot_3) = r1_1.base.bitStream.readNLeastSignificantBitsLoopPure(encodedSizeInBits, 0, 0L) + val (r3Got_3, vGot_3) = r1_1.base.bitStream.readNLSBBitsMSBFirstLoopPure(encodedSizeInBits, 0, 0L) assert(iGot.toRaw == vGot_3) assert(r3Got.base.bitStream == r3Got_3) checkBitsLoopAndReadNLSB(r1_1.base.bitStream, diff, false) - readNLeastSignificantBitsLeadingZerosLemma(r1_1.base.bitStream, encodedSizeInBits, diff) + readNLSBBitsMSBFirstLeadingZerosLemma(r1_1.base.bitStream, encodedSizeInBits, diff) check(iGot == intVal) check(r3Got == r3_1) } else { @@ -693,7 +693,7 @@ case class ACN(base: Codec) { validateOffsetBitsDifferenceLemma(this1.base.bitStream, this.base.bitStream, formatBitLength, addedBits) } // @ghost val this2 = snapshot(this) - appendNLeastSignificantBits(v & onesLSBLong(nBits), nBits) + appendLSBBitsMSBFirst(v & onesLSBLong(nBits), nBits) /*ghostExpr { assert(BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(this2.base.bitStream.buf.length, this2.base.bitStream.currentByte, this2.base.bitStream.currentBit) + nBits) assert(BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(this1.base.bitStream.buf.length, this1.base.bitStream.currentByte, this1.base.bitStream.currentBit) + formatBitLength) @@ -710,13 +710,13 @@ case class ACN(base: Codec) { assert(r3_1 == r3_2) validateOffsetImpliesMoveBits(r1_1.base.bitStream, addedBits) assert(r2_2 == r1_1.withMovedBitIndex(addedBits)) - val (r2Got_2, vGot_2) = r2_2.base.bitStream.readNLeastSignificantBitsLoopPure(nBits, 0, 0L) + val (r2Got_2, vGot_2) = r2_2.base.bitStream.readNLSBBitsMSBFirstLoopPure(nBits, 0, 0L) assert(vGot_2 == (v & onesLSBLong(nBits))) - val (r3Got_3, vGot_3) = r1_1.base.bitStream.readNLeastSignificantBitsLoopPure(formatBitLength, 0, 0L) + val (r3Got_3, vGot_3) = r1_1.base.bitStream.readNLSBBitsMSBFirstLoopPure(formatBitLength, 0, 0L) checkBitsLoopAndReadNLSB(r1_1.base.bitStream, addedBits, v < 0) - readNLeastSignificantBitsLeadingBitsLemma(r1_1.base.bitStream, v < 0, formatBitLength, addedBits) + readNLSBBitsMSBFirstLeadingBitsLemma(r1_1.base.bitStream, v < 0, formatBitLength, addedBits) assert(vGot == (bitMSBLong(v < 0, NO_OF_BITS_IN_LONG - formatBitLength) | vGot_3)) assert(r3Got.base.bitStream == r3Got_3) assert(((vGot_3 & (1L << (formatBitLength - 1))) == 0L) == v >= 0) @@ -793,7 +793,7 @@ case class ACN(base: Codec) { require(encodedSizeInBits >= 0 && encodedSizeInBits <= NO_OF_BITS_IN_LONG) require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, encodedSizeInBits)) - val res = readNLeastSignificantBits(encodedSizeInBits) + val res = readNLSBBitsMSBFirst(encodedSizeInBits) if encodedSizeInBits == 0 || (res & (1L << (encodedSizeInBits - 1))) == 0L then res else onesMSBLong(NO_OF_BITS_IN_LONG - encodedSizeInBits) | res /* From cea317b7ff9f920158498b575d74854d9286ae6c Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Fri, 23 Aug 2024 17:16:41 +0200 Subject: [PATCH 04/35] renaming --- .../src/main/scala/asn1scala/asn1jvm.scala | 2 +- .../scala/asn1scala/asn1jvm_Bitstream.scala | 14 +++++------ .../main/scala/asn1scala/asn1jvm_Codec.scala | 24 +++++++++---------- .../asn1scala/asn1jvm_Verification.scala | 4 ++-- asn1scala/verify_bitStream.sh | 1 + 5 files changed, 23 insertions(+), 22 deletions(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm.scala index 5de9f1bc5..e8ecf8d46 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm.scala @@ -335,7 +335,7 @@ def GetCharIndex(ch: UByte, charSet: Array[UByte]): Int = i += 1 ).invariant(i >= 0 &&& i <= charSet.length && ret < charSet.length && ret >= 0) ret -} ensuring(res => charSet.length == 0 || res >= 0 && res < charSet.length) +}.ensuring(res => charSet.length == 0 || res >= 0 && res < charSet.length) def NullType_Initialize(): NullType = { 0 diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 14df5f2d8..09c799ff4 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -106,7 +106,7 @@ object BitStream { lemmaIsPrefixTransitive(r1, w1, w2) lemmaIsPrefixTransitive(r1, w2, r2) (r1, r2) - } ensuring(res => + }.ensuring(res => res._1.isPrefixOf(res._2) && res._1.isPrefixOf(w1) && res._2.isPrefixOf(w2) @@ -840,7 +840,7 @@ case class BitStream private [asn1scala]( def resetAt(b: BitStream): BitStream = { require(b.buf.length == buf.length) BitStream(snapshot(buf), b.currentByte, b.currentBit) - } ensuring(res => invariant(res)) + }.ensuring(res => invariant(res)) // ****************** Append Bit Functions ********************** @@ -1568,7 +1568,7 @@ case class BitStream private [asn1scala]( else val bit = bitStreamSnap.readBit() Cons(bit, bitStreamReadBitsIntoList(bitStreamSnap, nBits - 1)) - } ensuring( res => if(nBits == 0) then res.isEmpty else res.length > 0 ) // we'd like to prove res.length == nBits but it's not possible because of type mismatch + }.ensuring( res => if(nBits == 0) then res.isEmpty else res.length > 0 ) // we'd like to prove res.length == nBits but it's not possible because of type mismatch @ghost @opaque @@ -1593,7 +1593,7 @@ case class BitStream private [asn1scala]( val bitStream1Snap = snapshot(bitStream1) assert(bitStream1.readBitPure()._2 == listBits.head) () - } ensuring(_ => + }.ensuring(_ => bitStreamReadBitsIntoList(bitStream2, nBits - 1) == listBits.tail ) @@ -1677,7 +1677,7 @@ case class BitStream private [asn1scala]( if nBits > 0 then lemmaSameBitContentListThenbyteArrayBitContentSame(arr1, arr2, fromArr1 + 1, fromArr2 + 1, nBits - 1) - } ensuring(_ => byteArrayBitContentSame(arr1, arr2, fromArr1, fromArr2, nBits)) + }.ensuring(_ => byteArrayBitContentSame(arr1, arr2, fromArr1, fromArr2, nBits)) @@ -2038,7 +2038,7 @@ case class BitStream private [asn1scala]( val arr: Array[Byte] = Array.fill(arrLen)(0 : Byte) readBitsLoop(nBits, arr, 0, nBits) UByte.fromArrayRaws(arr) - } ensuring(res => + }.ensuring(res => buf == old(this).buf &&& BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) &&& BitStream.invariant(this.currentBit, this.currentByte, this.buf.length) @@ -2106,7 +2106,7 @@ case class BitStream private [asn1scala]( require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) val arr = readBits(nBits) Vector.fromScala(arr.toVector) - } ensuring(res => + }.ensuring(res => buf == old(this).buf && BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) && BitStream.invariant(this.currentBit, this.currentByte, this.buf.length) && res.length == ((nBits + NO_OF_BITS_IN_BYTE - 1) / NO_OF_BITS_IN_BYTE).toInt diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index 3adb97ce5..ebd73d886 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -419,7 +419,7 @@ case class Codec(bitStream: BitStream) { min else res - } ensuring( res => + }.ensuring( res => buf == old(this).buf && res >= min && res <= max && BitStream.invariant(bitStream.currentBit, bitStream.currentByte, bitStream.buf.length) && @@ -1348,7 +1348,7 @@ case class Codec(bitStream: BitStream) { ghostExpr(check(nCurOffset1 >= 0 )) ghostExpr(check(nRemainingItemsVar1 <= 0x4000 )) (nRemainingItemsVar1, nCurOffset1) - } ensuring(res => + }.ensuring(res => BitStream.bitIndex(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit ) <= bitIndex + (nRemainingItemsVar1 / 0x4000) * 8 + nRemainingItemsVar1 * 8 - res._1 * 8 && BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, res._1 + 2) && BitStream.invariant(bitStream.currentBit, bitStream.currentByte, bitStream.buf.length) && @@ -1397,7 +1397,7 @@ case class Codec(bitStream: BitStream) { assert(bitIndexAfterRecursive == bitIndexBeforeRecursive + (to - from - 1) * NO_OF_BITS_IN_BYTE) assert(NO_OF_BITS_IN_BYTE + (to - from - 1) * NO_OF_BITS_IN_BYTE == (to - from) * NO_OF_BITS_IN_BYTE) assert(bitIndexAfterRecursive == bitIndexBeforeAppending + NO_OF_BITS_IN_BYTE + (to - from - 1) * NO_OF_BITS_IN_BYTE) - } ensuring(_ => + }.ensuring(_ => val oldBitStream = old(this).bitStream BitStream.bitIndex(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit ) == bitIndex + (to - from) * NO_OF_BITS_IN_BYTE && oldBitStream.buf.length == bitStream.buf.length @@ -1409,14 +1409,14 @@ case class Codec(bitStream: BitStream) { @inlineOnce def lemmaGetBitCountUnsignedFFEqualsEight(): Unit = { - } ensuring(_ => GetBitCountUnsigned(stainless.math.wrapping(0xFF).toRawULong) == 8) + }.ensuring(_ => GetBitCountUnsigned(stainless.math.wrapping(0xFF).toRawULong) == 8) @ghost @opaque @inlineOnce def lemmaGetBitCountUnsigned7FFFEquals15(): Unit = { - } ensuring(_ => GetBitCountUnsigned(stainless.math.wrapping(0x7FFF).toRawULong) == 15) + }.ensuring(_ => GetBitCountUnsigned(stainless.math.wrapping(0x7FFF).toRawULong) == 15) @ghost @opaque @@ -1429,7 +1429,7 @@ case class Codec(bitStream: BitStream) { require(offsetBits == offsetBytes * 8) require(BitStream.validate_offset_bits(bufLength, currentByte, currentBit, offsetBits)) - } ensuring(_ => BitStream.validate_offset_bytes(bufLength, currentByte, currentBit, offsetBytes)) + }.ensuring(_ => BitStream.validate_offset_bytes(bufLength, currentByte, currentBit, offsetBytes)) /** * Takes more than 100sec to verify, that's why it is extracted to a lemma, even though it does not need a specific proof * @@ -1463,7 +1463,7 @@ case class Codec(bitStream: BitStream) { require(bitIndex2 - bitIndex1 <= offset1Bits - offset2Bits) require(BitStream.validate_offset_bits(bufLength, currentByte1, currentBit1, offset1Bits)) - } ensuring(_ => BitStream.validate_offset_bits(bufLength, currentByte2, currentBit2, offset2Bits)) + }.ensuring(_ => BitStream.validate_offset_bits(bufLength, currentByte2, currentBit2, offset2Bits)) /** @@ -1550,7 +1550,7 @@ case class Codec(bitStream: BitStream) { val newArr: Array[UByte] = Array.fill(nLengthTmp1.toInt)(0.toRawUByte) arrayCopyOffsetLen(arr, newArr, 0, 0, newArr.length) newArr - } ensuring(_ => BitStream.invariant(bitStream.currentBit, bitStream.currentByte, bitStream.buf.length)) + }.ensuring(_ => BitStream.invariant(bitStream.currentBit, bitStream.currentByte, bitStream.buf.length)) /** @@ -1654,7 +1654,7 @@ case class Codec(bitStream: BitStream) { assert(arr.length == asn1SizeMax.toInt) decodeOctetString_fragmentation_innerWhile(arr, asn1SizeMax, newNCurOffset1) - } ensuring(res => + }.ensuring(res => (res._2 >= 0 && res._2 <= asn1SizeMax || res == (-1L, -1L)) && BitStream.invariant(bitStream.currentBit, bitStream.currentByte, bitStream.buf.length) && old(this).bitStream.buf.length == bitStream.buf.length && @@ -1701,7 +1701,7 @@ case class Codec(bitStream: BitStream) { decodeOctetString_fragmentation_innerMostWhile(arr, asn1SizeMax, from + 1, to) () - } ensuring(_ => + }.ensuring(_ => old(this).buf.length == bitStream.buf.length && arr.length == asn1SizeMax.toInt && BitStream.invariant(bitStream.currentBit, bitStream.currentByte, bitStream.buf.length) && @@ -1887,7 +1887,7 @@ case class Codec(bitStream: BitStream) { assert(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, newRemaingItems + 8*(newRemaingItems / 0x4000) + 16)) encodeBitString_while(arr, nCount, asn1SizeMin, asn1SizeMax, newRemaingItems, newOffset, newBitIndex) - } ensuring (res => + }.ensuring (res => BitStream.invariant(bitStream.currentBit, bitStream.currentByte, bitStream.buf.length) && // BitStream.bitIndex(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit ) <= bitIndex + (nRemainingItemsVar1 / 0x4000) * 8 + nRemainingItemsVar1 - res._1 && BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, res._1 + 16) && @@ -2062,7 +2062,7 @@ case class Codec(bitStream: BitStream) { return (-1L, -1L) decodeBitString_while(asn1SizeMin, asn1SizeMax, newNCurOffset1, arr) - } ensuring (res => + }.ensuring (res => res == (-1L, -1L) || res._1 >= 0 && res._1 <= 0xFF && diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Verification.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Verification.scala index a4bf5780a..50e39ca95 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Verification.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Verification.scala @@ -33,14 +33,14 @@ def arrayCopyOffset[T](@pure src: Array[T], dst: Array[T], fromSrc: Int, toSrc: dst(fromDst) = src(fromSrc) arrayCopyOffset(src, dst, fromSrc + 1, toSrc, fromDst + 1) } -} ensuring ( _ => old(dst).length == dst.length) +}.ensuring ( _ => old(dst).length == dst.length) def arrayCopyOffsetLen[T](@pure src: Array[T], dst: Array[T], fromSrc: Int, fromDst: Int, len: Int): Unit = { require(0 <= len && len <= src.length && len <= dst.length) require(0 <= fromSrc && fromSrc <= src.length - len) require(0 <= fromDst && fromDst <= dst.length - len) arrayCopyOffset(src, dst, fromSrc, fromSrc + len, fromDst) -} ensuring ( _ => old(dst).length == dst.length) +}.ensuring ( _ => old(dst).length == dst.length) @pure def arrayBitIndices(fromBit: Long, toBit: Long): (Int, Int, Int, Int) = { diff --git a/asn1scala/verify_bitStream.sh b/asn1scala/verify_bitStream.sh index 41a81670b..ca58b4383 100755 --- a/asn1scala/verify_bitStream.sh +++ b/asn1scala/verify_bitStream.sh @@ -3,6 +3,7 @@ src/main/scala/asn1scala/asn1jvm.scala \ src/main/scala/asn1scala/asn1jvm_Verification.scala \ src/main/scala/asn1scala/asn1jvm_Helper.scala \ src/main/scala/asn1scala/asn1jvm_Bitstream.scala \ +src/main/scala/asn1scala/asn1jvm_Vector.scala \ --config-file=stainless.conf \ -D-parallel=5 \ $1 From b6b234ba923893cb9b2d20ed051699ffc0116c5f Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Fri, 23 Aug 2024 18:12:04 +0200 Subject: [PATCH 05/35] with lemma --- asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala | 2 +- asn1scala/stainless.conf | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 09c799ff4..11bf44c3e 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -984,7 +984,7 @@ case class BitStream private [asn1scala]( assert(r3Got_23 == r3_23) - // checkBitsLoopPrefixLemma(r1_13, nBits, bit, from) // not needed but speed up verification + checkBitsLoopPrefixLemma(r1_13, nBits, bit, from) // not needed but speed up verification assert(r2_23 == r1_13.withMovedBitIndex(1)) check(resGot_13 == resGot_23) // timeout check(r3Got_13 == r3_13) diff --git a/asn1scala/stainless.conf b/asn1scala/stainless.conf index b0919113d..eaeb70164 100644 --- a/asn1scala/stainless.conf +++ b/asn1scala/stainless.conf @@ -12,5 +12,5 @@ strict-arithmetic = true solvers = "smt-cvc5,smt-z3,smt-cvc4" check-measures = yes infer-measures = true -simplifier = "ol" +simplifier = "bland" no-colors = false From f3446721e772905cb43ee55d1504d8a6986b67ce Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Tue, 27 Aug 2024 10:01:43 +0200 Subject: [PATCH 06/35] new annotations for proof to pass --- .../scala/asn1scala/asn1jvm_Bitstream.scala | 128 +++++++++--------- 1 file changed, 67 insertions(+), 61 deletions(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 11bf44c3e..695de0620 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -566,65 +566,65 @@ object BitStream { } } - // @ghost @pure @opaque @inlineOnce - // def checkBitsLoopPrefixLemma2(bs1: BitStream, bs2: BitStream, nBits: Int, expected: Boolean, from: Long): Unit = { - // require(bs1.buf.length == bs2.buf.length) - // require(0 < nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) - // require(0 <= from && from < nBits) - // require(BitStream.validate_offset_bits(bs1.buf.length.toLong, bs1.currentByte.toLong, bs1.currentBit.toLong, nBits - from)) - // require(arrayBitRangesEq( - // bs1.buf, - // bs2.buf, - // 0, - // BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + nBits - from - // )) - // decreases(nBits - from) + @ghost @pure @opaque @inlineOnce + def checkBitsLoopPrefixLemma2(bs1: BitStream, bs2: BitStream, nBits: Int, expected: Boolean, from: Long): Unit = { + require(bs1.buf.length == bs2.buf.length) + require(0 < nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) + require(0 <= from && from < nBits) + require(BitStream.validate_offset_bits(bs1.buf.length.toLong, bs1.currentByte.toLong, bs1.currentBit.toLong, nBits - from)) + require(arrayBitRangesEq( + bs1.buf, + bs2.buf, + 0, + BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + nBits - from + )) + decreases(nBits - from) - // val bs2Reset = bs2.resetAt(bs1) - // val (bsFinal1, vGot1) = bs1.checkBitsLoopPure(nBits, expected, from) - // val (bsFinal2, vGot2) = bs2Reset.checkBitsLoopPure(nBits, expected, from) + val bs2Reset = bs2.resetAt(bs1) + val (bsFinal1, vGot1) = bs1.checkBitsLoopPure(nBits, expected, from) + val (bsFinal2, vGot2) = bs2Reset.checkBitsLoopPure(nBits, expected, from) - // val bsFinal1PureBitIndex = BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) - // val bsFinal2PureBitIndex = BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) + val bsFinal1PureBitIndex = BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) + val bsFinal2PureBitIndex = BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) - // { - // val (bs1Rec, gotB1) = bs1.readBitPure() - // val (bs2Rec, gotB2) = bs2Reset.readBitPure() - // arrayBitRangesEqSlicedLemma(bs1.buf, bs2.buf, 0, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + nBits - from, 0, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) - // readBitPrefixLemma(bs1, bs2) - // assert(gotB1 == gotB2) - // if (from == nBits - 1) { - // check(vGot1 == vGot2) - // assert(BitStream.invariant(bsFinal1)) - // check(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) - // } else { - // assert(BitStream.invariant(bs1Rec)) - // assert(BitStream.bitIndex(bs1Rec.buf.length, bs1Rec.currentByte, bs1Rec.currentBit ) == BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) - // validateOffsetBitsContentIrrelevancyLemma(bs1, bs1Rec.buf, 1) - // assert(BitStream.invariant(bs1Rec)) - // assert((BitStream.validate_offset_bits(bs1Rec.buf.length.toLong, bs1Rec.currentByte.toLong, bs1Rec.currentBit.toLong, nBits - from - 1))) - // checkBitsLoopPrefixLemma2(bs1Rec, bs2Rec, nBits, expected, from + 1) - - // val (_, vRecGot1) = bs1Rec.checkBitsLoopPure(nBits, expected, from + 1) - // assert((BitStream.validate_offset_bits(bs2Rec.buf.length.toLong, bs2Rec.currentByte.toLong, bs2Rec.currentBit.toLong, nBits - from - 1))) - // val (_, vRecGot2) = bs2Rec.checkBitsLoopPure(nBits, expected, from + 1) - - // assert(vRecGot1 == vRecGot2) - // assert(vGot1 == ((gotB1 == expected) && vRecGot1)) - // assert(vGot2 == ((gotB1 == expected) && vRecGot2)) - - // check(vGot1 == vGot2) - // assert(BitStream.invariant(bsFinal2.currentBit, bsFinal2.currentByte, bsFinal2.buf.length)) - // assert(BitStream.invariant(bsFinal1.currentBit, bsFinal1.currentByte, bsFinal1.buf.length)) - // assert(bsFinal2PureBitIndex == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) - // assert(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == bsFinal1PureBitIndex) - // assert(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) // 200sec!!! - // check(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) - // } - // }.ensuring { _ => - // vGot1 == vGot2 && BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) - // } - // } + { + val (bs1Rec, gotB1) = bs1.readBitPure() + val (bs2Rec, gotB2) = bs2Reset.readBitPure() + arrayBitRangesEqSlicedLemma(bs1.buf, bs2.buf, 0, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + nBits - from, 0, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) + readBitPrefixLemma(bs1, bs2) + assert(gotB1 == gotB2) + if (from == nBits - 1) { + check(vGot1 == vGot2) + assert(BitStream.invariant(bsFinal1)) + check(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) + } else { + assert(BitStream.invariant(bs1Rec)) + assert(BitStream.bitIndex(bs1Rec.buf.length, bs1Rec.currentByte, bs1Rec.currentBit ) == BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) + validateOffsetBitsContentIrrelevancyLemma(bs1, bs1Rec.buf, 1) + assert(BitStream.invariant(bs1Rec)) + assert((BitStream.validate_offset_bits(bs1Rec.buf.length.toLong, bs1Rec.currentByte.toLong, bs1Rec.currentBit.toLong, nBits - from - 1))) + checkBitsLoopPrefixLemma2(bs1Rec, bs2Rec, nBits, expected, from + 1) + + val (_, vRecGot1) = bs1Rec.checkBitsLoopPure(nBits, expected, from + 1) + assert((BitStream.validate_offset_bits(bs2Rec.buf.length.toLong, bs2Rec.currentByte.toLong, bs2Rec.currentBit.toLong, nBits - from - 1))) + val (_, vRecGot2) = bs2Rec.checkBitsLoopPure(nBits, expected, from + 1) + + assert(vRecGot1 == vRecGot2) + assert(vGot1 == ((gotB1 == expected) && vRecGot1)) + assert(vGot2 == ((gotB1 == expected) && vRecGot2)) + + check(vGot1 == vGot2) + assert(BitStream.invariant(bsFinal2.currentBit, bsFinal2.currentByte, bsFinal2.buf.length)) + assert(BitStream.invariant(bsFinal1.currentBit, bsFinal1.currentByte, bsFinal1.buf.length)) + assert(bsFinal2PureBitIndex == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) + assert(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == bsFinal1PureBitIndex) + assert(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) // 200sec!!! + check(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) + } + }.ensuring { _ => + vGot1 == vGot2 && BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) + } + } // @ghost @pure @opaque @inlineOnce // def readByteArrayLoopAnyArraysLemma(bs: BitStream, arr1: Array[UByte], arr2: Array[UByte], from: Int, to: Int): Unit = { @@ -971,11 +971,15 @@ case class BitStream private [asn1scala]( lemmaIsPrefixTransitive(oldThis1, oldThis2, this) readBitPrefixLemma(oldThis2.resetAt(oldThis1), this) + check(BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit ) == BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit) + 1) + val (r1_13, r3_13) = reader(oldThis1, this) val (r2_23, r3_23) = reader(oldThis2, this) val (_, bitGot) = r1_13.readBitPure() check(bitGot == bit) + check(r2_23 == r1_13.withMovedBitIndex(1)) + validateOffsetBitsContentIrrelevancyLemma(oldThis1, this.buf, nBits - from) val (r3Got_13, resGot_13) = r1_13.checkBitsLoopPure(nBits, bit, from) @@ -984,10 +988,12 @@ case class BitStream private [asn1scala]( assert(r3Got_23 == r3_23) - checkBitsLoopPrefixLemma(r1_13, nBits, bit, from) // not needed but speed up verification + // checkBitsLoopPrefixLemma(r1_13, nBits, bit, from) // not needed but speed up verification + check(resGot_23) assert(r2_23 == r1_13.withMovedBitIndex(1)) check(resGot_13 == resGot_23) // timeout check(r3Got_13 == r3_13) + check(resGot_13) } @@ -1002,9 +1008,9 @@ case class BitStream private [asn1scala]( val w1 = old(this) val w2 = this w1.buf.length == w2.buf.length - && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + (nBits - from) - && w1.isPrefixOf(w2) - && { + &&& BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + (nBits - from) + &&& w1.isPrefixOf(w2) + &&& { val (r1, r2) = reader(w1, w2) validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits - from) val (r2Got, bGot) = r1.checkBitsLoopPure(nBits, bit, from) @@ -2112,7 +2118,7 @@ case class BitStream private [asn1scala]( res.length == ((nBits + NO_OF_BITS_IN_BYTE - 1) / NO_OF_BITS_IN_BYTE).toInt ) - @opaque @inlineOnce + // @opaque @inlineOnce def checkBitsLoop(nBits: Long, expected: Boolean, from: Long): Boolean = { require(0 <= nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) require(0 <= from && from <= nBits) From 6f5fcaa7668a5c4c789dcc04aea53e44c075fcc2 Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Tue, 27 Aug 2024 16:45:58 +0200 Subject: [PATCH 07/35] ACN lemmas uncommented + update to prove safety again --- .../scala/asn1scala/asn1jvm_Bitstream.scala | 20 +++--- .../main/scala/asn1scala/asn1jvm_Codec.scala | 1 - .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 67 +++++++++++-------- asn1scala/stainless.conf | 2 +- asn1scala/used_acn_functions.txt | 65 ++++++++++++++++++ asn1scala/verify.sh | 3 + asn1scala/verify_safety_acn.sh | 12 ++++ 7 files changed, 130 insertions(+), 40 deletions(-) create mode 100644 asn1scala/used_acn_functions.txt create mode 100755 asn1scala/verify_safety_acn.sh diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 695de0620..7507a1dcb 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -113,18 +113,18 @@ object BitStream { && res._1 == res._2.withMovedBitIndex(BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) - BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit)) ) - // @ghost @pure @opaque @inlineOnce - // def resetAndThenMovedLemma(b1: BitStream, b2: BitStream, moveInBits: Long): Unit = { - // require(b1.buf.length == b2.buf.length) - // require(moveInBits >= 0) - // require(BitStream.validate_offset_bits(b1.buf.length.toLong, b1.currentByte.toLong, b1.currentBit.toLong, moveInBits)) + @ghost @pure @opaque @inlineOnce + def resetAndThenMovedLemma(b1: BitStream, b2: BitStream, moveInBits: Long): Unit = { + require(b1.buf.length == b2.buf.length) + require(moveInBits >= 0) + require(BitStream.validate_offset_bits(b1.buf.length.toLong, b1.currentByte.toLong, b1.currentBit.toLong, moveInBits)) - // val b2Reset = b2.resetAt(b1) + val b2Reset = b2.resetAt(b1) - // { - // () - // }.ensuring(_ => moveBitIndexPrecond(b2Reset, moveInBits)) - // } + { + () + }.ensuring(_ => moveBitIndexPrecond(b2Reset, moveInBits)) + } @ghost @pure @opaque @inlineOnce def eqBufAndBitIndexImpliesEq(b1: BitStream, b2: BitStream): Unit = { diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index ebd73d886..dcc2d11d9 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -8,7 +8,6 @@ import stainless.proof.* import stainless.math.* import StaticChecks.{require as staticRequire, _} import scala.annotation.static -import scala.annotation.newMain val masks2: Array[Int] = Array( 0x00000000, // 0 / 0000 0000 0000 0000 0000 0000 0000 0000 / 0x0000 0000 diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 3cb66f74a..56eaaf504 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -27,7 +27,7 @@ object ACN { } // For showing invertibility of encoding - not fully integrated yet - /* + @ghost @pure @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma(acn1: ACN, acn2: ACN): Unit = { require(acn1.base.bufLength() == acn2.base.bufLength()) @@ -48,8 +48,9 @@ object ACN { val end = (BitStream.bitIndex(acn1.base.bitStream.buf.length, acn1.base.bitStream.currentByte, acn1.base.bitStream.currentBit) / 8 + 2).toInt arrayRangesEqImpliesEq(acn1.base.bitStream.buf, acn2.base.bitStream.buf, 0, acn1.base.bitStream.currentByte, end) arrayRangesEqImpliesEq(acn1.base.bitStream.buf, acn2.base.bitStream.buf, 0, acn1.base.bitStream.currentByte + 1, end) + assert(i1 == i2) }.ensuring { _ => - BitStream.bitIndex(acn1Res.base.bitStream.buf.length, acn1Res.base.bitStream.currentByte, acn1Res.base.bitStream.currentBit) == BitStream.bitIndex(acn2Res.base.bitStream.buf.length, acn2Res.base.bitStream.currentByte, acn2Res.base.bitStream.currentBit) && i1 == i2 + BitStream.bitIndex(acn1Res.base.bitStream.buf.length, acn1Res.base.bitStream.currentByte, acn1Res.base.bitStream.currentBit) == BitStream.bitIndex(acn2Res.base.bitStream.buf.length, acn2Res.base.bitStream.currentByte, acn2Res.base.bitStream.currentBit) &&& i1 == i2 } } @@ -143,7 +144,6 @@ object ACN { BitStream.bitIndex(acn1Res.base.bitStream.buf.length, acn1Res.base.bitStream.currentByte, acn1Res.base.bitStream.currentBit) == BitStream.bitIndex(acn2Res.base.bitStream.buf.length, acn2Res.base.bitStream.currentByte, acn2Res.base.bitStream.currentBit) && i1 == i2 } } - @ghost @pure @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_little_endian_32_prefixLemma(acn1: ACN, acn2: ACN): Unit = { require(acn1.base.bufLength() == acn2.base.bufLength()) @@ -208,7 +208,7 @@ object ACN { }.ensuring { _ => BitStream.bitIndex(acn1Res.base.bitStream.buf.length, acn1Res.base.bitStream.currentByte, acn1Res.base.bitStream.currentBit) == BitStream.bitIndex(acn2Res.base.bitStream.buf.length, acn2Res.base.bitStream.currentByte, acn2Res.base.bitStream.currentBit) && i1 == i2 } - }*/ + } } case class ACN(base: Codec) { import BitStream.* @@ -526,7 +526,7 @@ case class ACN(base: Codec) { (cpy, l) } - @opaque @inlineOnce + def dec_Int_PositiveInteger_ConstSize_big_endian_16(): ULong = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 16)) val b1 = readByte().toRaw @@ -542,7 +542,6 @@ case class ACN(base: Codec) { (cpy, l) } - @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_big_endian_32(): ULong = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 32)) val i1 = dec_Int_PositiveInteger_ConstSize_big_endian_16().toRaw @@ -558,7 +557,6 @@ case class ACN(base: Codec) { (cpy, l) } - @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_big_endian_64(): ULong = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 64)) val i1 = dec_Int_PositiveInteger_ConstSize_big_endian_32().toRaw @@ -574,7 +572,6 @@ case class ACN(base: Codec) { (cpy, l) } - @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_little_endian_16(): ULong = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 16)) val b1 = readByte().toRaw @@ -590,7 +587,6 @@ case class ACN(base: Codec) { (cpy, l) } - @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_little_endian_32(): ULong = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 32)) val i1 = dec_Int_PositiveInteger_ConstSize_little_endian_16().toRaw @@ -606,7 +602,6 @@ case class ACN(base: Codec) { (cpy, l) } - @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_little_endian_64(): ULong = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 64)) val i1 = dec_Int_PositiveInteger_ConstSize_little_endian_32().toRaw @@ -629,11 +624,13 @@ case class ACN(base: Codec) { var vv = v.toRaw << (NO_OF_BYTES_IN_JVM_LONG * 8 - nBytes * 8) var i: Int = 0 - while i < nBytes do + (while (i < nBytes) { + decreases(nBytes - i) val byteToEncode = ((vv & MAX_BYTE_MASK) >>> ((NO_OF_BYTES_IN_JVM_LONG - 1) * 8)).toByte appendByte(byteToEncode.toRawUByte) vv <<= 8 i += 1 + }) } def enc_Int_PositiveInteger_VarSize_LengthEmbedded(intVal: ULong): Unit = { @@ -1128,6 +1125,7 @@ case class ACN(base: Codec) { var i: Int = 0 // TODO: size_t? while i < 100 && digitsArray100(i) != 0x0 do + decreases(100 - i) appendByte(digitsArray100(i).toRawUByte) i += 1 @@ -1153,11 +1151,11 @@ case class ACN(base: Codec) { //read null_character_size characters into the tmp buffer var j: Int = 0 - (while j < null_characters_size do + (while (j < null_characters_size){ decreases(null_characters_size - j) tmp(j) = readByte().toRaw j += 1 - ).invariant(true) // TODO invariant + }).invariant(true) // TODO invariant var i: Long = 0 while !arraySameElements(null_characters, tmp) do @@ -1505,6 +1503,7 @@ case class ACN(base: Codec) { i += 1 } + @extern def enc_String_Ascii_Null_Terminated_multVec(max: Long, null_character: Array[Byte], null_character_size: Int, strVal: Vector[ASCIIChar]): Unit = { enc_String_Ascii_Null_Terminated_mult(max, null_character, null_character_size, strVal.toScala.toArray) } @@ -1523,6 +1522,7 @@ case class ACN(base: Codec) { def enc_String_CharIndex_FixSize(max: Long, allowedCharSet: Array[UByte], strVal: Array[ASCIIChar]): Unit = { var i: Int = 0 while i < max do + decreases(max -i) val charIndex: Int = GetCharIndex(strVal(i), allowedCharSet) encodeConstrainedWholeNumber(charIndex, 0, allowedCharSet.length - 1) i += 1 @@ -1694,6 +1694,7 @@ case class ACN(base: Codec) { strVal } + @extern def dec_String_Ascii_Null_Terminated_multVec(max: Long, null_character: Array[ASCIIChar], null_character_size: Int): Vector[ASCIIChar] = { val res = dec_String_Ascii_Null_Terminated_mult(max, null_character, null_character_size) Vector.fromScala(res.toVector) @@ -1725,23 +1726,33 @@ case class ACN(base: Codec) { assert(i < strVal.length) val nBitsPerElmt = GetBitCountUnsigned(stainless.math.wrapping(allowedCharSet.length - 1).toRawULong) - (while i < charactersToDecode do + var flag = false + (while !flag && i < charactersToDecode do decreases(charactersToDecode - i) if(!BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, nBitsPerElmt)) - return Array.empty - strVal(i) = allowedCharSet(decodeConstrainedWholeNumber(0, allowedCharSet.length - 1).toInt) - i += 1 + // return Array.empty + flag = true + else + strVal(i) = allowedCharSet(decodeConstrainedWholeNumber(0, allowedCharSet.length - 1).toInt) + i += 1 ).invariant( - i <= charactersToDecode && i >= 0 && - charactersToDecode < Int.MaxValue && - i < strVal.length && - max < strVal.length && - strVal.length == max.toInt + 1 && - base.bitStream.buf == oldThis.base.bitStream.buf + flag && base.bitStream.buf == oldThis.base.bitStream.buf + || !flag && ( + i <= charactersToDecode && i >= 0 && + charactersToDecode < Int.MaxValue && + charactersToDecode <= max && + charactersToDecode >= 0 && + i < strVal.length && + max < strVal.length && + strVal.length == max.toInt + 1 && + base.bitStream.buf == oldThis.base.bitStream.buf + ) ) - - strVal - }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) + if flag then + Array.empty[ASCIIChar] + else + strVal + }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && (res.length == max.toInt + 1 || res.length == 0)) def dec_String_CharIndex_FixSize(max: Long, allowedCharSet: Array[ASCIIChar]): Array[ASCIIChar] = { dec_String_CharIndex_private(max, max, allowedCharSet) @@ -1779,7 +1790,7 @@ case class ACN(base: Codec) { 0x78, 0x79, 0x7A, 0x7B, 0x7C, 0x7D, 0x7E, 0x7F ) dec_String_CharIndex_private(max, if extSizeDeterminantFld <= max then extSizeDeterminantFld else max, UByte.fromArrayRaws(allowedCharSet)) - }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) + }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && (res.length == max.toInt + 1 || res.length == 0)) @extern def dec_IA5String_CharIndex_External_Field_DeterminantVec(max: Long, extSizeDeterminantFld: Long): Vector[ASCIIChar] = { @@ -1816,7 +1827,7 @@ case class ACN(base: Codec) { val charToDecode = if nCount <= max then nCount else max assert(charToDecode >= 0 && charToDecode <= max) dec_String_CharIndex_private(max, charToDecode, UByte.fromArrayRaws(allowedCharSet)) - }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) + }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && (res.length == max.toInt + 1 || res.length == 0)) @extern def dec_IA5String_CharIndex_Internal_Field_DeterminantVec(max: Long, min: Long): Vector[ASCIIChar] = { diff --git a/asn1scala/stainless.conf b/asn1scala/stainless.conf index eaeb70164..450a2d9c6 100644 --- a/asn1scala/stainless.conf +++ b/asn1scala/stainless.conf @@ -3,7 +3,7 @@ vc-cache = true # debug = ["smt"] -timeout = 1200 +timeout = 120 check-models = false print-ids = false print-types = false diff --git a/asn1scala/used_acn_functions.txt b/asn1scala/used_acn_functions.txt new file mode 100644 index 000000000..71f49cdbb --- /dev/null +++ b/asn1scala/used_acn_functions.txt @@ -0,0 +1,65 @@ +initACNCodec +reader +dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma +dec_Int_PositiveInteger_ConstSize_big_endian_32_prefixLemma +dec_Int_PositiveInteger_ConstSize_big_endian_64_prefixLemma +dec_Int_PositiveInteger_ConstSize_little_endian_16_prefixLemma +dec_Int_PositiveInteger_ConstSize_little_endian_32_prefixLemma +dec_Int_PositiveInteger_ConstSize_little_endian_64_prefixLemma +enc_Int_PositiveInteger_ConstSize +enc_Int_PositiveInteger_ConstSize +resetAt +withMovedByteIndex +withMovedBitIndex +isPrefixOf +enc_Int_PositiveInteger_ConstSize_8 +enc_Int_PositiveInteger_ConstSize_big_endian_16 +enc_Int_PositiveInteger_ConstSize_big_endian_32 +enc_Int_PositiveInteger_ConstSize_big_endian_64 +dec_Int_PositiveInteger_ConstSize +dec_Int_PositiveInteger_ConstSize_pure +dec_Int_PositiveInteger_ConstSize_8 +dec_Int_PositiveInteger_ConstSize_8_pure +dec_Int_PositiveInteger_ConstSize_big_endian_16 +dec_Int_PositiveInteger_ConstSize_big_endian_16_pure +dec_Int_PositiveInteger_ConstSize_big_endian_32 +dec_Int_PositiveInteger_ConstSize_big_endian_32_pure +dec_Int_PositiveInteger_ConstSize_big_endian_64 +dec_Int_PositiveInteger_ConstSize_big_endian_64_pure +dec_Int_PositiveInteger_ConstSize_little_endian_16_pure +dec_Int_PositiveInteger_ConstSize_little_endian_32_pure +dec_Int_PositiveInteger_ConstSize_little_endian_64_pure +enc_Int_TwosComplement_ConstSize +enc_Int_TwosComplement_ConstSize_8 +enc_Int_TwosComplement_ConstSize_big_endian_16 +enc_Int_TwosComplement_ConstSize_big_endian_32 +enc_Int_TwosComplement_ConstSize_big_endian_64 +dec_Int_TwosComplement_ConstSize +dec_Int_TwosComplement_ConstSize_pure +dec_Int_TwosComplement_ConstSize_8 +dec_Int_TwosComplement_ConstSize_big_endian_16 +dec_Int_TwosComplement_ConstSize_big_endian_32 +dec_Int_TwosComplement_ConstSize_big_endian_64 +BitStream_ReadBitPattern +BitStream_DecodeTrueFalseBoolean +enc_Real_IEEE754_32_big_endian +enc_Real_IEEE754_32_little_endian +enc_Real_IEEE754_64_big_endian +enc_Real_IEEE754_64_little_endian +dec_Real_IEEE754_32_big_endian +dec_Real_IEEE754_32_little_endian +dec_Real_IEEE754_64_big_endian +dec_Real_IEEE754_64_little_endian +enc_String_Ascii_Null_Terminated_multVec +enc_String_CharIndex_private +enc_IA5String_CharIndex_External_Field_Determinant +enc_IA5String_CharIndex_External_Field_DeterminantVec +enc_IA5String_CharIndex_Internal_Field_DeterminantVec +dec_String_Ascii_Null_Terminated_multVec +dec_String_CharIndex_private +dec_IA5String_CharIndex_External_Field_Determinant +dec_IA5String_CharIndex_External_Field_DeterminantVec +dec_IA5String_CharIndex_Internal_Field_Determinant +dec_IA5String_CharIndex_Internal_Field_DeterminantVec +milbus_encode +milbus_decode \ No newline at end of file diff --git a/asn1scala/verify.sh b/asn1scala/verify.sh index 41a81670b..66bdd1c82 100755 --- a/asn1scala/verify.sh +++ b/asn1scala/verify.sh @@ -3,6 +3,9 @@ src/main/scala/asn1scala/asn1jvm.scala \ src/main/scala/asn1scala/asn1jvm_Verification.scala \ src/main/scala/asn1scala/asn1jvm_Helper.scala \ src/main/scala/asn1scala/asn1jvm_Bitstream.scala \ +src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala \ +src/main/scala/asn1scala/asn1jvm_Vector.scala \ +src/main/scala/asn1scala/asn1jvm_Codec.scala \ --config-file=stainless.conf \ -D-parallel=5 \ $1 diff --git a/asn1scala/verify_safety_acn.sh b/asn1scala/verify_safety_acn.sh new file mode 100755 index 000000000..9bb430113 --- /dev/null +++ b/asn1scala/verify_safety_acn.sh @@ -0,0 +1,12 @@ +stainless-dotty \ +src/main/scala/asn1scala/asn1jvm.scala \ +src/main/scala/asn1scala/asn1jvm_Verification.scala \ +src/main/scala/asn1scala/asn1jvm_Helper.scala \ +src/main/scala/asn1scala/asn1jvm_Bitstream.scala \ +src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala \ +src/main/scala/asn1scala/asn1jvm_Vector.scala \ +src/main/scala/asn1scala/asn1jvm_Codec.scala \ +--config-file=stainless.conf \ +-D-parallel=5 \ +--functions=initACNCodec,reader,dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma,dec_Int_PositiveInteger_ConstSize_big_endian_32_prefixLemma,dec_Int_PositiveInteger_ConstSize_big_endian_64_prefixLemma,dec_Int_PositiveInteger_ConstSize_little_endian_16_prefixLemma,dec_Int_PositiveInteger_ConstSize_little_endian_32_prefixLemma,dec_Int_PositiveInteger_ConstSize_little_endian_64_prefixLemma,enc_Int_PositiveInteger_ConstSize,enc_Int_PositiveInteger_ConstSize,resetAt,withMovedByteIndex,withMovedBitIndex,isPrefixOf,enc_Int_PositiveInteger_ConstSize_8,enc_Int_PositiveInteger_ConstSize_big_endian_16,enc_Int_PositiveInteger_ConstSize_big_endian_32,enc_Int_PositiveInteger_ConstSize_big_endian_64,dec_Int_PositiveInteger_ConstSize,dec_Int_PositiveInteger_ConstSize_pure,dec_Int_PositiveInteger_ConstSize_8,dec_Int_PositiveInteger_ConstSize_8_pure,dec_Int_PositiveInteger_ConstSize_big_endian_16,dec_Int_PositiveInteger_ConstSize_big_endian_16_pure,dec_Int_PositiveInteger_ConstSize_big_endian_32,dec_Int_PositiveInteger_ConstSize_big_endian_32_pure,dec_Int_PositiveInteger_ConstSize_big_endian_64,dec_Int_PositiveInteger_ConstSize_big_endian_64_pure,dec_Int_PositiveInteger_ConstSize_little_endian_16_pure,dec_Int_PositiveInteger_ConstSize_little_endian_32_pure,dec_Int_PositiveInteger_ConstSize_little_endian_64_pure,enc_Int_TwosComplement_ConstSize,enc_Int_TwosComplement_ConstSize_8,enc_Int_TwosComplement_ConstSize_big_endian_16,enc_Int_TwosComplement_ConstSize_big_endian_32,enc_Int_TwosComplement_ConstSize_big_endian_64,dec_Int_TwosComplement_ConstSize,dec_Int_TwosComplement_ConstSize_pure,dec_Int_TwosComplement_ConstSize_8,dec_Int_TwosComplement_ConstSize_big_endian_16,dec_Int_TwosComplement_ConstSize_big_endian_32,dec_Int_TwosComplement_ConstSize_big_endian_64,BitStream_ReadBitPattern,BitStream_DecodeTrueFalseBoolean,enc_Real_IEEE754_32_big_endian,enc_Real_IEEE754_32_little_endian,enc_Real_IEEE754_64_big_endian,enc_Real_IEEE754_64_little_endian,dec_Real_IEEE754_32_big_endian,dec_Real_IEEE754_32_little_endian,dec_Real_IEEE754_64_big_endian,dec_Real_IEEE754_64_little_endian,enc_String_Ascii_Null_Terminated_multVec,enc_String_CharIndex_private,enc_IA5String_CharIndex_External_Field_Determinant,enc_IA5String_CharIndex_External_Field_DeterminantVec,enc_IA5String_CharIndex_Internal_Field_DeterminantVec,dec_String_Ascii_Null_Terminated_multVec,dec_String_CharIndex_private,dec_IA5String_CharIndex_External_Field_Determinant,dec_IA5String_CharIndex_External_Field_DeterminantVec,dec_IA5String_CharIndex_Internal_Field_Determinant,dec_IA5String_CharIndex_Internal_Field_DeterminantVec,milbus_encode,milbus_decode \ +$1 From 4ff699483536b16071bee9cbf031d457b73679be Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Wed, 28 Aug 2024 09:45:05 +0200 Subject: [PATCH 08/35] prove inverse of encodeUnsignedInteger --- .../scala/asn1scala/asn1jvm_Bitstream.scala | 58 +++++++++---------- .../main/scala/asn1scala/asn1jvm_Codec.scala | 40 ++++++++----- .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 34 +++++------ 3 files changed, 73 insertions(+), 59 deletions(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 7507a1dcb..181089edc 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -229,15 +229,15 @@ object BitStream { }.ensuring(_ => BitStream.validate_offset_bytes(b2.buf.length.toLong, b2.currentByte.toLong, b2.currentBit.toLong,bytes - ((bits + 7) / 8).toInt)) } - // @ghost @pure @opaque @inlineOnce - // def validateOffsetImpliesMoveBits(b: BitStream, bits: Long): Unit = { - // require(0 <= bits && bits <= b.buf.length.toLong * 8L) - // require(BitStream.validate_offset_bits(b.buf.length.toLong, b.currentByte.toLong, b.currentBit.toLong, bits)) + @ghost @pure @opaque @inlineOnce + def validateOffsetImpliesMoveBits(b: BitStream, bits: Long): Unit = { + require(0 <= bits && bits <= b.buf.length.toLong * 8L) + require(BitStream.validate_offset_bits(b.buf.length.toLong, b.currentByte.toLong, b.currentBit.toLong, bits)) - // { - // () - // }.ensuring(_ => moveBitIndexPrecond(b, bits)) - // } + { + () + }.ensuring(_ => moveBitIndexPrecond(b, bits)) + } // For showing invertibility of encoding - not fully integrated yet @ghost @pure @opaque @inlineOnce @@ -520,28 +520,28 @@ object BitStream { } } - // @ghost @pure @opaque @inlineOnce - // def checkBitsLoopAndReadNLSB(bs: BitStream, nBits: Int, bit: Boolean, from: Int = 0): Unit = { - // require(0 < nBits && nBits <= 64) - // require(0 <= from && from <= nBits) - // require(BitStream.validate_offset_bits(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong, nBits - from)) - // decreases(nBits - from) - // val (bs1Final, ok) = bs.checkBitsLoopPure(nBits, bit, from) - // require(ok) - // val acc = if (bit) onesLSBLong(from) << (nBits - from) else 0 - // val (bs2Final, vGot) = bs.readNLSBBitsMSBFirstLoopPure(nBits, from, acc) + @ghost @pure @opaque @inlineOnce + def checkBitsLoopAndReadNLSB(bs: BitStream, nBits: Int, bit: Boolean, from: Int = 0): Unit = { + require(0 < nBits && nBits <= 64) + require(0 <= from && from <= nBits) + require(BitStream.validate_offset_bits(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong, nBits - from)) + decreases(nBits - from) + val (bs1Final, ok) = bs.checkBitsLoopPure(nBits, bit, from) + require(ok) + val acc = if (bit) onesLSBLong(from) << (nBits - from) else 0 + val (bs2Final, vGot) = bs.readNLSBBitsMSBFirstLoopPure(nBits, from, acc) - // { - // if (from == nBits) () - // else { - // val (bs1Rec, _) = bs.readBitPure() - // checkBitsLoopAndReadNLSB(bs1Rec, nBits, bit, from + 1) - // } - // }.ensuring { _ => - // if (!bit) vGot == 0 - // else vGot == onesLSBLong(nBits) - // } - // } + { + if (from == nBits) () + else { + val (bs1Rec, _) = bs.readBitPure() + checkBitsLoopAndReadNLSB(bs1Rec, nBits, bit, from + 1) + } + }.ensuring { _ => + if (!bit) vGot == 0 + else vGot == onesLSBLong(nBits) + } + } // TODO: Bad name @ghost @pure @opaque @inlineOnce diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index dcc2d11d9..26ecee812 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -149,8 +149,7 @@ object Codec { */ case class Codec(bitStream: BitStream) { import Codec.* - import BitStream.{reader => _, *} - export bitStream.{resetAt => _, withMovedByteIndex => _, withMovedBitIndex => _, isPrefixOf => _, *} + export bitStream.{resetAt => _, withMovedByteIndex => _, withMovedBitIndex => _, isPrefixOf => _, readNLSBBitsMSBFirstPure => _, *} @ghost @pure @inline def resetAt(other: Codec): Codec = { @@ -160,13 +159,13 @@ case class Codec(bitStream: BitStream) { @ghost @pure @inline def withMovedByteIndex(diffInBytes: Int): Codec = { - require(moveByteIndexPrecond(bitStream, diffInBytes)) + require(BitStream.moveByteIndexPrecond(bitStream, diffInBytes)) Codec(bitStream.withMovedByteIndex(diffInBytes)) } @ghost @pure @inline def withMovedBitIndex(diffInBits: Int): Codec = { - require(moveBitIndexPrecond(bitStream, diffInBits)) + require(BitStream.moveBitIndexPrecond(bitStream, diffInBits)) Codec(bitStream.withMovedBitIndex(diffInBits)) } @@ -195,17 +194,32 @@ case class Codec(bitStream: BitStream) { @opaque @inlineOnce def encodeUnsignedInteger(v: ULong): Unit = { require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,GetBitCountUnsigned(v))) + @ghost val w1 = snapshot(this) appendLSBBitsMSBFirst(v.toRaw, GetBitCountUnsigned(v)) + ghostExpr { + val nBits = GetBitCountUnsigned(v) + val w2 = this + assert( w1.bitStream.buf.length == w2.bitStream.buf.length + && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits + && w1.isPrefixOf(w2) + ) + val (r1, r2) = reader(w1, w2) + BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) + val (r2Got, vGot) = r1.bitStream.readNLSBBitsMSBFirstPure(nBits) + assert(vGot == v.toRaw && r2Got == r2.bitStream) + + } } .ensuring { _ => val w1 = old(this) val w2 = this val nBits = GetBitCountUnsigned(v) - w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits /*&& w1.isPrefixOf(w2) && { + w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits + && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) - validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) + BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) val (r2Got, vGot) = r1.decodeUnsignedIntegerPure(nBits) vGot == v && r2Got == r2 - }*/ + } } /** @@ -215,7 +229,7 @@ case class Codec(bitStream: BitStream) { * @return Unsigned integer with nBits decoded from bitstream. * */ - @opaque @inlineOnce + // @opaque @inlineOnce def decodeUnsignedInteger(nBits: Int): ULong = { require(nBits >= 0 && nBits <= NO_OF_BITS_IN_LONG) require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nBits)) @@ -266,7 +280,7 @@ case class Codec(bitStream: BitStream) { appendLSBBitsMSBFirst(encVal, nRangeBits) else ghostExpr { - lemmaIsPrefixRefl(bitStream) + BitStream.lemmaIsPrefixRefl(bitStream) } }.ensuring { _ => val w1 = old(this) @@ -275,7 +289,7 @@ case class Codec(bitStream: BitStream) { val nBits = GetBitCountUnsigned(range) w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) - validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) + BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) val (r2Got, vGot) = r1.decodeConstrainedPosWholeNumberPure(min, max) vGot == v && r2Got == r2 } @@ -357,7 +371,7 @@ case class Codec(bitStream: BitStream) { appendLSBBitsMSBFirst(encVal, nRangeBits) // else // ghostExpr { - // lemmaIsPrefixRefl(bitStream) + // BitStream.lemmaIsPrefixRefl(bitStream) // } }.ensuring { _ => val w1 = old(this) @@ -369,7 +383,7 @@ case class Codec(bitStream: BitStream) { w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) - validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) + BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) val (r2Got, vGot) = r1.decodeConstrainedWholeNumberPure(min, max) vGot == v && r2Got == r2 }*/ @@ -646,7 +660,7 @@ case class Codec(bitStream: BitStream) { val nBits = NO_OF_BITS_IN_BYTE + GetLengthForEncodingSigned(v) * NO_OF_BITS_IN_BYTE w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits /*&& w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) - validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) + BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) val (r2Got, vGot) = r1.decodeUnconstrainedWholeNumberPure() vGot == v && r2Got == r2 }*/ diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 56eaaf504..e2f70040a 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -238,16 +238,16 @@ case class ACN(base: Codec) { /* put required zeros*/ val diff = encodedSizeInBits - nBits appendNZeroBits(diff) - // @ghost val this2 = snapshot(this) + @ghost val this2 = snapshot(this) ghostExpr { - validateOffsetBitsDifferenceLemma(this1.base.bitStream, this.base.bitStream, encodedSizeInBits, diff) + BitStream.validateOffsetBitsDifferenceLemma(this1.base.bitStream, this.base.bitStream, encodedSizeInBits, diff) } /*Encode number */ encodeUnsignedInteger(intVal) - /*ghostExpr { + ghostExpr { assert(BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(this2.base.bitStream.buf.length, this2.base.bitStream.currentByte, this2.base.bitStream.currentBit) + nBits) assert(BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(this1.base.bitStream.buf.length, this1.base.bitStream.currentByte, this1.base.bitStream.currentBit) + encodedSizeInBits) - validTransitiveLemma(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) + lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) val this2Reset = this2.resetAt(this1) val (r1_1, r3_1) = ACN.reader(this1, this) validateOffsetBitsContentIrrelevancyLemma(this1.base.bitStream, this.base.bitStream.buf, encodedSizeInBits) @@ -279,22 +279,22 @@ case class ACN(base: Codec) { check(iGot == intVal) check(r3Got == r3_1) } - }*/ - } /*else { + } + } else { ghostExpr { - validReflexiveLemma(bitStream) + lemmaIsPrefixRefl(bitStream) } - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this w1.base.bitStream.buf.length == w3.base.bitStream.buf.length && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + encodedSizeInBits - /*&& w1.isPrefixOf(w3) && { + && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, encodedSizeInBits) val (r3Got, iGot) = r1.dec_Int_PositiveInteger_ConstSize_pure(encodedSizeInBits) iGot == intVal && r3Got == r3 - }*/ + } } @ghost @pure @inline @@ -345,7 +345,7 @@ case class ACN(base: Codec) { appendByte(wrappingExpr { intVal.toByte.toRawUByte }) /*ghostExpr { // For isPrefix - validTransitiveLemma(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) + lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first byte gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.base.bitStream.resetAt(this1.base.bitStream) readBytePrefixLemma(this2Reset, this.base.bitStream) @@ -373,7 +373,7 @@ case class ACN(base: Codec) { enc_Int_PositiveInteger_ConstSize_big_endian_16(wrappingExpr { (intVal & 0xFFFFL).toRawULong }) /*ghostExpr { // For isPrefix - validTransitiveLemma(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) + lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first integer gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma(this2Reset, this) @@ -399,7 +399,7 @@ case class ACN(base: Codec) { enc_Int_PositiveInteger_ConstSize_big_endian_32(wrappingExpr { (intVal & 0xFFFFFFFFL).toRawULong }) /*ghostExpr { // For isPrefix - validTransitiveLemma(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) + lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first integer gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) dec_Int_PositiveInteger_ConstSize_big_endian_32_prefixLemma(this2Reset, this) @@ -427,7 +427,7 @@ case class ACN(base: Codec) { appendByte(wrappingExpr { (intVal >> 8).toUByte }) /*ghostExpr { // For isPrefix - validTransitiveLemma(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) + lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first byte gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) readBytePrefixLemma(this2Reset.base.bitStream, this.base.bitStream) @@ -455,7 +455,7 @@ case class ACN(base: Codec) { enc_Int_PositiveInteger_ConstSize_little_endian_16(wrappingExpr { ((intVal >> 16) & 0xFFFFL).toRawULong }) /*ghostExpr { // For isPrefix - validTransitiveLemma(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) + lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first integer gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) dec_Int_PositiveInteger_ConstSize_little_endian_16_prefixLemma(this2Reset, this) @@ -481,7 +481,7 @@ case class ACN(base: Codec) { enc_Int_PositiveInteger_ConstSize_little_endian_32(wrappingExpr { ((intVal >> 32) & 0xFFFFFFFFL).toRawULong }) /*ghostExpr { // For isPrefix - validTransitiveLemma(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) + lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first integer gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) dec_Int_PositiveInteger_ConstSize_little_endian_32_prefixLemma(this2Reset, this) @@ -694,7 +694,7 @@ case class ACN(base: Codec) { /*ghostExpr { assert(BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(this2.base.bitStream.buf.length, this2.base.bitStream.currentByte, this2.base.bitStream.currentBit) + nBits) assert(BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(this1.base.bitStream.buf.length, this1.base.bitStream.currentByte, this1.base.bitStream.currentBit) + formatBitLength) - validTransitiveLemma(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) + lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) val this2Reset = this2.resetAt(this1) val (r1_1, r3_1) = ACN.reader(this1, this) validateOffsetBitsContentIrrelevancyLemma(this1.base.bitStream, this.base.bitStream.buf, formatBitLength) From 48b4e736a6866ad740e64cb0e16b4c2bcffd2873 Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Wed, 28 Aug 2024 09:56:37 +0200 Subject: [PATCH 09/35] proved enc_Int_PositiveInteger_ConstSize --- asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index e2f70040a..ba5134174 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -225,7 +225,7 @@ case class ACN(base: Codec) { enc_Int_PositiveInteger_ConstSize(intVal.toLong.toRawULong, encodedSizeInBits) } - @opaque @inlineOnce + // @opaque @inlineOnce def enc_Int_PositiveInteger_ConstSize(intVal: ULong, encodedSizeInBits: Int): Unit = { require(encodedSizeInBits >= 0 && encodedSizeInBits <= 64) /* Get number of bits*/ From 9db42384338bf072b4d0eee1e434a98b9799bcb2 Mon Sep 17 00:00:00 2001 From: Samuel Chassot Date: Wed, 28 Aug 2024 14:12:22 +0200 Subject: [PATCH 10/35] prove some invertibility in Codec ACN --- .../main/scala/asn1scala/asn1jvm_Codec.scala | 124 ++++++++++++++---- .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 101 +++++++------- 2 files changed, 151 insertions(+), 74 deletions(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index 26ecee812..9c5ca030c 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -365,28 +365,29 @@ case class Codec(bitStream: BitStream) { val encVal = stainless.math.wrapping(v - min).toRawULong @ghost val nEncValBits = GetBitCountUnsigned(encVal) - //SAMassert(nRangeBits >= nEncValBits) - //SAMassert(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nRangeBits)) + assert(nRangeBits >= nEncValBits) + assert(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nRangeBits)) appendLSBBitsMSBFirst(encVal, nRangeBits) - // else - // ghostExpr { - // BitStream.lemmaIsPrefixRefl(bitStream) - // } + else + ghostExpr { + BitStream.lemmaIsPrefixRefl(bitStream) + } }.ensuring { _ => val w1 = old(this) val w2 = this val range = stainless.math.wrapping(max - min) val nBits = GetBitCountUnsigned(range.toRawULong) w1.bitStream.buf.length == w2.bitStream.buf.length - && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits /*&& + && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits + && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) val (r2Got, vGot) = r1.decodeConstrainedWholeNumberPure(min, max) vGot == v && r2Got == r2 - }*/ + } } /** @@ -404,7 +405,6 @@ case class Codec(bitStream: BitStream) { * SAM Changed to cap the value to the max/min value, so that the post condition holds * */ - @opaque @inlineOnce def decodeConstrainedWholeNumber(min: Long, max: Long): Long = { require(min <= max) staticRequire( @@ -500,6 +500,7 @@ case class Codec(bitStream: BitStream) { * This function writes full bytes to the bitstream. The length is written as * an signed byte in front of the bytes written for the number v. * + * Unused in PUS-C * @param v number that gets encoded to the bitstream. Must be bigger than min. * @param min lower boundary of range * @@ -513,21 +514,61 @@ case class Codec(bitStream: BitStream) { val encV: ULong = stainless.math.wrapping(v - min).toRawULong val nBytes = GetLengthForEncodingUnsigned(encV).toByte + val nBits = nBytes * NO_OF_BITS_IN_BYTE // need space for length and value assert(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nBytes + 1)) + @ghost val this1 = snapshot(this) // encode length appendByte(nBytes.toRawUByte) + + @ghost val this2 = snapshot(this) // encode value appendLSBBitsMSBFirst(encV.toRaw, nBytes * NO_OF_BITS_IN_BYTE) - }.ensuring(_ => buf.length == old(this).buf.length && - BitStream.bitIndex(this.bitStream.buf.length, this.bitStream.currentByte, this.bitStream.currentBit) == BitStream.bitIndex(old(this).bitStream.buf.length, old(this).bitStream.currentByte, old(this).bitStream.currentBit) + GetLengthForEncodingUnsigned(stainless.math.wrapping(v - min).toRawULong) * 8L + 8L) + + ghostExpr(BitStream.lemmaIsPrefixTransitive(this1.bitStream, this2.bitStream, this.bitStream)) + + ghostExpr { + BitStream.lemmaIsPrefixRefl(bitStream) + } + + ghostExpr { + BitStream.lemmaIsPrefixTransitive(this1.bitStream, this2.bitStream, this.bitStream) + val this2Reset = this2.bitStream.resetAt(this1.bitStream) + BitStream.readBytePrefixLemma(this2Reset, this.bitStream) + assert(this2.bitStream.resetAt(this1.bitStream).readBytePure()._2.unsignedToInt == nBytes) + val (r1, r2) = reader(this1, this) + BitStream.validateOffsetBytesContentIrrelevancyLemma(this1.bitStream, this.bitStream.buf, nBytes + 1) + assert(r1 == Codec(BitStream(snapshot(this.bitStream.buf), this1.bitStream.currentByte, this1.bitStream.currentBit))) + assert(BitStream.validate_offset_bytes(r1.bitStream.buf.length, r1.bitStream.currentByte, r1.bitStream.currentBit, nBytes + 1)) + val (r2Got, vGot) = r1.decodeSemiConstrainedWholeNumberPure(min) + check(r2Got == r2) + assert((vGot & onesLSBLong(nBits)) == (v & onesLSBLong(nBits))) + check(vGot == v) + } + + }.ensuring(_ => + val w1 = old(this) + val w2 = this + val encV: ULong = stainless.math.wrapping(v - min).toRawULong + val nBits = GetLengthForEncodingUnsigned(stainless.math.wrapping(v - min).toRawULong) * 8L + 8L + buf.length == old(this).buf.length + &&& BitStream.bitIndex(this.bitStream.buf.length, this.bitStream.currentByte, this.bitStream.currentBit) == BitStream.bitIndex(old(this).bitStream.buf.length, old(this).bitStream.currentByte, old(this).bitStream.currentBit) + GetLengthForEncodingUnsigned(stainless.math.wrapping(v - min).toRawULong) * 8L + 8L + &&& w1.isPrefixOf(w2) + &&& { + val (r1, r2) = reader(w1, w2) + BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) + val (r2Got, vGot) = r1.decodeSemiConstrainedWholeNumberPure(min) + (vGot == v) && r2Got == r2 + } + ) /** * Decode number from bitstream that is in range [min, Long.MaxValue]. * This is the reversal function of encodeSemiConstrainedWholeNumber. * + * Unused in PUS-C * @param min lower boundary of range * @return value decoded from the bitstream. * @@ -555,14 +596,30 @@ case class Codec(bitStream: BitStream) { // SAM: here the post condition should be obvious, as ULong are always positive. But we can have // overflow, and ULong does not encode the unsigned nature in any way, so cannot work. - v + min - }// SAM .ensuring(x => x >= min) + val res = v + min + if(res < min) then Long.MaxValue else res + }.ensuring(res => res >= min) + + // Unused in PUS-C + @ghost @pure + def decodeSemiConstrainedWholeNumberPure(min: Long): (Codec, Long) = { + require(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, 1)) + staticRequire { + val nBytes = bitStream.readBytePure()._2.unsignedToInt + BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, 1 + nBytes) && 0 <= nBytes && nBytes <= 8 + } + val cpy = snapshot(this) + val res = cpy.decodeSemiConstrainedWholeNumber(min) + (cpy, res) + } + /** * Encode number to the bitstream within the range [min, Long.Max_Value]. * This function writes full bytes to the bitstream. The length is written as * an signed byte in front of the bytes written for the number v. * + * Unused in PUS-C * @param v number that gets encoded to the bitstream. Must be bigger than min. * @param min lower unsigned boundary of range * @@ -589,6 +646,7 @@ case class Codec(bitStream: BitStream) { * Decode unsigned number from the bitstream * within the range [min, Long.Max_Value]. * + * Unused in PUS-C * @param min lower unsigned boundary of range * */ @@ -603,13 +661,18 @@ case class Codec(bitStream: BitStream) { val nBytesRaw = nBytes.toRaw val nBits = nBytesRaw * NO_OF_BITS_IN_BYTE // SAM GUARD - val v = if(!(nBits >= 0 && nBits <= 64) || !BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, nBits)){ + val v: ULong = if(!(nBits >= 0 && nBits <= 64) || !BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, nBits)){ 0L.toRawULong } else { readNLSBBitsMSBFirst(nBits).toRawULong } - val res: ULong = ULong.fromRaw(v + min) // For some reasons, the scala compiler chokes on this being returned - res + val res: ULong = ULong.fromRaw(v + min) + if(res < min) then + assert(ULong.fromRaw(-1L) >= min) + ULong.fromRaw(Long.MaxValue) + else + assert(res >= min) + res }//.ensuring(res => min <= res) /** @@ -618,6 +681,7 @@ case class Codec(bitStream: BitStream) { * The encoding of an integer value shall be primitive. * The contents octets shall consist of one or more octets. * + * Unused in PUS-C * @param v The value that is always encoded in the smallest possible number of octets. */ @opaque @inlineOnce @@ -639,31 +703,32 @@ case class Codec(bitStream: BitStream) { @ghost val this2 = snapshot(this) // encode number appendLSBBitsMSBFirst(v & onesLSBLong(nBits), nBits) - /* + ghostExpr { - validTransitiveLemma(this1.bitStream, this2.bitStream, this.bitStream) + BitStream.lemmaIsPrefixTransitive(this1.bitStream, this2.bitStream, this.bitStream) val this2Reset = this2.bitStream.resetAt(this1.bitStream) - readBytePrefixLemma(this2Reset, this.bitStream) + BitStream.readBytePrefixLemma(this2Reset, this.bitStream) assert(this2.bitStream.resetAt(this1.bitStream).readBytePure()._2.unsignedToInt == nBytes) val (r1, r2) = reader(this1, this) - validateOffsetBytesContentIrrelevancyLemma(this1.bitStream, this.bitStream.buf, nBytes + 1) + BitStream.validateOffsetBytesContentIrrelevancyLemma(this1.bitStream, this.bitStream.buf, nBytes + 1) assert(r1 == Codec(BitStream(snapshot(this.bitStream.buf), this1.bitStream.currentByte, this1.bitStream.currentBit))) assert(BitStream.validate_offset_bytes(r1.bitStream.buf.length, r1.bitStream.currentByte, r1.bitStream.currentBit, nBytes + 1)) val (r2Got, vGot) = r1.decodeUnconstrainedWholeNumberPure() check(r2Got == r2) - //SAM assert((vGot & onesLSBLong(nBits)) == (v & onesLSBLong(nBits))) - check(vGot == v) - }*/ + assert(vGot.isEmpty || (vGot.get & onesLSBLong(nBits)) == (v & onesLSBLong(nBits))) + check(vGot.isEmpty || vGot.get == v) + } }.ensuring { _ => val w1 = old(this) val w2 = this val nBits = NO_OF_BITS_IN_BYTE + GetLengthForEncodingSigned(v) * NO_OF_BITS_IN_BYTE - w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits /*&& w1.isPrefixOf(w2) && { + w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits + && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) val (r2Got, vGot) = r1.decodeUnconstrainedWholeNumberPure() - vGot == v && r2Got == r2 - }*/ + (vGot.isEmpty || vGot.get == v) && r2Got == r2 + } } /** @@ -673,9 +738,9 @@ case class Codec(bitStream: BitStream) { * The length n is the first octet, n octets with the value follow * Values with n > 8 are not supported * + * Unused in PUS-C * @return decoded number */ - @opaque @inlineOnce def decodeUnconstrainedWholeNumber(): Option[Long] = { require(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,1)) @@ -722,6 +787,9 @@ case class Codec(bitStream: BitStream) { /** * Facade function for real encoding + * + * Unused in PUS-C + * * @param vValDouble real input in IEEE754 double format */ @extern @@ -773,6 +841,8 @@ case class Codec(bitStream: BitStream) { * |1|S|0|0|a|b|c|d| * +-+-+-+-+-+-+-+-+ * + * + * */ private def encodeRealBitString(vVal: Long): Unit = { // Require from CalculateMantissaAndExponent diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index ba5134174..f0cb9624b 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -326,93 +326,97 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w2 = this - w1.base.bufLength() == w2.base.bufLength() && BitStream.bitIndex(w2.base.bitStream.buf.length, w2.base.bitStream.currentByte, w2.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 8 /*&& w1.isPrefixOf(w2) && { + w1.base.bufLength() == w2.base.bufLength() && BitStream.bitIndex(w2.base.bitStream.buf.length, w2.base.bitStream.currentByte, w2.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 8 + && w1.isPrefixOf(w2) && { val (r1, r2) = ACN.reader(w1, w2) val (r2Got, vGot) = r1.dec_Int_PositiveInteger_ConstSize_8_pure() vGot == intVal && r2Got == r2 - }*/ + } } - @opaque @inlineOnce def enc_Int_PositiveInteger_ConstSize_big_endian_16(uintVal: ULong): Unit = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 16)) require(uintVal <= 65535) val intVal = uintVal.toRaw assert((intVal >> 16) == 0L) - // @ghost val this1 = snapshot(this) + @ghost val this1 = snapshot(this) appendByte(wrappingExpr { (intVal >> 8).toByte.toRawUByte }) - // @ghost val this2 = snapshot(this) + @ghost val this2 = snapshot(this) appendByte(wrappingExpr { intVal.toByte.toRawUByte }) - /*ghostExpr { + ghostExpr { // For isPrefix lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first byte gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.base.bitStream.resetAt(this1.base.bitStream) readBytePrefixLemma(this2Reset, this.base.bitStream) - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 /*&& w1.isPrefixOf(w3) && { + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 + && w1.isPrefixOf(w3) + && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 16) val (r3Got, iGot) = r1.dec_Int_PositiveInteger_ConstSize_big_endian_16_pure() iGot == uintVal && r3Got == r3 - }*/ + } } - @opaque @inlineOnce + @inlineOnce @opaque def enc_Int_PositiveInteger_ConstSize_big_endian_32(uintVal: ULong): Unit = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 32)) require(uintVal <= 4294967295L) val intVal = uintVal.toRaw assert((intVal >> 32) == 0L) - // @ghost val this1 = snapshot(this) + @ghost val this1 = snapshot(this) enc_Int_PositiveInteger_ConstSize_big_endian_16(wrappingExpr { ((intVal >> 16) & 0xFFFFL).toRawULong }) - // @ghost val this2 = snapshot(this) + @ghost val this2 = snapshot(this) enc_Int_PositiveInteger_ConstSize_big_endian_16(wrappingExpr { (intVal & 0xFFFFL).toRawULong }) - /*ghostExpr { + ghostExpr { // For isPrefix lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first integer gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma(this2Reset, this) - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 /*&& w1.isPrefixOf(w3) && { + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 + && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 32) val (r3Got, iGot) = r1.dec_Int_PositiveInteger_ConstSize_big_endian_32_pure() iGot == uintVal && r3Got == r3 - }*/ + } } @opaque @inlineOnce def enc_Int_PositiveInteger_ConstSize_big_endian_64(uintVal: ULong): Unit = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 64)) val intVal = uintVal.toRaw - // @ghost val this1 = snapshot(this) + @ghost val this1 = snapshot(this) enc_Int_PositiveInteger_ConstSize_big_endian_32(wrappingExpr { ((intVal >> 32) & 0xFFFFFFFFL).toRawULong }) - // @ghost val this2 = snapshot(this) + @ghost val this2 = snapshot(this) enc_Int_PositiveInteger_ConstSize_big_endian_32(wrappingExpr { (intVal & 0xFFFFFFFFL).toRawULong }) - /*ghostExpr { + ghostExpr { // For isPrefix lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first integer gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) dec_Int_PositiveInteger_ConstSize_big_endian_32_prefixLemma(this2Reset, this) - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 /*&& w1.isPrefixOf(w3) && { + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 + && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 64) val (r3Got, iGot) = r1.dec_Int_PositiveInteger_ConstSize_big_endian_64_pure() iGot == uintVal && r3Got == r3 - }*/ + } } @opaque @inlineOnce @@ -421,26 +425,27 @@ case class ACN(base: Codec) { require(uintVal <= 65535) val intVal = uintVal.toRaw assert((intVal >> 16) == 0L) - // @ghost val this1 = snapshot(this) + @ghost val this1 = snapshot(this) appendByte(wrappingExpr { intVal.toUByte }) - // @ghost val this2 = snapshot(this) + @ghost val this2 = snapshot(this) appendByte(wrappingExpr { (intVal >> 8).toUByte }) - /*ghostExpr { + ghostExpr { // For isPrefix lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first byte gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) readBytePrefixLemma(this2Reset.base.bitStream, this.base.bitStream) - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 /*&& w1.isPrefixOf(w3) && { + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 + && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 16) val (r3Got, iGot) = r1.dec_Int_PositiveInteger_ConstSize_little_endian_16_pure() iGot == uintVal && r3Got == r3 - }*/ + } } @opaque @inlineOnce @@ -449,52 +454,54 @@ case class ACN(base: Codec) { require(uintVal <= 4294967295L) val intVal = uintVal.toRaw assert((intVal >> 32) == 0L) - // @ghost val this1 = snapshot(this) + @ghost val this1 = snapshot(this) enc_Int_PositiveInteger_ConstSize_little_endian_16(wrappingExpr { (intVal & 0xFFFFL).toRawULong }) - // @ghost val this2 = snapshot(this) + @ghost val this2 = snapshot(this) enc_Int_PositiveInteger_ConstSize_little_endian_16(wrappingExpr { ((intVal >> 16) & 0xFFFFL).toRawULong }) - /*ghostExpr { + ghostExpr { // For isPrefix lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first integer gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) dec_Int_PositiveInteger_ConstSize_little_endian_16_prefixLemma(this2Reset, this) - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 /*&& w1.isPrefixOf(w3) && { + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 + && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 32) val (r3Got, iGot) = r1.dec_Int_PositiveInteger_ConstSize_little_endian_32_pure() iGot == uintVal && r3Got == r3 - }*/ + } } @opaque @inlineOnce def enc_Int_PositiveInteger_ConstSize_little_endian_64(uintVal: ULong): Unit = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 64)) val intVal = uintVal.toRaw - // @ghost val this1 = snapshot(this) + @ghost val this1 = snapshot(this) enc_Int_PositiveInteger_ConstSize_little_endian_32(wrappingExpr { (intVal & 0xFFFFFFFFL).toRawULong }) - // @ghost val this2 = snapshot(this) + @ghost val this2 = snapshot(this) enc_Int_PositiveInteger_ConstSize_little_endian_32(wrappingExpr { ((intVal >> 32) & 0xFFFFFFFFL).toRawULong }) - /*ghostExpr { + ghostExpr { // For isPrefix lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) // Reading back the first integer gives the same result whether we are reading from this2 or the end result this val this2Reset = this2.resetAt(this1) dec_Int_PositiveInteger_ConstSize_little_endian_32_prefixLemma(this2Reset, this) - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 /*&& w1.isPrefixOf(w3) && { + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 + && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 64) val (r3Got, iGot) = r1.dec_Int_PositiveInteger_ConstSize_little_endian_64_pure() iGot == uintVal && r3Got == r3 - }*/ + } } def dec_Int_PositiveInteger_ConstSize(encodedSizeInBits: Int): ULong = { @@ -512,7 +519,6 @@ case class ACN(base: Codec) { (cpy, l) } - @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_8(): ULong = { require(BitStream.validate_offset_byte(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit)) ULong.fromRaw(readByte().toRaw & 0xFF) @@ -677,7 +683,7 @@ case class ACN(base: Codec) { * @param v value that gets encoded * @param formatBitLength number of dataformat bits */ - @opaque @inlineOnce + // @opaque @inlineOnce def enc_Int_TwosComplement_ConstSize(v: Long, formatBitLength: Int): Unit = { val nBits = GetBitCountSigned(v) require(nBits <= formatBitLength && formatBitLength <= NO_OF_BITS_IN_LONG) @@ -689,9 +695,9 @@ case class ACN(base: Codec) { ghostExpr { validateOffsetBitsDifferenceLemma(this1.base.bitStream, this.base.bitStream, formatBitLength, addedBits) } - // @ghost val this2 = snapshot(this) + @ghost val this2 = snapshot(this) appendLSBBitsMSBFirst(v & onesLSBLong(nBits), nBits) - /*ghostExpr { + ghostExpr { assert(BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(this2.base.bitStream.buf.length, this2.base.bitStream.currentByte, this2.base.bitStream.currentBit) + nBits) assert(BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(this1.base.bitStream.buf.length, this1.base.bitStream.currentByte, this1.base.bitStream.currentBit) + formatBitLength) lemmaIsPrefixTransitive(this1.base.bitStream, this2.base.bitStream, this.base.bitStream) @@ -739,16 +745,17 @@ case class ACN(base: Codec) { check(vGot == v) check(r3Got == r3_1) } - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + formatBitLength /*&& w1.isPrefixOf(w3) && { + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + formatBitLength + && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, formatBitLength) val (r3Got, vGot) = r1.dec_Int_TwosComplement_ConstSize_pure(formatBitLength) vGot == v && r3Got == r3 - }*/ + } } def enc_Int_TwosComplement_ConstSize_8(intVal: Long): Unit = { From 42f4480e135fa1406dd85085abf79a117fea2cb0 Mon Sep 17 00:00:00 2001 From: George Mamais Date: Sat, 31 Aug 2024 20:14:49 +0300 Subject: [PATCH 11/35] Update `IcdPdus` handling and validation Updated `CheckFiles` in `CheckAsn1.fs` to validate `icdPdus` list from command line arguments, raising `SemanticError` for non-existent PDUs. Changed `IcdPdus` type in `Program.fs` from `string list` to `string`, expecting a comma-separated string in double quotes. Updated help text and `constructCommandLineSettings` function to reflect and process the new format. --- FrontEndAst/CheckAsn1.fs | 9 ++++++++- asn1scc/Program.fs | 12 +++++++++--- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/FrontEndAst/CheckAsn1.fs b/FrontEndAst/CheckAsn1.fs index 4984742ef..f3b66cf3a 100644 --- a/FrontEndAst/CheckAsn1.fs +++ b/FrontEndAst/CheckAsn1.fs @@ -687,7 +687,14 @@ let CheckFiles( ast:AstRoot) (pass :int) = modules |> Seq.map(fun m-> m.Name) |> CheckForDuplicates // check each file modules |> Seq.iter (fun x -> CheckModule x ast pass) - + //check that the icdPdus list provided in the command line is valid + match ast.args.icdPdus with + | None -> () + | Some pdus -> + let allPdus = modules |> Seq.collect(fun m -> m.TypeAssignments |> Seq.map(fun tas -> tas.Name.Value)) |> Seq.toList + pdus |> List.iter(fun pdu -> + if not (allPdus |> Seq.exists(fun x -> x = pdu)) then + raise (SemanticError(emptyLocation, sprintf "The PDU '%s' which was specified in the command line does not exist in the ASN.1 files" pdu))) diff --git a/asn1scc/Program.fs b/asn1scc/Program.fs index 08e5848a1..d82c8e8f4 100644 --- a/asn1scc/Program.fs +++ b/asn1scc/Program.fs @@ -32,7 +32,7 @@ type CliArguments = | [] CustomIcdUper of custom_stg_colon_out_filename:string | [] IcdAcn of acn_icd_output_file:string | [] CustomIcdAcn of custom_stg_colon_out_filename:string - | [] IcdPdus of asn1_type_assignments_list:string list + | [] IcdPdus of asn1_type_assignments_list:string | [] AdaUses | [] ACND @@ -100,7 +100,7 @@ E.g., -eee 50 will enable this mode for enumerated types with 50 or more enumera | CustomIcdUper _ -> "Invokes the custom stg file 'stgFile.stg' using the icdUper backend and produces the output file 'outputFile'" | IcdAcn _ -> "Produces an Interface Control Document for the input ASN.1 and ACN grammars for ACN encoding" | CustomIcdAcn _ -> "Invokes the custom stg file 'stgFile.stg' using the icdAcn backend and produces the output file 'outputFile'" - | IcdPdus _ -> "A list of type assignments to be included in the generated ICD." + | IcdPdus _ -> "A list of type assignments to be included in the generated ICD. If there are multiple type assignments, please separate them with commas and enclose them in double quotes." | AdaUses -> "Prints in the console all type Assignments of the input ASN.1 grammar" | ACND -> "creates ACN grammars for the input ASN.1 grammars using the default encoding properties" | Debug_Asn1 _ -> "Prints all input ASN.1 grammars in a single module/single file and with parameterized types removed. Used for debugging purposes" @@ -315,7 +315,13 @@ let constructCommandLineSettings args (parserResults: ParseResults IcdAcnHtmlFileName = "" generateConstInitGlobals = parserResults.Contains(<@Init_Globals@>) custom_Stg_Ast_Version = parserResults.GetResult(<@ Custom_Stg_Ast_Version @>, defaultValue = 1) - icdPdus = parserResults.TryGetResult(<@ IcdPdus @>) + icdPdus = + match parserResults.TryGetResult(<@ IcdPdus @>) with + | None -> None + | Some pdus -> + // remove double quotes and split by comma + let actualPdus = pdus.Replace("\"", "") + Some ((actualPdus.Split(',')) |> Seq.map(fun (z:string) -> z.Trim()) |> Seq.filter(fun z -> not (String.IsNullOrEmpty z)) |> Seq.toList) mappingFunctionsModule = parserResults.TryGetResult(<@ Mapping_Functions_Module @>) integerSizeInBytes = let ws = parserResults.GetResult(<@Word_Size@>, defaultValue = 8) From 2e457b057fe79a02cf4d19f1690285b36f9158c1 Mon Sep 17 00:00:00 2001 From: George Mamais Date: Sat, 31 Aug 2024 21:58:57 +0300 Subject: [PATCH 12/35] ICD, null types now show the bit or octet pattern --- BackendAst/DAstACN.fs | 44 ++++++++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index bb22f0e8a..5fca4e6ba 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -547,17 +547,6 @@ let createIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Comm createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us -let createAcnChildIcdFunction (ch:AcnChild) = - let icd fieldName comments = - let sType, minSize, maxSize = - match ch.Type with - | Asn1AcnAst.AcnInteger a -> "INTEGER", a.acnMinSizeInBits, a.acnMaxSizeInBits - | Asn1AcnAst.AcnBoolean a -> "BOOLEAN", a.acnMinSizeInBits, a.acnMaxSizeInBits - | Asn1AcnAst.AcnNullType a -> "NULL", a.acnMinSizeInBits, a.acnMaxSizeInBits - | Asn1AcnAst.AcnReferenceToEnumerated a -> a.tasName.Value, a.enumerated.acnMinSizeInBits, a.enumerated.acnMaxSizeInBits - | Asn1AcnAst.AcnReferenceToIA5String a -> a.tasName.Value, a.str.acnMinSizeInBits, a.str.acnMaxSizeInBits - {IcdRow.fieldName = fieldName; comments = comments; sPresent="always";sType=(IcdPlainType sType); sConstraint=None; minLengthInBits = minSize ;maxLengthInBits=maxSize;sUnits=None; rowType = IcdRowType.FieldRow; idxOffset = None} - icd let enumComment stgFileName (o:Asn1AcnAst.Enumerated) = let EmitItem (n:Asn1AcnAst.NamedItem) = @@ -808,20 +797,22 @@ let createAcnNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec: match o.acnProperties.encodingPattern with | None -> None | Some encPattern -> - let arrsBits, arrBytes, nBitsSize = + let arrsBits, arrBytes, nBitsSize, icdDesc = match encPattern with | PATTERN_PROP_BITSTR_VALUE bitStringPattern -> let arrsBits = bitStringPattern.Value.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList let arrBytes = bitStringValueToByteArray bitStringPattern - arrsBits, arrBytes, (BigInteger bitStringPattern.Value.Length) + let icdDesc = sprintf "fixed pattern: '%s'B" bitStringPattern.Value + arrsBits, arrBytes, (BigInteger bitStringPattern.Value.Length), icdDesc | PATTERN_PROP_OCTSTR_VALUE octStringBytes -> let arrBytes = octStringBytes |> Seq.map(fun z -> z.Value) |> Seq.toArray let bitStringPattern = byteArrayToBitStringValue arrBytes let arrsBits = bitStringPattern.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList - arrsBits,arrBytes,(BigInteger bitStringPattern.Length) + let icdDesc = sprintf "fixed pattern: '%s'H" (arrBytes |> Seq.map(fun z -> z.ToString("X2")) |> Seq.StrJoin "") + arrsBits,arrBytes,(BigInteger bitStringPattern.Length), icdDesc let ret = nullType pp arrBytes nBitsSize arrsBits errCode.errCodeName o.acnProperties.savePosition codec let icdFnc fieldName sPresent comments = - [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType "NULL"); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=None; rowType = IcdRowType.FieldRow; idxOffset = None}], [] + [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType icdDesc); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=None; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = "NULL"; rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} Some ({AcnFuncBodyResult.funcBody = ret; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnNullEncodingType (Some encPattern)); icdResult = Some icd}) (funcBody errCode), ns @@ -839,20 +830,22 @@ let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com Some ({AcnFuncBodyResult.funcBody = lm.acn.Null_declare pp; errCodes = []; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=Some pp; typeEncodingKind = Some (AcnNullEncodingType None); icdResult=None}) | _ -> None | Some encPattern -> - let arrsBits, arrBytes, nBitsSize = + let arrsBits, arrBytes, nBitsSize, icdDesc = match encPattern with | PATTERN_PROP_BITSTR_VALUE bitStringPattern -> let arrsBits = bitStringPattern.Value.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList let arrBytes = bitStringValueToByteArray bitStringPattern - arrsBits, arrBytes, (BigInteger bitStringPattern.Value.Length) + let icdDesc = sprintf "fixed pattern: '%s'B" bitStringPattern.Value + arrsBits, arrBytes, (BigInteger bitStringPattern.Value.Length), icdDesc | PATTERN_PROP_OCTSTR_VALUE octStringBytes -> let arrBytes = octStringBytes |> Seq.map(fun z -> z.Value) |> Seq.toArray let bitStringPattern = byteArrayToBitStringValue arrBytes let arrsBits = bitStringPattern.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList - arrsBits,arrBytes,(BigInteger bitStringPattern.Length) + let icdDesc = sprintf "fixed pattern: '%s'H" (arrBytes |> Seq.map(fun z -> z.ToString("X2")) |> Seq.StrJoin "") + arrsBits,arrBytes,(BigInteger bitStringPattern.Length), icdDesc let ret = nullType pp arrBytes nBitsSize arrsBits errCode.errCodeName o.acnProperties.savePosition codec let icdFnc fieldName sPresent comments = - [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] + [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType icdDesc); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} Some ({AcnFuncBodyResult.funcBody = ret; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= lm.lg.acn.null_valIsUnReferenced; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnNullEncodingType (Some encPattern)); icdResult = Some icd}) @@ -1878,8 +1871,17 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi [], [] let icd_acn_child (c:AcnChild) (extra_comments:string list) : ((IcdRow list) * (IcdTypeAss list))= - let icdRow = createAcnChildIcdFunction c c.Name.Value ((c.Comments |> Seq.toList)@extra_comments) - [icdRow], [] + let icdResult = + let dummyNestingScope = NestingScope.init 0I 0I + let p : CallerScope = {CallerScope.modName = ""; arg = Selection.valueEmptyPath ""} + let funcResult = c.funcBody Encode [] dummyNestingScope p + match funcResult with + | None -> None + | Some bodyResult -> bodyResult.icdResult + match icdResult with + | None -> [], [] + | Some icdArgAux -> + icdArgAux.rowsFunc c.Name.Value "always" extra_comments From 8a3db57c87eb5c02c40c415171872952331c1758 Mon Sep 17 00:00:00 2001 From: George Mamais Date: Sun, 1 Sep 2024 19:07:46 +0300 Subject: [PATCH 13/35] ICD improvements. Links to ACN definitions --- BackendAst/DAstACN.fs | 6 ++- BackendAst/GenerateAcnIcd.fs | 81 +++++++++++++++++++++--------------- FrontEndAst/DAst.fs | 1 + 3 files changed, 52 insertions(+), 36 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index 5fca4e6ba..6cb123d70 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -182,7 +182,7 @@ let handleAlignmentForAcnTypes (r:Asn1AcnAst.AstRoot) let md5 = System.Security.Cryptography.MD5.Create() -let createIcdTas (r:Asn1AcnAst.AstRoot) (id:ReferenceToType) (icdAux:IcdArgAux) (td:FE_TypeDefinition) (typeDefinition:TypeDefinitionOrReference) nMinBytesInACN nMaxBytesInACN= +let createIcdTas (r:Asn1AcnAst.AstRoot) (id:ReferenceToType) (icdAux:IcdArgAux) (td:FE_TypeDefinition) (typeDefinition:TypeDefinitionOrReference) nMinBytesInACN nMaxBytesInACN hasAcnDefinition = let calcIcdTypeAssHash (t1:IcdTypeAss) = let rec calcIcdTypeAssHash_aux (t1:IcdTypeAss) = let rws = @@ -224,6 +224,7 @@ let createIcdTas (r:Asn1AcnAst.AstRoot) (id:ReferenceToType) (icdAux:IcdArgAux) compositeChildren = compositeChildren minLengthInBytes = nMinBytesInACN; maxLengthInBytes = nMaxBytesInACN + hasAcnDefinition = hasAcnDefinition hash = "" // will be calculated later } let icdHash = calcIcdTypeAssHash icdTas @@ -334,7 +335,8 @@ let private createAcnFunction (r: Asn1AcnAst.AstRoot) let icdAux, ns3 = match icdResult with | Some icdAux -> - let icdTas = createIcdTas r t.id icdAux td typeDefinition nMinBytesInACN nMaxBytesInACN + let hasAcnDefinition = t.typeAssignmentInfo.IsSome && t.acnLocation.IsSome + let icdTas = createIcdTas r t.id icdAux td typeDefinition nMinBytesInACN nMaxBytesInACN hasAcnDefinition let ns3 = match ns2.icdHashes.TryFind icdTas.hash with | None -> {ns2 with icdHashes = ns2.icdHashes.Add(icdTas.hash, [icdTas])} diff --git a/BackendAst/GenerateAcnIcd.fs b/BackendAst/GenerateAcnIcd.fs index 0c0eda6d1..950e43517 100644 --- a/BackendAst/GenerateAcnIcd.fs +++ b/BackendAst/GenerateAcnIcd.fs @@ -64,14 +64,15 @@ let PrintAcnAsHTML stgFileName (r:AstRoot) = icd_acn.EmitFilePart2 stgFileName (Path.GetFileName fName) (content |> Seq.StrJoin "") ) -let PrintAcnAsHTML2 stgFileName (r:AstRoot) = +let PrintAcnAsHTML2 stgFileName (r:AstRoot) (icdHashesToPrint:string list) = + let icdHashesToPrintSet = icdHashesToPrint |> Set.ofList let fileTypeAssignments = r.icdHashes.Values |> Seq.collect id |> Seq.choose(fun z -> match z.tasInfo with - | None -> None - | Some ts -> Some (ts.tasName, z.hash)) |> + | Some ts when icdHashesToPrintSet.Contains z.hash -> Some (ts.tasName, z.hash) + | _ -> None) |> Map.ofSeq let colorize (t: IToken) = @@ -81,7 +82,7 @@ let PrintAcnAsHTML2 stgFileName (r:AstRoot) = let safeText = t.Text.Replace("<",lt).Replace(">",gt) let uid = match fileTypeAssignments.TryFind t.Text with - |Some hash -> icd_acn.TasName stgFileName safeText hash + |Some hash (*when icdHashesToPrintSet.Contains hash*) -> icd_acn.TasName stgFileName safeText hash |None -> safeText let colored = match t.Type with @@ -627,7 +628,8 @@ let emitTas2 stgFileName (r:AstRoot) myParams (icdTas:IcdTypeAss) = let sCommentLine = icdTas.hash::icdTas.comments |> Seq.StrJoin (icd_uper.NewLine stgFileName ()) let arRows = icdTas.rows |> List.mapi (fun i rw -> emitIcdRow stgFileName r (i+1) rw) - icd_acn.EmitSequenceOrChoice stgFileName false icdTas.name icdTas.hash false (icdTas.kind) (icdTas.minLengthInBytes.ToString()) (icdTas.maxLengthInBytes.ToString()) "sMaxBitsExplained" sCommentLine arRows (myParams 4I) (sCommentLine.Split [|'\n'|]) + let bHasAcnDef = icdTas.hasAcnDefinition + icd_acn.EmitSequenceOrChoice stgFileName false icdTas.name icdTas.hash bHasAcnDef (icdTas.kind) (icdTas.minLengthInBytes.ToString()) (icdTas.maxLengthInBytes.ToString()) "sMaxBitsExplained" sCommentLine arRows (myParams 4I) (sCommentLine.Split [|'\n'|]) (* let rec PrintType2 stgFileName (r:AstRoot) acnParams (icdTas:IcdTypeAss): string list = @@ -690,28 +692,33 @@ let PrintTasses2 stgFileName (r:AstRoot) : string list = | None -> None) |> Seq.toList -let printTasses3 stgFileName (r:DAst.AstRoot) : string list = +let printTasses3 stgFileName (r:DAst.AstRoot) : (string list)*(string list) = let pdus = r.args.icdPdus |> Option.map Set.ofList - seq { - for f in r.Files do - for m in f.Modules do - for tas in m.TypeAssignments do - match pdus.IsNone || pdus.Value.Contains tas.Name.Value with - | true -> - match tas.Type.icdTas with - | Some icdTas -> - let icdTassesHash = getMySelfAndChildren r icdTas - yield! icdTassesHash - | None -> () - | false -> () - } |> Seq.distinct - |> Seq.choose(fun hash -> - match r.icdHashes.TryFind hash with - | Some chIcdTas -> Some (emitTas2 stgFileName r (fun _ -> []) (selectTypeWithSameHash chIcdTas)) - | None -> None) |> Seq.toList - -let PrintAsn1FileInColorizedHtml (stgFileName:string) (r:AstRoot) (f:Asn1File) = + let icdHashesToPrint = + seq { + for f in r.Files do + for m in f.Modules do + for tas in m.TypeAssignments do + match pdus.IsNone || pdus.Value.Contains tas.Name.Value with + | true -> + match tas.Type.icdTas with + | Some icdTas -> + let icdTassesHash = getMySelfAndChildren r icdTas + yield! icdTassesHash + | None -> () + | false -> () + } |> Seq.distinct |> Seq.toList + let files = + icdHashesToPrint + |> Seq.choose(fun hash -> + match r.icdHashes.TryFind hash with + | Some chIcdTas -> Some (emitTas2 stgFileName r (fun _ -> []) (selectTypeWithSameHash chIcdTas)) + | None -> None) |> Seq.toList + (files, icdHashesToPrint) + +let PrintAsn1FileInColorizedHtml (stgFileName:string) (r:AstRoot) (icdHashesToPrint:string list) (f:Asn1File) = //let tryCreateRefType = CreateAsn1AstFromAntlrTree.CreateRefTypeContent + let icdHashesToPrintSet = icdHashesToPrint |> Set.ofList let fileModules = f.Modules |> List.map(fun m -> m.Name.Value) |> Set.ofList let fileTypeAssignments = r.icdHashes.Values |> @@ -719,9 +726,8 @@ let PrintAsn1FileInColorizedHtml (stgFileName:string) (r:AstRoot) (f:Asn1File) = Seq.choose(fun z -> match z.tasInfo with | None -> None - | Some ts when fileModules.Contains ts.modName -> Some (ts.tasName, z.hash) - | Some _ -> None ) |> - Map.ofSeq + | Some ts when icdHashesToPrintSet.Contains z.hash && fileModules.Contains ts.modName -> Some (ts.tasName, z.hash) + | Some _ -> None ) |> Seq.toList //let blueTasses = f.Modules |> Seq.collect(fun m -> getModuleBlueTasses m) @@ -762,13 +768,20 @@ let PrintAsn1FileInColorizedHtml (stgFileName:string) (r:AstRoot) (f:Asn1File) = |Some(tok) -> tok |None -> if idx = 0 then t else f.Tokens.[idx-1] let uid = - match fileTypeAssignments.TryFind t.Text with - |Some tasHash -> + //match fileTypeAssignments.TryFind t.Text with + match fileTypeAssignments |> List.filter(fun (tasName,_) -> tasName = t.Text) with + | [] -> safeText + //|Some tasHash -> + | (_,tasHash)::[] -> if nextToken.Type = asn1Lexer.ASSIG_OP && prevToken.Type <> asn1Lexer.LID then icd_uper.TasName stgFileName safeText tasHash else icd_uper.TasName2 stgFileName safeText tasHash - |None -> safeText + | _ -> + //printfn "Warning: %s is not unique" t.Text + //printfn "Warning: %A" (fileTypeAssignments |> List.filter(fun (tasName,_) -> tasName = t.Text)) + safeText + //|None -> safeText let colored = match t.Type with |asn1Lexer.StringLiteral @@ -787,14 +800,14 @@ let PrintAsn1FileInColorizedHtml (stgFileName:string) (r:AstRoot) (f:Asn1File) = let DoWork (r:AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (stgFileName:string) (asn1HtmlStgFileMacros:string option) outFileName = let files1 = r.Files |> Seq.map (fun f -> PrintTasses stgFileName f r ) - let files1b = printTasses3 stgFileName r + let (files1b, icdHashesToPrint) = printTasses3 stgFileName r let bAcnParamsMustBeExplained = true let asn1HtmlMacros = match asn1HtmlStgFileMacros with | None -> stgFileName | Some x -> x - let files2 = r.Files |> Seq.map (PrintAsn1FileInColorizedHtml asn1HtmlMacros r) - let files3 = PrintAcnAsHTML2 stgFileName r + let files2 = r.Files |> Seq.map (PrintAsn1FileInColorizedHtml asn1HtmlMacros r icdHashesToPrint) + let files3 = PrintAcnAsHTML2 stgFileName r icdHashesToPrint let cssFileName = Path.ChangeExtension(outFileName, ".css") let htmlContent = icd_acn.RootHtml stgFileName files1 files2 bAcnParamsMustBeExplained files3 (Path.GetFileName(cssFileName)) let htmlContentb = icd_acn.RootHtml stgFileName files1b files2 bAcnParamsMustBeExplained files3 (Path.GetFileName(cssFileName)) diff --git a/FrontEndAst/DAst.fs b/FrontEndAst/DAst.fs index 627234793..deae87b7c 100644 --- a/FrontEndAst/DAst.fs +++ b/FrontEndAst/DAst.fs @@ -81,6 +81,7 @@ and IcdTypeAss = { maxLengthInBytes : BigInteger hash : string canBeEmbedded : bool + hasAcnDefinition : bool createRowsFunc : IcdInnerTableFunc } From e3fed24b534c47ea4b6130dc474e93b3434340b7 Mon Sep 17 00:00:00 2001 From: Maxime Perrotin Date: Thu, 5 Sep 2024 14:20:13 +0200 Subject: [PATCH 14/35] Update Makefile in test case Due to optimization in the code generation process some needed functions are not generated if not used by the runtime itself. But as user code makes here direct call to the runtime, we have to force the generation of the needed functions --- Docs/examples/calculate_crc/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Docs/examples/calculate_crc/Makefile b/Docs/examples/calculate_crc/Makefile index a1c523fc6..8fbd67d95 100644 --- a/Docs/examples/calculate_crc/Makefile +++ b/Docs/examples/calculate_crc/Makefile @@ -5,7 +5,7 @@ $(info ${PATH}) all: cTest adaTest cTest: - asn1scc -mfm postEncoding -c -ACN -atc -o c_out/ a.a* && (cd c_out/ ; make coverage; cd ..) + asn1scc -if Acn_Dec_Int_PositiveInteger_ConstSize -if Acn_Enc_Int_PositiveInteger_ConstSize -mfm postEncoding -c -ACN -atc -o c_out/ a.a* && (cd c_out/ ; make coverage; cd ..) adaTest: asn1scc -mfm postEncoding -Ada -ACN -atc -o a_out/ a.a* && (cd a_out/ ; make coverage; cd ..) From 792d1f19b90d5c756af58bba03dcdd5e0c2b454b Mon Sep 17 00:00:00 2001 From: Maxime Perrotin Date: Thu, 5 Sep 2024 14:21:48 +0200 Subject: [PATCH 15/35] Update Makefile of example test case --- Docs/examples/calculate_crc2/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Docs/examples/calculate_crc2/Makefile b/Docs/examples/calculate_crc2/Makefile index 868e5983f..f07fac6ea 100644 --- a/Docs/examples/calculate_crc2/Makefile +++ b/Docs/examples/calculate_crc2/Makefile @@ -5,7 +5,7 @@ $(info ${PATH}) all: cTest adaTest cTest: - asn1scc -c -ACN -atc -o c_out/ a.a* && (cd c_out/ ; make coverage; cd ..) + asn1scc -if Acn_Dec_Int_PositiveInteger_ConstSize -if Acn_Enc_Int_PositiveInteger_ConstSize -c -ACN -atc -o c_out/ a.a* && (cd c_out/ ; make coverage; cd ..) adaTest: asn1scc -Ada -ACN -atc -o a_out/ a.a* && (cd a_out/ ; make coverage; cd ..) From d9b60a87d5d5900dc07928ea59ebb551fde926d2 Mon Sep 17 00:00:00 2001 From: Samuel Chassot <14821693+samuelchassot@users.noreply.github.com> Date: Fri, 6 Sep 2024 13:28:14 +0200 Subject: [PATCH 16/35] Prove invertibility of more functions in ACN (#7) * unfold the loop in uint2int for verification, proves invertibility of some functions in ACN * invertibility * script to verify acn used functions * remove useless comments * refactor --- .../src/main/scala/asn1scala/asn1jvm.scala | 32 +++++++- .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 81 +++++++++++++++++++ asn1scala/stainless.conf | 2 +- ..._safety_acn.sh => verify_acn_used_fcts.sh} | 0 4 files changed, 112 insertions(+), 3 deletions(-) rename asn1scala/{verify_safety_acn.sh => verify_acn_used_fcts.sh} (100%) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm.scala index e8ecf8d46..16615d1b2 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm.scala @@ -302,7 +302,7 @@ def alignedSizeToDWord(bits: Long, offset: Long): Long = { alignedSizeToN(32L, offset, bits) }.ensuring(res => bits <= res && res <= bits + 31L) -def uint2int(v: ULong, uintSizeInBytes: Int): Long = { +def uint2intWhile(v: ULong, uintSizeInBytes: Int): Long = { require(uintSizeInBytes >= 1 && uintSizeInBytes <= 9) var vv = v.toRaw @@ -312,7 +312,7 @@ def uint2int(v: ULong, uintSizeInBytes: Int): Long = { if !bIsNegative then return v - var i: Int = NO_OF_BYTES_IN_JVM_LONG-1 + var i: Int = NO_OF_BYTES_IN_JVM_LONG-1 // 7 (while i >= uintSizeInBytes do decreases(i) vv |= ber_aux(i) @@ -321,6 +321,34 @@ def uint2int(v: ULong, uintSizeInBytes: Int): Long = { -(~vv) - 1 } +/** + * Version of uint2int that unfolds completely the loop, to help verification + * + * @param v + * @param uintSizeInBytes + */ +def uint2int(v: ULong, uintSizeInBytes: Int): Long = { + require(uintSizeInBytes >= 1 && uintSizeInBytes <= 9) + + var vv = v.toRaw + val tmp: ULong = 0x80 + val bIsNegative: Boolean = (vv & (tmp << ((uintSizeInBytes - 1) * 8))) > 0 + + if !bIsNegative then + return v + + if(uintSizeInBytes <= 7) then vv |= ber_aux(7) + if(uintSizeInBytes <= 6) then vv |= ber_aux(6) + if(uintSizeInBytes <= 5) then vv |= ber_aux(5) + if(uintSizeInBytes <= 4) then vv |= ber_aux(4) + if(uintSizeInBytes <= 3) then vv |= ber_aux(3) + if(uintSizeInBytes <= 2) then vv |= ber_aux(2) + if(uintSizeInBytes <= 1) then vv |= ber_aux(1) + + -(~vv) - 1 +} + + def GetCharIndex(ch: UByte, charSet: Array[UByte]): Int = { diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index f0cb9624b..1acb1edc0 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -223,6 +223,16 @@ case class ACN(base: Codec) { require(nBits <= encodedSizeInBits && encodedSizeInBits <= 64) require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, encodedSizeInBits)) enc_Int_PositiveInteger_ConstSize(intVal.toLong.toRawULong, encodedSizeInBits) + }.ensuring { _ => + val w1 = old(this) + val w3 = this + w1.base.bitStream.buf.length == w3.base.bitStream.buf.length && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + encodedSizeInBits + && w1.isPrefixOf(w3) && { + val (r1, r3) = ACN.reader(w1, w3) + validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, encodedSizeInBits) + val (r3Got, iGot) = r1.dec_Int_PositiveInteger_ConstSize_pure(encodedSizeInBits) + iGot.toRaw.toInt == intVal && r3Got == r3 + } } // @opaque @inlineOnce @@ -762,23 +772,63 @@ case class ACN(base: Codec) { require(BitStream.validate_offset_byte(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit)) require(-128L <= intVal && intVal <= 127L) enc_Int_PositiveInteger_ConstSize_8(ULong.fromRaw(intVal & 0xFFL)) + }.ensuring { _ => + val w1 = old(this) + val w3 = this + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 8 + && w1.isPrefixOf(w3) && { + val (r1, r3) = ACN.reader(w1, w3) + validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 8) + val (r3Got, iGot) = r1.dec_Int_TwosComplement_ConstSize_8_pure() + iGot == intVal && r3Got == r3 + } } def enc_Int_TwosComplement_ConstSize_big_endian_16(intVal: Long): Unit = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 16)) require(-32768L <= intVal && intVal <= 32767L) enc_Int_PositiveInteger_ConstSize_big_endian_16(ULong.fromRaw(intVal & 0xFFFFL)) + }.ensuring { _ => + val w1 = old(this) + val w3 = this + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 + && w1.isPrefixOf(w3) && { + val (r1, r3) = ACN.reader(w1, w3) + validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 16) + val (r3Got, iGot) = r1.dec_Int_TwosComplement_ConstSize_big_endian_16_pure() + iGot == intVal && r3Got == r3 + } } def enc_Int_TwosComplement_ConstSize_big_endian_32(intVal: Long): Unit = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 32)) require(-2147483648L <= intVal && intVal <= 2147483647L) enc_Int_PositiveInteger_ConstSize_big_endian_32(ULong.fromRaw(intVal & 0xFFFFFFFFL)) + }.ensuring { _ => + val w1 = old(this) + val w3 = this + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 + && w1.isPrefixOf(w3) && { + val (r1, r3) = ACN.reader(w1, w3) + validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 32) + val (r3Got, iGot) = r1.dec_Int_TwosComplement_ConstSize_big_endian_32_pure() + iGot == intVal && r3Got == r3 + } } def enc_Int_TwosComplement_ConstSize_big_endian_64(intVal: Long): Unit = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 64)) enc_Int_PositiveInteger_ConstSize_big_endian_64(ULong.fromRaw(intVal)) + }.ensuring { _ => + val w1 = old(this) + val w3 = this + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 + && w1.isPrefixOf(w3) && { + val (r1, r3) = ACN.reader(w1, w3) + validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 64) + val (r3Got, iGot) = r1.dec_Int_TwosComplement_ConstSize_big_endian_64_pure() + iGot == intVal && r3Got == r3 + } } def enc_Int_TwosComplement_ConstSize_little_endian_16(intVal: Long): Unit = { @@ -832,6 +882,13 @@ case class ACN(base: Codec) { (cpy, l) } + @ghost @pure + def dec_Int_TwosComplement_ConstSize_8_pure(): (ACN, Long) = { + + val cpy = snapshot(this) + val l = cpy.dec_Int_TwosComplement_ConstSize_8() + (cpy, l) + } def dec_Int_TwosComplement_ConstSize_8(): Long = { if(!BitStream.validate_offset_byte(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) ) then @@ -840,12 +897,28 @@ case class ACN(base: Codec) { uint2int(dec_Int_PositiveInteger_ConstSize_8(), 1) } + @ghost @pure + def dec_Int_TwosComplement_ConstSize_big_endian_16_pure(): (ACN, Long) = { + + val cpy = snapshot(this) + val l = cpy.dec_Int_TwosComplement_ConstSize_big_endian_16() + (cpy, l) + } + def dec_Int_TwosComplement_ConstSize_big_endian_16(): Long = { if(!BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 16) ) then 0L else uint2int(dec_Int_PositiveInteger_ConstSize_big_endian_16(), NO_OF_BYTES_IN_JVM_SHORT) } + + @ghost @pure + def dec_Int_TwosComplement_ConstSize_big_endian_32_pure(): (ACN, Long) = { + + val cpy = snapshot(this) + val l = cpy.dec_Int_TwosComplement_ConstSize_big_endian_32() + (cpy, l) + } def dec_Int_TwosComplement_ConstSize_big_endian_32(): Long = { if(!BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 32)) then @@ -854,6 +927,14 @@ case class ACN(base: Codec) { uint2int(dec_Int_PositiveInteger_ConstSize_big_endian_32(), NO_OF_BYTES_IN_JVM_INT) } + @ghost @pure + def dec_Int_TwosComplement_ConstSize_big_endian_64_pure(): (ACN, Long) = { + + val cpy = snapshot(this) + val l = cpy.dec_Int_TwosComplement_ConstSize_big_endian_64() + (cpy, l) + } + def dec_Int_TwosComplement_ConstSize_big_endian_64(): Long = { if(!BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 64)) then 0L diff --git a/asn1scala/stainless.conf b/asn1scala/stainless.conf index 450a2d9c6..96681193b 100644 --- a/asn1scala/stainless.conf +++ b/asn1scala/stainless.conf @@ -3,7 +3,7 @@ vc-cache = true # debug = ["smt"] -timeout = 120 +timeout = 200 check-models = false print-ids = false print-types = false diff --git a/asn1scala/verify_safety_acn.sh b/asn1scala/verify_acn_used_fcts.sh similarity index 100% rename from asn1scala/verify_safety_acn.sh rename to asn1scala/verify_acn_used_fcts.sh From bd28e3a381d8ddc633cbb2acd5d61be58b60f420 Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Mon, 22 Jul 2024 14:12:30 +0200 Subject: [PATCH 17/35] Add ACN dependencies to encoding function as well in preparation for inversion property --- BackendAst/DAstUtilFunctions.fs | 6 +- BackendAst/DastTestCaseCreation.fs | 2 +- BackendAst/EncodeDecodeTestCase.fs | 5 +- StgScala/ProofGen.fs | 119 +++++++++++++++++++++-------- 4 files changed, 92 insertions(+), 40 deletions(-) diff --git a/BackendAst/DAstUtilFunctions.fs b/BackendAst/DAstUtilFunctions.fs index c4bfbde46..64b4bf137 100644 --- a/BackendAst/DAstUtilFunctions.fs +++ b/BackendAst/DAstUtilFunctions.fs @@ -919,12 +919,12 @@ type SeqChildInfo with | ACN -> this.acnMaxSizeInBits | _ -> raise (BugErrorException $"Unexpected encoding: {enc}") -let hasAcnEncodeFunction (encFunc : AcnFunction option) acnParameters = +let hasAcnEncodeFunction (encFunc: AcnFunction option) acnParameters (tasInfo: TypeAssignmentInfo option) = match encFunc with | None -> false | Some fnc -> - match acnParameters with - | [] -> + match acnParameters, tasInfo with + | [], Some _ -> let p = {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} let ret,_ = fnc.funcBody emptyState [] (NestingScope.init 0I 0I []) p match ret with diff --git a/BackendAst/DastTestCaseCreation.fs b/BackendAst/DastTestCaseCreation.fs index 773fe2df9..86e710f91 100644 --- a/BackendAst/DastTestCaseCreation.fs +++ b/BackendAst/DastTestCaseCreation.fs @@ -195,7 +195,7 @@ let printAllTestCasesAndTestCaseRunner (r:DAst.AstRoot) (lm:LanguageMacros) outD let encDecTestFunc = t.Type.getEncDecTestFunc e match encDecTestFunc with | Some _ -> - let hasEncodeFunc = e <> Asn1Encoding.ACN || hasAcnEncodeFunction t.Type.acnEncFunction t.Type.acnParameters + let hasEncodeFunc = e <> Asn1Encoding.ACN || hasAcnEncodeFunction t.Type.acnEncFunction t.Type.acnParameters t.Type.id.tasInfo if hasEncodeFunc then let isTestCaseValid atc = match t.Type.acnEncFunction with diff --git a/BackendAst/EncodeDecodeTestCase.fs b/BackendAst/EncodeDecodeTestCase.fs index ffccc7f08..425910eea 100644 --- a/BackendAst/EncodeDecodeTestCase.fs +++ b/BackendAst/EncodeDecodeTestCase.fs @@ -153,7 +153,7 @@ let _createAcnEncDecFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A let sAmberDecode = getAmberDecode t let sAmberIsValid = getAmberDecode t - match hasAcnEncodeFunction encFunc t.acnParameters with + match hasAcnEncodeFunction encFunc t.acnParameters t.id.tasInfo with | false -> None, us | true -> match funcName with @@ -189,7 +189,7 @@ let _createAcnEncDecFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A } joinItems (content.orElse "") sNestedContent - match hasAcnEncodeFunction encFunc t.acnParameters with + match hasAcnEncodeFunction encFunc t.acnParameters t.id.tasInfo with | true -> let sNestedStatements = let rec printStatements statements : string option = @@ -484,4 +484,3 @@ let BitStringAutomaticTestCaseValues (r:Asn1AcnAst.AstRoot) (t:Asn1AcnAst.Asn1T let s2 = System.String('0', int o.maxSize.uper) [s1;s2] | _ -> valsFromSingleValueConstraints - diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index c4cb27e4e..b84e55b22 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -757,6 +757,7 @@ let generateEncodePostcondExprCommon (tpe: Type) (maxSize: bigint) (pVal: Selection) (resPostcond: Var) + (acnTps: Type list) (sz: SizeExprRes) (extraCondsPre: Expr list) (decodePureId: string) @@ -765,6 +766,9 @@ let generateEncodePostcondExprCommon (tpe: Type) let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} let oldCdc = Old (Var cdc) let szRecv = {Var.name = pVal.asLastOrSelf.receiverId; tpe = tpe} + + let acnVarsPatBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn{ix + 1}"; tpe = tpe}) + // TODO: Invertibility for ACN parameters as well let invertibility = let prefix = isPrefixOfACN oldCdc (Var cdc) @@ -790,7 +794,23 @@ let generateEncodePostcondExprCommon (tpe: Type) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) ] (*@ invertibility*)) let rightBody = letsIn sz.bdgs rightBody - eitherMatchExpr (Var resPostcond) None (BoolLit true) None rightBody + if acnTps.IsEmpty then + eitherMatchExpr (Var resPostcond) None (BoolLit true) None rightBody + else + let rightTuplePat = TuplePattern {binder = None; subPatterns = Wildcard None :: (acnVarsPatBdg |> List.map (fun v -> Wildcard (Some v)))} + MatchExpr { + scrut = Var resPostcond + cases = [ + { + pattern = ADTPattern {binder = None; id = leftId; subPatterns = [Wildcard None]} + rhs = BoolLit true + } + { + pattern = ADTPattern {binder = None; id = rightId; subPatterns = [rightTuplePat]} + rhs = rightBody + } + ] + } let generatePrecond (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (codec: Codec): Expr = let codecTpe = runtimeCodecTypeFor ACN @@ -820,7 +840,7 @@ let generateEncodePostcondExpr (t: Asn1AcnAst.Asn1Type) (pVal: Selection) (resPo // Note that we don't have a "ReferenceType" in such cases, so we have to explicitly call `size` and not rely on asn1SizeExpr... {bdgs = []; resSize = callSize (Var szRecv) (bitIndexACN oldCdc)} | _ -> asn1SizeExpr t.acnAlignment t.Kind (Var szRecv) (bitIndexACN oldCdc) 0I 0I - generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits pVal resPostcond sz [] decodePureId [] + generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits pVal resPostcond [] sz [] decodePureId [] let generateDecodePostcondExpr (t: Asn1AcnAst.Asn1Type) (resPostcond: Var): Expr = let codecTpe = runtimeCodecTypeFor ACN @@ -941,9 +961,19 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) let precond = [Precond (validateOffsetBitsACN (Var cdc) (longlit t.acnMaxSizeInBits))] let isValidFuncName = $"{t.FT_TypeDefinition.[Scala].typeName}_IsConstraintValid" + // Computing external ACN dependencies for decoding + // We also pass them to the encoding function because its postcondition + // refers to the decoding function, which needs them + let paramsAcn = acnExternDependenciesVariableDecode t nestingScope + // All ACN fields present in this SEQUENCE, including nested ones + // Encoding functions will return them so that we can refer to them in the postcondition when calling the decoding function + let acns = collectNestedAcnChildren t.Kind + let acnsVars = acns |> List.map (fun c -> {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type}) + let acnTps = acnsVars |> List.map (fun v -> v.tpe) + match codec with | Encode -> - let retTpe = IntegerType Int + let retTpe = tupleType (IntegerType Int :: acnTps) let outerPVal = SelectionExpr (joinedSelection outerSel.arg) let cstrCheck = let scrut = FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var recPVal]} @@ -954,12 +984,12 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) let body = letsGhostIn [oldCdc, Snapshot (Var cdc)] (mkBlock ([ cstrCheck EncDec body - ClassCtor (right errTpe retTpe (int32lit 0I)) + ClassCtor (right errTpe retTpe (mkTuple (int32lit 0I :: (acnsVars |> List.map Var)))) ])) let outermostPVal = {Var.name = "pVal"; tpe = fromAsn1TypeKind (nestingScope.parents |> List.last |> snd).Kind} - let acnVars = acnExternDependenciesVariableEncode t nestingScope |> Option.toList - let resPostcond = {Var.name = "res"; tpe = ClassType {id = eitherId; tps = [errTpe; IntegerType Int]}} + let acnExtVars = acnExternDependenciesVariableEncode t nestingScope |> Option.toList + let resPostcond = {Var.name = "res"; tpe = ClassType (eitherTpe errTpe retTpe)} let decodePureId = $"{t.FT_TypeDefinition.[Scala].typeName}_ACN_Decode_pure" let szRecv = {Var.name = recSel.arg.asLastOrSelf.receiverId; tpe = tpe} let sz = @@ -970,10 +1000,10 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) // If we do, we must "inline" the size definition which will contain the size of these extra ACN fields and if not, we can just call size // We always inline here since it is ok even if we don't have extra ACN fields asn1SizeExpr t.acnAlignment t.Kind (Var szRecv) (bitIndexACN (Old (Var cdc))) 0I 0I - let postcondExpr = generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits recSel.arg resPostcond sz [] decodePureId [] + let postcondExpr = generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits recSel.arg resPostcond acnTps sz [] decodePureId [] let fd = { id = $"{ToC t.id.dropModule.AsString}_ACN_Encode" - prms = [cdc; outermostPVal] @ acnVars @ [recPVal] + prms = [cdc; outermostPVal] @ acnExtVars @ paramsAcn @ [recPVal] specs = precond annots = [Opaque; InlineOnce] postcond = Some (resPostcond, postcondExpr) @@ -982,20 +1012,39 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ (acnVars |> List.map (fun v -> Var v)) @ [FreshCopy outerPVal]} // TODO: Ideally we should not be needing a freshCopy... + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map (fun v -> Var v)) @ [outerPVal]} let leftBdg = {Var.name = "l"; tpe = errTpe} - let leftBody = Return (leftExpr errTpe (IntegerType Int) (Var leftBdg)) - eitherMatchExpr scrut (Some leftBdg) leftBody None UnitLit + // TODO: FIXME: the right type must be the outside type!!! + let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} + let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! + if acnsVars.IsEmpty then + eitherMatchExpr scrut (Some leftBdg) leftBody None UnitLit + else + // Since the ACN vars name may be capitalized (which can conflict with pattern matching), we use dummy var names in the binding + let acnVarsPatBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"v{ix + 1}"; tpe = tpe}) + let rightTuplePat = TuplePattern {binder = None; subPatterns = Wildcard None :: (acnVarsPatBdg |> List.map (fun v -> Wildcard (Some v)))} + let rightBody = mkTuple (acnVarsPatBdg |> List.map Var) + let call = MatchExpr { + scrut = scrut + cases = [ + { + pattern = ADTPattern {binder = None; id = leftId; subPatterns = [Wildcard (Some leftBdg)]} + rhs = leftBody + } + { + pattern = ADTPattern {binder = None; id = rightId; subPatterns = [rightTuplePat]} + rhs = rightBody + } + ] + } + let resVar = {Var.name = $"res_{outerSel.arg.asIdentifier}"; tpe = retTpe} + let acnVarsBdg = + if acnsVars.Tail.IsEmpty then [(acnsVars.Head, Var resVar)] + else acnsVars |> List.indexed |> List.map (fun (ix, v) -> (v, TupleSelect (Var resVar, ix + 1))) + letsIn ((resVar, call) :: acnVarsBdg) (mkBlock []) fd, call | Decode -> - // Computing external ACN dependencies - let paramsAcn = acnExternDependenciesVariableDecode t nestingScope - - // All ACN fields present in this SEQUENCE, including nested ones - let acns = collectNestedAcnChildren t.Kind - let acnsVars = acns |> List.map (fun c -> {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type}) - let acnTps = acnsVars |> List.map (fun v -> v.tpe) let retTpe = tupleType (tpe :: acnTps) let outerPVal = {Var.name = outerSel.arg.asIdentifier; tpe = tpe} let retInnerFd = @@ -1023,8 +1072,6 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) generateDecodePostcondExprCommon resPostcond szRecv sz [] [cstrIsValid] else assert (match t.Kind with Sequence _ -> true | _ -> false) - let codecTpe = runtimeCodecTypeFor ACN - let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} let oldCdc = Old (Var cdc) let rightBody = letsIn sz.bdgs (And [ Equals (selBuf oldCdc, selBuf (Var cdc)) @@ -1730,7 +1777,6 @@ let generateOptionalPrefixLemma (enc: Asn1Encoding) (soc: SequenceOptionalChild) let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): FunDef list * Expr = if soc.child.Optionality.IsNone then [], EncDec (soc.childBody soc.p soc.existVar) else - //assert (codec = Encode || soc.existVar.IsSome) let codecTpe = runtimeCodecTypeFor enc let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} let oldCdc = {Var.name = $"oldCdc"; tpe = ClassType codecTpe} @@ -1738,8 +1784,6 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) let childTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind let optChildTpe = ClassType (optionMutTpe childTpe) let fnid, fnIdPure = - //let td = soc.sq.typeDef.[Scala].typeName - //let prefix = soc.nestingScope.parents |> List.tryHead |> Option.map (fun (cs, _) -> $"{cs.arg.asIdentifier}_") |> Option.defaultValue "" let fnId = match codec with | Encode -> $"{ToC soc.child.Type.id.dropModule.AsString}_Optional_ACN_Encode" @@ -1760,6 +1804,11 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) | Some AlwaysAbsent -> {sz with resSize = longlit 0I} | _ -> {sz with resSize = IfExpr {cond = isDefinedMutExpr recv; thn = sz.resSize; els = longlit 0I}} + // Computing external ACN dependencies for decoding + // We also pass them to the encoding function because its postcondition + // refers to the decoding function, which needs them + let paramsAcn = acnExternDependenciesVariableDecode soc.child.Type.toAsn1AcnAst soc.nestingScope + match codec with | Encode -> let rightTpe = IntegerType Int @@ -1779,17 +1828,19 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) let resPostcond = {Var.name = "res"; tpe = fnRetTpe} let outermostPVal = {Var.name = "pVal"; tpe = fromAsn1TypeKind (soc.nestingScope.parents |> List.last |> snd).Kind} + let acnExtVars = acnExternDependenciesVariableEncode soc.child.Type.toAsn1AcnAst soc.nestingScope |> Option.toList let outerPVal = SelectionExpr (joinedSelection soc.p.arg) let sz = sizeExprOf (Var childVar) let isDefined = match soc.child.Optionality with | Some (AlwaysPresent | AlwaysAbsent) -> [] | _ -> [isDefinedMutExpr (Var childVar)] - let postcondExpr = generateEncodePostcondExprCommon optChildTpe childAsn1Tpe.acnMaxSizeInBits soc.p.arg resPostcond sz [] fnIdPure isDefined - let body = letsGhostIn [(oldCdc, Snapshot (Var cdc))] (mkBlock (cstrCheck @ [encDec; rightExpr errTpe rightTpe (int32lit 0I)])) + let postcondExpr = generateEncodePostcondExprCommon optChildTpe childAsn1Tpe.acnMaxSizeInBits soc.p.arg resPostcond [] sz [] fnIdPure isDefined + let retRes = rightExpr errTpe rightTpe (int32lit 0I) + let body = letsGhostIn [(oldCdc, Snapshot (Var cdc))] (mkBlock (cstrCheck @ [encDec; retRes])) let fd = { FunDef.id = fnid - prms = [cdc; outermostPVal; childVar] + prms = [cdc; outermostPVal] @ acnExtVars @ paramsAcn @ [childVar] annots = [Opaque; InlineOnce] specs = validateOffsetBitCond postcond = Some (resPostcond, postcondExpr) @@ -1797,12 +1848,13 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) body = body } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal; outerPVal]} + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map (fun v -> Var v)) @ [outerPVal]} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! eitherMatchExpr scrut (Some leftBdg) leftBody None UnitLit + [fd], call | Decode -> // The `existVar` does not exist for always present/absent @@ -1839,11 +1891,10 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) optionMutMatchExpr (Var resvalVar) (Some someBdg) isRight (BoolLit true)) |> Option.toList let postcondExpr = generateDecodePostcondExprCommon resPostcond resvalVar sz alwaysAbsentOrPresent cstrIsValid let body = letsGhostIn [(oldCdc, Snapshot (Var cdc))] (mkBlock [encDec; retInnerFd]) - let acnParams = acnExternDependenciesVariableDecode soc.child.Type.toAsn1AcnAst soc.nestingScope let fd = { FunDef.id = fnid - prms = [cdc] @ (existVar |> Option.toList) @ acnParams + prms = [cdc] @ (existVar |> Option.toList) @ paramsAcn annots = [Opaque; InlineOnce] specs = validateOffsetBitCond postcond = Some (resPostcond, postcondExpr) @@ -1852,7 +1903,7 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (existVar |> Option.map Var |> Option.toList) @ (acnParams |> List.map Var)} + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (existVar |> Option.map Var |> Option.toList) @ (paramsAcn |> List.map Var)} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} @@ -1860,18 +1911,20 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) let rightBdg = {Var.name = "v"; tpe = childTpe} let rightBody = Var rightBdg eitherMutMatchExpr scrut (Some leftBdg) leftBody (Some rightBdg) rightBody - let ret = letsIn [(outerPVal, call)] (mkBlock []) + + // The rest of the backend expects a `val outerPVal = result` + let ret = Let {bdg = outerPVal; e = call; body = mkBlock []} let fdPure = let varCpy = {Var.name = "cpy"; tpe = ClassType codecTpe} let varRes = {Var.name = "res"; tpe = fnRetTpe} let pureBody = (letsIn [varCpy, Snapshot (Var cdc); - varRes, FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var varCpy] @ (existVar |> Option.map Var |> Option.toList) @ (acnParams |> List.map Var)}] + varRes, FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var varCpy] @ (existVar |> Option.map Var |> Option.toList) @ (paramsAcn |> List.map Var)}] (mkTuple [Var varCpy; Var varRes])) { FunDef.id = fnIdPure - prms = [cdc] @ (existVar |> Option.toList) @ acnParams + prms = [cdc] @ (existVar |> Option.toList) @ paramsAcn annots = [GhostAnnot; Pure] specs = validateOffsetBitCond postcond = None From 817970b319bb41820f574c753b0993153ecedb1a Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Mon, 22 Jul 2024 17:40:09 +0200 Subject: [PATCH 18/35] Add invertibility property in postcondition --- StgScala/LangGeneric_scala.fs | 16 ++---- StgScala/ProofAst.fs | 2 + StgScala/ProofGen.fs | 95 ++++++++++++++++++++++++++--------- 3 files changed, 76 insertions(+), 37 deletions(-) diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index 7ba6db19a..1f0c44753 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -356,26 +356,16 @@ type LangGeneric_scala() = match res with | Some res -> assert (not nestingScope.parents.IsEmpty) - let fd, call = wrapAcnFuncBody t res.funcBody codec nestingScope p recP - - // let deps = t.externalDependencies - // printfn "FOR %A WE HAVE:" t.id.AcnAbsPath - // printfn $" {deps}" - // let topMost = snd (List.last nestingScope.parents) - // let allAcns = collectAllAcnChildren topMost.Kind - // let paramsAcn = deps |> List.map (fun dep -> allAcns |> List.tryFind (fun acn -> acn.id.fieldPath = dep.asStringList)) - // printfn " %A" (paramsAcn |> List.map (fun p -> p |> Option.map (fun p -> p.id.AcnAbsPath))) - - let fdStr = show (FunDefTree fd) + let fds, call = wrapAcnFuncBody t res.funcBody codec nestingScope p recP + let fdsStr = fds |> List.map (fun fd -> show (FunDefTree fd)) let callStr = show (ExprTree call) - // let newBody = fdStr + "\n" + callStr // TODO: Hack to determine how to change the "result variable" let resultExpr = match res.resultExpr with | Some res when res = recP.arg.asIdentifier -> Some p.arg.asIdentifier | Some res -> Some res | None -> None - Some {res with funcBody = callStr; resultExpr = resultExpr; auxiliaries = res.auxiliaries @ [fdStr]}, s + Some {res with funcBody = callStr; resultExpr = resultExpr; auxiliaries = res.auxiliaries @ fdsStr}, s | None -> None, s else funcBody s err prms nestingScope p diff --git a/StgScala/ProofAst.fs b/StgScala/ProofAst.fs index 367f86928..8eb1d4c71 100644 --- a/StgScala/ProofAst.fs +++ b/StgScala/ProofAst.fs @@ -559,6 +559,8 @@ let callSize (recv: Expr) (offset: Expr): Expr = MethodCall { id = "size"; recv let getLengthForEncodingSigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetLengthForEncodingSigned"; tps = []; args = [arg] } +let acnReader (oldCdc: Expr) (cdc: Expr): Expr = FunctionCall { prefix = [acnId]; id = "reader"; tps = []; args = [oldCdc; cdc] } + let stringLength (recv: Expr): Expr = FieldSelect (recv, "nCount") let indexOfOrLength (recv: Expr) (elem: Expr): Expr = MethodCall {recv = recv; id = "indexOfOrLength"; args = [elem]} diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index b84e55b22..93e29309a 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -769,30 +769,58 @@ let generateEncodePostcondExprCommon (tpe: Type) let acnVarsPatBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn{ix + 1}"; tpe = tpe}) - // TODO: Invertibility for ACN parameters as well let invertibility = let prefix = isPrefixOfACN oldCdc (Var cdc) - let r1 = resetAtACN (Var cdc) oldCdc + let r1 = {Var.name = "r1"; tpe = ClassType codecTpe} + let r2 = {Var.name = "r2"; tpe = ClassType codecTpe} + let readerCall = acnReader oldCdc (Var cdc) let lemmaCall = validateOffsetBitsContentIrrelevancyLemma (selBitStream oldCdc) (selBuf (Var cdc)) (longlit maxSize) + let decodePureCall = FunctionCall {prefix = []; id = decodePureId; tps = []; args = (Var r1) :: decodeExtraArgs} let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} + let decodingRes = {Var.name = "decodingRes"; tpe = ClassType (eitherMutTpe (IntegerType Int) tpe)} let resGot = {Var.name = "resGot"; tpe = tpe} - let decodePure = FunctionCall {prefix = []; id = decodePureId; tps = []; args = r1 :: decodeExtraArgs} - let eq = And [Equals (Var resGot, rightMutExpr (IntegerType Int) tpe (Var szRecv)); Equals (Var r2Got, Var cdc)] - let block = Locally (mkBlock [ - lemmaCall - LetTuple { - bdgs = [r2Got; resGot] - e = decodePure - body = eq + let acnVarsGotBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acnGot{ix + 1}"; tpe = tpe}) + let acnEq = List.zip acnVarsGotBdg acnVarsPatBdg |> List.map (fun (acnGot, acn) -> Equals (Var acnGot, Var acn)) + let eq = And ([ + Equals (Var resGot, Var szRecv) + Equals (Var r2Got, Var cdc) + ] @ acnEq) + let decodeResPatmat = + let rightPat = + let subpat = + if acnTps.IsEmpty then Wildcard (Some resGot) + else TuplePattern {binder = None; subPatterns = Wildcard (Some resGot) :: (acnVarsGotBdg |> List.map (fun v -> Wildcard (Some v)))} + ADTPattern { + binder = None + id = rightMutId + subPatterns = [subpat] + } + MatchExpr { + scrut = Var decodingRes + cases = [ + { + pattern = ADTPattern {binder = None; id = leftMutId; subPatterns = [Wildcard None]} + rhs = BoolLit false + } + { + pattern = rightPat + rhs = eq + } + ] } - ]) - [prefix; block] + let boundCall = + letTuple [r1; r2] readerCall ( + mkBlock [ + lemmaCall + letTuple [r2Got; decodingRes] decodePureCall decodeResPatmat + ] + ) + [prefix; Locally boundCall] - // TODO: Put back invertibility let rightBody = And (extraCondsPre @ [ Equals (selBufLength oldCdc, selBufLength (Var cdc)) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) - ] (*@ invertibility*)) + ] @ invertibility) let rightBody = letsIn sz.bdgs rightBody if acnTps.IsEmpty then eitherMatchExpr (Var resPostcond) None (BoolLit true) None rightBody @@ -950,7 +978,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) (codec: Codec) (nestingScope: NestingScope) (outerSel: CallerScope) - (recSel: CallerScope): FunDef * Expr = + (recSel: CallerScope): FunDef list * Expr = assert recSel.arg.path.IsEmpty let codecTpe = runtimeCodecTypeFor ACN let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} @@ -990,7 +1018,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) let outermostPVal = {Var.name = "pVal"; tpe = fromAsn1TypeKind (nestingScope.parents |> List.last |> snd).Kind} let acnExtVars = acnExternDependenciesVariableEncode t nestingScope |> Option.toList let resPostcond = {Var.name = "res"; tpe = ClassType (eitherTpe errTpe retTpe)} - let decodePureId = $"{t.FT_TypeDefinition.[Scala].typeName}_ACN_Decode_pure" + let decodePureId = $"{ToC t.id.dropModule.AsString}_ACN_Decode_pure" let szRecv = {Var.name = recSel.arg.asLastOrSelf.receiverId; tpe = tpe} let sz = match t.Kind with @@ -1000,7 +1028,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) // If we do, we must "inline" the size definition which will contain the size of these extra ACN fields and if not, we can just call size // We always inline here since it is ok even if we don't have extra ACN fields asn1SizeExpr t.acnAlignment t.Kind (Var szRecv) (bitIndexACN (Old (Var cdc))) 0I 0I - let postcondExpr = generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits recSel.arg resPostcond acnTps sz [] decodePureId [] + let postcondExpr = generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits recSel.arg resPostcond acnTps sz [] decodePureId (paramsAcn |> List.map Var) let fd = { id = $"{ToC t.id.dropModule.AsString}_ACN_Encode" prms = [cdc; outermostPVal] @ acnExtVars @ paramsAcn @ [recPVal] @@ -1012,7 +1040,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map (fun v -> Var v)) @ [outerPVal]} + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map Var) @ [outerPVal]} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} @@ -1043,9 +1071,10 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) else acnsVars |> List.indexed |> List.map (fun (ix, v) -> (v, TupleSelect (Var resVar, ix + 1))) letsIn ((resVar, call) :: acnVarsBdg) (mkBlock []) - fd, call + [fd], call | Decode -> let retTpe = tupleType (tpe :: acnTps) + let fnRetTpe = ClassType (eitherMutTpe errTpe retTpe) let outerPVal = {Var.name = outerSel.arg.asIdentifier; tpe = tpe} let retInnerFd = let retVal = mkTuple (Var recPVal :: (acnsVars |> List.map Var)) @@ -1056,7 +1085,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) eitherMatchExpr scrut (Some leftBdg) leftBody None rightBody let body = letsGhostIn [oldCdc, Snapshot (Var cdc)] (mkBlock [EncDec body; retInnerFd]) - let resPostcond = {Var.name = "res"; tpe = ClassType {id = eitherMutId; tps = [errTpe; retTpe]}} + let resPostcond = {Var.name = "res"; tpe = fnRetTpe} let szRecv = {Var.name = "resVal"; tpe = tpe} let sz = match t.Kind with @@ -1105,7 +1134,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) specs = precond annots = [Opaque; InlineOnce] postcond = Some (resPostcond, postcondExpr) - returnTpe = ClassType (eitherMutTpe errTpe retTpe) + returnTpe = fnRetTpe body = body } @@ -1126,7 +1155,25 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) let tplVar = {Var.name = outerPVal.name + "_tuple"; tpe = retTpe} let bdgs = (tplVar, call) :: ((outerPVal :: acnsVars) |> List.mapi (fun i v -> v, TupleSelect (Var tplVar, i + 1))) letsIn bdgs (mkBlock []) - fd, ret + + let fdPure = + let varCpy = {Var.name = "cpy"; tpe = ClassType codecTpe} + let varRes = {Var.name = "res"; tpe = fnRetTpe} + let pureBody = (letsIn + [varCpy, Snapshot (Var cdc); + varRes, FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var varCpy] @ (paramsAcn |> List.map Var)}] + (mkTuple [Var varCpy; Var varRes])) + { + FunDef.id = $"{ToC t.id.dropModule.AsString}_ACN_Decode_pure" + prms = [cdc] @ paramsAcn + annots = [GhostAnnot; Pure] + specs = precond + postcond = None + returnTpe = tupleType [ClassType codecTpe; fnRetTpe] + body = pureBody + } + + [fd; fdPure], ret let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Var) (oldCdc: Var) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec) (rest: Expr): Expr = @@ -1835,7 +1882,7 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) match soc.child.Optionality with | Some (AlwaysPresent | AlwaysAbsent) -> [] | _ -> [isDefinedMutExpr (Var childVar)] - let postcondExpr = generateEncodePostcondExprCommon optChildTpe childAsn1Tpe.acnMaxSizeInBits soc.p.arg resPostcond [] sz [] fnIdPure isDefined + let postcondExpr = generateEncodePostcondExprCommon optChildTpe childAsn1Tpe.acnMaxSizeInBits soc.p.arg resPostcond [] sz [] fnIdPure (isDefined @ (paramsAcn |> List.map Var)) let retRes = rightExpr errTpe rightTpe (int32lit 0I) let body = letsGhostIn [(oldCdc, Snapshot (Var cdc))] (mkBlock (cstrCheck @ [encDec; retRes])) let fd = { @@ -1848,7 +1895,7 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) body = body } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map (fun v -> Var v)) @ [outerPVal]} + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map Var) @ [outerPVal]} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} From 2709d47c79f33cf123ab1978e2d9b0d5ef9cccf4 Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Thu, 25 Jul 2024 14:45:00 +0200 Subject: [PATCH 19/35] Generate prefix lemmas (without proof) for sequences --- BackendAst/DAstACN.fs | 5 +- FrontEndAst/Language.fs | 2 + StgScala/LangGeneric_scala.fs | 4 + StgScala/ProofGen.fs | 185 +++++++++++++----- .../scala/asn1scala/asn1jvm_Bitstream.scala | 4 +- .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 47 ++--- 6 files changed, 177 insertions(+), 70 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index 29a45a38b..f13d9e52e 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -2171,6 +2171,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi Some resultExpr, [lm.uper.sequence_build resultExpr (typeDefinition.longTypedefName2 lm.lg.hasModules) p.arg.isOptional (existSeq@childrenResultExpr)] | _ -> None, [] let proof = lm.lg.generateSequenceProof ACN t o nestingScope p.arg codec + let aux = lm.lg.generateSequenceAuxiliaries ACN t o nestingScope p.arg codec let seqContent = (saveInitialBitStrmStatements@childrenStatements@(post_encoding_function |> Option.toList)@seqBuild@proof) |> nestChildItems lm codec match existsAcnChildWithNoUpdates with @@ -2183,9 +2184,9 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi match lm.lg.decodeEmptySeq (p.arg.joined lm.lg) with | None -> None, ns | Some decodeEmptySeq -> - Some ({AcnFuncBodyResult.funcBody = decodeEmptySeq; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced= false; bBsIsUnReferenced=true; resultExpr=Some decodeEmptySeq; typeEncodingKind=Some (SequenceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries; icdResult = Some icd}), ns + Some ({AcnFuncBodyResult.funcBody = decodeEmptySeq; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced= false; bBsIsUnReferenced=true; resultExpr=Some decodeEmptySeq; typeEncodingKind=Some (SequenceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries @ aux; icdResult = Some icd}), ns | Some ret -> - Some ({AcnFuncBodyResult.funcBody = ret; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced= false; bBsIsUnReferenced=(o.acnMaxSizeInBits = 0I); resultExpr=resultExpr; typeEncodingKind=Some (SequenceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries; icdResult = Some icd}), ns + Some ({AcnFuncBodyResult.funcBody = ret; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced= false; bBsIsUnReferenced=(o.acnMaxSizeInBits = 0I); resultExpr=resultExpr; typeEncodingKind=Some (SequenceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries @ aux; icdResult = Some icd}), ns | errChild::_ -> let determinantUsage = diff --git a/FrontEndAst/Language.fs b/FrontEndAst/Language.fs index 3f7027348..b8f03e52b 100644 --- a/FrontEndAst/Language.fs +++ b/FrontEndAst/Language.fs @@ -341,6 +341,7 @@ type ILangGeneric () = abstract member getBoardDirs : Targets option -> string list abstract member adaptAcnFuncBody: AcnFuncBody -> isValidFuncName: string option -> Asn1AcnAst.Asn1Type -> Codec -> AcnFuncBody + abstract member generateSequenceAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list abstract member generateSequenceOfLikeAuxiliaries: Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> string list * string option // TODO: Bad name abstract member generateOptionalAuxiliaries: Asn1Encoding -> SequenceOptionalChild -> Codec -> string list * string @@ -375,6 +376,7 @@ type ILangGeneric () = sourceCode default this.adaptAcnFuncBody f _ _ _ = f + default this.generateSequenceAuxiliaries _ _ _ _ _ _ = [] default this.generateSequenceOfLikeAuxiliaries _ _ _ _ = [], None default this.generateOptionalAuxiliaries _ soc _ = // By default, languages do not have wrapped optional and have an `exist` field: they "attach" the child field themselves diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index 1f0c44753..04e8e56f6 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -318,6 +318,10 @@ type LangGeneric_scala() = override this.bitStringValueToByteArray (v : BitStringValue) = FsUtils.bitStringValueToByteArray (StringLoc.ByValue v) + override this.generateSequenceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateSequenceAuxiliaries enc t sq nestingScope sel codec + fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) + override this.generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (o: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): string list * string option = let fds, call = generateSequenceOfLikeAuxiliaries enc o pg codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]), Some (show (ExprTree call)) diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 93e29309a..044771dc1 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -973,6 +973,142 @@ let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: let nme = seqParent.id.lastItem Some {Var.name = nme; tpe = tpe} +let generateSequencePrefixLemma (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (sq: Asn1AcnAst.Sequence): FunDef = + let codecTpe = runtimeCodecTypeFor enc + let c1 = {Var.name = "c1"; tpe = ClassType codecTpe} + let c2 = {Var.name = "c2"; tpe = ClassType codecTpe} + let sz = {Var.name = "sz"; tpe = IntegerType Long} + let tpe = fromAsn1TypeKind t.Kind + let maxSizeExpr = longlit t.Kind.acnMaxSizeInBits + let preconds = [ + Precond (Equals (selBufLength (Var c1), selBufLength (Var c2))) + Precond (validateOffsetBitsACN (Var c1) maxSizeExpr) + Precond (And [Leq (longlit 0I, Var sz); Leq (Var sz, maxSizeExpr)]) + Precond (arrayBitRangesEq + (selBuf (Var c1)) + (selBuf (Var c2)) + (longlit 0I) + (plus [bitIndexACN (Var c1); Var sz]) + ) + ] + let isTopLevel = nestingScope.parents.IsEmpty + let paramsAcn, acnTps = + if isTopLevel then [], [] + else + let paramsAcn = acnExternDependenciesVariableDecode t nestingScope + let acns = collectNestedAcnChildren t.Kind + let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) + paramsAcn, acnTps + let baseId = + if isTopLevel then t.FT_TypeDefinition.[Scala].typeName + else ToC t.id.dropModule.AsString + let decodeId = $"{baseId}_ACN_Decode" + let decodePureId = $"{decodeId}_pure" + let c2Reset = {Var.name = "c2Reset"; tpe = ClassType codecTpe} + let c1Res = {Var.name = "c1Res"; tpe = ClassType codecTpe} + let decodingRes1 = {Var.name = "decodingRes1"; tpe = tpe} + let dec1 = {Var.name = "dec1"; tpe = TupleType [c1Res.tpe; decodingRes1.tpe]} + let call1 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = Var c1 :: (paramsAcn |> List.map Var)} + let c2Res = {Var.name = "c2Res"; tpe = ClassType codecTpe} + let decodingRes2 = {Var.name = "decodingRes2"; tpe = tpe} + let dec2 = {Var.name = "dec2"; tpe = TupleType [c2Res.tpe; decodingRes2.tpe]} + let call2 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = Var c2Reset :: (paramsAcn |> List.map Var)} + + let preSpecs = + preconds @ [ + LetSpec (c2Reset, resetAtACN (Var c2) (Var c1)) + LetSpec (dec1, call1) + LetSpec (c1Res, TupleSelect (Var dec1, 1)) + LetSpec (decodingRes1, TupleSelect (Var dec1, 2)) + LetSpec (dec2, call2) + LetSpec (c2Res, TupleSelect (Var dec2, 1)) + LetSpec (decodingRes2, TupleSelect (Var dec2, 2)) + ] + + let postcond = + let v1 = {Var.name = "v1"; tpe = tpe} + let v2 = {Var.name = "v2"; tpe = tpe} + let decodedAcn1 = acnTps |> List.indexed |> List.map (fun (i, tpe) -> {Var.name = $"acn1_{i + 1}"; tpe = tpe}) + let decodedAcn2 = acnTps |> List.indexed |> List.map (fun (i, tpe) -> {Var.name = $"acn2_{i + 1}"; tpe = tpe}) + + let subPat1, subPat2 = + if acnTps.IsEmpty then + Wildcard (Some v1), Wildcard (Some v2) + else + let subPat1 = TuplePattern { + binder = None + subPatterns = Wildcard (Some v1) :: (decodedAcn1 |> List.map (fun v -> Wildcard (Some v))) + } + let subPat2 = TuplePattern { + binder = None + subPatterns = Wildcard (Some v2) :: (decodedAcn2 |> List.map (fun v -> Wildcard (Some v))) + } + subPat1, subPat2 + + let acnsEq = List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2)) + let v1SizeExpr = asn1SizeExpr t.acnAlignment t.Kind (Var v1) (bitIndexACN (Var c1)) 0I 0I + let v1SizeVar = {Var.name = "v1Size"; tpe = IntegerType Long} + let prop = + Or [ + Not (Equals (Var v1SizeVar, Var sz)) + And ([Equals (bitIndexACN (Var c1Res), bitIndexACN (Var c2Res)); Equals (Var v1, Var v2)] @ acnsEq) + ] + let boundProp = letsIn (v1SizeExpr.bdgs @ [v1SizeVar, v1SizeExpr.resSize]) prop + MatchExpr { + scrut = mkTuple [Var decodingRes1; Var decodingRes2] + cases = [ + { + pattern = TuplePattern { + binder = None + subPatterns = [ + ADTPattern { + binder = None + id = rightMutId + subPatterns = [subPat1] + } + ADTPattern { + binder = None + id = rightMutId + subPatterns = [subPat2] + } + ] + } + rhs = boundProp + } + { + pattern = TuplePattern { + binder = None + subPatterns = [ + ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + Wildcard None + ] + } + rhs = BoolLit true + } + { + pattern = Wildcard None + rhs = BoolLit false + } + ] + } + + { + FunDef.id = $"{baseId}_prefixLemma" + prms = [c1; c2; sz] @ paramsAcn + annots = [GhostAnnot; Opaque; InlineOnce] + specs = preSpecs + postcond = Some ({Var.name = "_"; tpe = UnitType}, postcond) + returnTpe = UnitType + body = UnitLit + } + let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) (body: string) (codec: Codec) @@ -1341,49 +1477,6 @@ let selectCodecReadPrefixLemma (prefixLemmaInfo: PrefixLemmaInfo) (cdcSnap: Expr else if prefixLemmaInfo.prefix = [codecId] then selBase cdcSnap, selBase cdc else cdcSnap, cdc -let generateSequencePrefixLemma (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence): FunDef = - let codecTpe = runtimeCodecTypeFor enc - let c1 = {Var.name = "c1"; tpe = ClassType codecTpe} - let c2 = {Var.name = "c2"; tpe = ClassType codecTpe} - let tpe = fromAsn1TypeKind t.Kind - let sizeExpr = longlit t.Kind.acnMaxSizeInBits - let preconds = [ - Precond (Equals (selBufLength (Var c1), selBufLength (Var c2))) - Precond (validateOffsetBitsACN (Var c1) sizeExpr) - Precond (arrayBitRangesEq - (selBuf (Var c1)) - (selBuf (Var c2)) - (longlit 0I) - (plus [bitIndexACN (Var c1); sizeExpr]) - ) - ] - - let decodeId = $"{ToC t.id.dropModule.AsString}_ACN_Decode" - let decodePureId = $"{decodeId}_pure" - let c2Reset = {Var.name = "c2Reset"; tpe = ClassType codecTpe} - let c1Res = {Var.name = "c1Res"; tpe = ClassType codecTpe} - let v1 = {Var.name = "v1"; tpe = tpe} - let dec1 = {Var.name = "dec1"; tpe = TupleType [c1Res.tpe; v1.tpe]} - let call1 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = [Var c1]} - let c2Res = {Var.name = "c2Res"; tpe = ClassType codecTpe} - let v2 = {Var.name = "v2"; tpe = tpe} - let dec2 = {Var.name = "dec2"; tpe = TupleType [c2Res.tpe; v2.tpe]} - let call2 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = [Var c2Reset]} - - let preSpecs = - preconds @ [ - LetSpec (c2Reset, resetAtACN (Var c2) (Var c1)) - LetSpec (dec1, call1) - LetSpec (c1Res, TupleSelect (Var dec1, 1)) - LetSpec (v1, TupleSelect (Var dec1, 2)) - LetSpec (dec2, call2) - LetSpec (c2Res, TupleSelect (Var dec2, 1)) - LetSpec (v2, TupleSelect (Var dec2, 2)) - ] - let postcond = And [Equals (bitIndexACN (Var c1Res), bitIndexACN (Var c2Res)); Equals (Var v1, Var v2)] - - failwith "TODO" - let generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): Expr option = if sq.children.IsEmpty then None else @@ -1481,10 +1574,14 @@ let generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1 ]) Some (Ghost (mkBlock (transitiveLemmas @ presenceBitsPrefixLemmaApps @ childrenPrefixLemmaApps @ [proof]))) *) + +let generateSequenceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if enc = ACN && codec = Decode then [generateSequencePrefixLemma enc t nestingScope sq] + else [] + let generateSequenceOfLikeProof (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = None - let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): FunDef list * Expr = let sqfTpe = fromSequenceOfLike sqf let elemTpe = fromSequenceOfLikeElemTpe sqf diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 181089edc..a370c99af 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -840,7 +840,7 @@ case class BitStream private [asn1scala]( def resetAt(b: BitStream): BitStream = { require(b.buf.length == buf.length) BitStream(snapshot(buf), b.currentByte, b.currentBit) - }.ensuring(res => invariant(res)) + }.ensuring(res => res.buf == this.buf && res.currentByte == b.currentByte && res.currentBit == b.currentBit) // ****************** Append Bit Functions ********************** @@ -1544,7 +1544,7 @@ case class BitStream private [asn1scala]( srcBuffer == old(srcBuffer) &&& BitStream.invariant(currentBit, currentByte, buf.length) &&& w1.buf.length == w2.buf.length - &&& BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == + &&& BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits &&& w1.isPrefixOf(w2) &&& diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 1acb1edc0..45fec0217 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -27,7 +27,7 @@ object ACN { } // For showing invertibility of encoding - not fully integrated yet - + @ghost @pure @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma(acn1: ACN, acn2: ACN): Unit = { require(acn1.base.bufLength() == acn2.base.bufLength()) @@ -311,7 +311,7 @@ case class ACN(base: Codec) { def resetAt(other: ACN): ACN = { require(bitStream.buf.length == other.base.bitStream.buf.length) ACN(Codec(bitStream.resetAt(other.base.bitStream))) - } + }.ensuring(res => res.base.bitStream.buf == this.base.bitStream.buf && res.base.bitStream.currentByte == other.base.bitStream.currentByte && res.base.bitStream.currentBit == other.base.bitStream.currentBit) @ghost @pure @inline def withMovedByteIndex(diffInBytes: Int): ACN = { @@ -320,15 +320,18 @@ case class ACN(base: Codec) { } @ghost @pure @inline - def withMovedBitIndex(diffInBits: Int): ACN = { + def withMovedBitIndex(diffInBits: Long): ACN = { require(moveBitIndexPrecond(bitStream, diffInBits)) ACN(Codec(bitStream.withMovedBitIndex(diffInBits))) - } + }.ensuring(res => + this.base.bitStream.bitIndex + diffInBits == res.base.bitStream.bitIndex + && this.base.bitStream.buf.length == res.base.bitStream.buf.length + ) @pure @inline def isPrefixOf(acn2: ACN): Boolean = bitStream.isPrefixOf(acn2.base.bitStream) - @opaque @inlineOnce + // @opaque @inlineOnce def enc_Int_PositiveInteger_ConstSize_8(intVal: ULong): Unit = { require(BitStream.validate_offset_byte(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit)) require(intVal <= 255) @@ -336,7 +339,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w2 = this - w1.base.bufLength() == w2.base.bufLength() && BitStream.bitIndex(w2.base.bitStream.buf.length, w2.base.bitStream.currentByte, w2.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 8 + w1.base.bufLength() == w2.base.bufLength() && BitStream.bitIndex(w2.base.bitStream.buf.length, w2.base.bitStream.currentByte, w2.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 8 && w1.isPrefixOf(w2) && { val (r1, r2) = ACN.reader(w1, w2) val (r2Got, vGot) = r1.dec_Int_PositiveInteger_ConstSize_8_pure() @@ -363,8 +366,8 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 - && w1.isPrefixOf(w3) + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 + && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 16) @@ -393,7 +396,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 32) @@ -420,7 +423,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 64) @@ -449,7 +452,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 16) @@ -478,7 +481,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 32 && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 32) @@ -505,7 +508,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 64) @@ -542,7 +545,7 @@ case class ACN(base: Codec) { (cpy, l) } - + def dec_Int_PositiveInteger_ConstSize_big_endian_16(): ULong = { require(BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, 16)) val b1 = readByte().toRaw @@ -759,7 +762,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + formatBitLength + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + formatBitLength && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, formatBitLength) @@ -791,7 +794,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 16 && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 16) @@ -822,7 +825,7 @@ case class ACN(base: Codec) { }.ensuring { _ => val w1 = old(this) val w3 = this - w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 + w1.base.bufLength() == w3.base.bufLength() && BitStream.bitIndex(w3.base.bitStream.buf.length, w3.base.bitStream.currentByte, w3.base.bitStream.currentBit) == BitStream.bitIndex(w1.base.bitStream.buf.length, w1.base.bitStream.currentByte, w1.base.bitStream.currentBit) + 64 && w1.isPrefixOf(w3) && { val (r1, r3) = ACN.reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1.base.bitStream, w3.base.bitStream.buf, 64) @@ -911,7 +914,7 @@ case class ACN(base: Codec) { else uint2int(dec_Int_PositiveInteger_ConstSize_big_endian_16(), NO_OF_BYTES_IN_JVM_SHORT) } - + @ghost @pure def dec_Int_TwosComplement_ConstSize_big_endian_32_pure(): (ACN, Long) = { @@ -1820,11 +1823,11 @@ case class ACN(base: Codec) { if(!BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, nBitsPerElmt)) // return Array.empty flag = true - else + else strVal(i) = allowedCharSet(decodeConstrainedWholeNumber(0, allowedCharSet.length - 1).toInt) i += 1 ).invariant( - flag && base.bitStream.buf == oldThis.base.bitStream.buf + flag && base.bitStream.buf == oldThis.base.bitStream.buf || !flag && ( i <= charactersToDecode && i >= 0 && charactersToDecode < Int.MaxValue && @@ -1836,9 +1839,9 @@ case class ACN(base: Codec) { base.bitStream.buf == oldThis.base.bitStream.buf ) ) - if flag then + if flag then Array.empty[ASCIIChar] - else + else strVal }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && (res.length == max.toInt + 1 || res.length == 0)) From f58740d1625f08b0c8a6e5f0cfcefa0dc454e93b Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Wed, 7 Aug 2024 11:23:58 +0200 Subject: [PATCH 20/35] Sketching parts of proof for Sequence prefix lemma --- BackendAst/DAstACN.fs | 49 +- BackendAst/DAstUPer.fs | 10 +- FrontEndAst/Asn1AcnAst.fs | 4 +- FrontEndAst/Language.fs | 17 +- StgScala/LangGeneric_scala.fs | 29 +- StgScala/ProofAst.fs | 11 +- StgScala/ProofGen.fs | 536 ++++++++++++------ .../scala/asn1scala/asn1jvm_Bitstream.scala | 3 +- .../main/scala/asn1scala/asn1jvm_Codec.scala | 33 +- .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 70 ++- 10 files changed, 516 insertions(+), 246 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index f13d9e52e..f45795b61 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -482,7 +482,6 @@ let private createAcnIntegerFunctionInternal (r:Asn1AcnAst.AstRoot) let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType "INTEGER"); sConstraint=sAsn1Constraints; minLengthInBits = acnMinSizeInBits ;maxLengthInBits=acnMaxSizeInBits;sUnits=unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = "INTEGER"; rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = []; bValIsUnReferenced= bValIsUnReferenced; bBsIsUnReferenced=bBsIsUnReferenced; resultExpr = resultExpr; typeEncodingKind = typeEncodingKind; auxiliaries = []; icdResult=Some icd}) funcBody @@ -535,10 +534,17 @@ let createIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Comm | None -> getMappingFunctionModule r lm soMapFunc, soMapFunc | Some soMapFunMod -> Some soMapFunMod.Value, soMapFunc | None -> None, None - let funcBody = createAcnIntegerFunctionInternal r lm codec o.uperRange o.intClass o.acnEncodingClass uperFunc.funcBody_e sAsn1Constraints t.acnMinSizeInBits t.acnMaxSizeInBits t.unitsOfMeasure (soMapFunc, soMapFunMod) - let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - + let funcBodyOrig = createAcnIntegerFunctionInternal r lm codec o.uperRange o.intClass o.acnEncodingClass uperFunc.funcBody_e sAsn1Constraints t.acnMinSizeInBits t.acnMaxSizeInBits t.unitsOfMeasure (soMapFunc, soMapFunMod) + let funcBody (errCode: ErrorCode) + (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) + (nestingScope: NestingScope) + (p: CallerScope) = + let res = funcBodyOrig errCode acnArgs nestingScope p + res |> Option.map (fun res -> + let aux = lm.lg.generateIntegerAuxiliaries ACN t o nestingScope p.arg codec + {res with auxiliaries = res.auxiliaries @ aux}) + let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us let createAcnChildIcdFunction (ch:AcnChild) = @@ -2038,8 +2044,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let tpeKind = if child.Optionality.IsSome then childTpeKind |> Option.map OptionEncodingType else childTpeKind - let typeInfo = {uperMaxSizeBits=child.uperMaxSizeInBits; acnMaxSizeBits=child.acnMaxSizeInBits; typeKind=tpeKind} - let props = {info=Some childInfo.toAsn1AcnAst; sel=Some childSel; uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits; typeInfo=typeInfo; typeKind=Asn1 child.Type.Kind.baseKind} + let props = {info=childInfo.toAsn1AcnAst; sel=childSel; uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits} let res = {stmts=[stmts]; resultExpr=childResultExpr; existVar=existVar; props=props; typeKindEncoding=tpeKind; auxiliaries=auxiliaries @ optAux; icdComments=[]} let newAcc = {us=ns3; childIx=s.childIx + 1I; uperAccBits=s.uperAccBits + child.uperMaxSizeInBits; acnAccBits=s.acnAccBits + child.acnMaxSizeInBits} res, newAcc @@ -2084,8 +2089,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let stmts = (updateStatement |> Option.toList)@(childEncDecStatement |> Option.toList) let icdComments = stmts |> List.collect(fun z -> z.icdComments) // Note: uperMaxSizeBits and uperAccBits here do not make sense since we are in ACN - let typeInfo = {uperMaxSizeBits=0I; acnMaxSizeBits=childInfo.acnMaxSizeInBits; typeKind=childTpeKind} - let props = {info = Some childInfo.toAsn1AcnAst; sel=Some childP.arg; uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits; typeInfo=typeInfo; typeKind=Acn acnChild.Type} + let props = {info=childInfo.toAsn1AcnAst; sel=childP.arg; uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits} let res = {stmts=stmts; resultExpr=None; existVar=None; props=props; typeKindEncoding=childTpeKind; icdComments=icdComments; auxiliaries=auxiliaries} let newAcc = {us=ns2; childIx=s.childIx + 1I; uperAccBits=s.uperAccBits; acnAccBits=s.acnAccBits + acnChild.Type.acnMaxSizeInBits} res, newAcc @@ -2111,37 +2115,12 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi | Asn1Child asn1 -> printPresenceBit asn1 res.existVar | AcnChild _ -> None)) let seqProofGen = - let presenceBitsTpe = { - Asn1AcnAst.Boolean.acnProperties = {encodingPattern = None} - cons = [] - withcons = [] - uperMaxSizeInBits = 1I - uperMinSizeInBits = 1I - acnMaxSizeInBits = 1I - acnMinSizeInBits = 1I - typeDef = Map.empty - defaultInitVal = "false" - } - let presenceBitsInfo = presenceBits |> List.mapi (fun i _ -> - { - info = None - sel=None - uperMaxOffset = bigint i - acnMaxOffset = bigint i - typeInfo = { - uperMaxSizeBits = 1I - acnMaxSizeBits = 1I - typeKind = Some (AcnBooleanEncodingType None) - } - typeKind = Asn1 (Asn1AcnAst.Boolean presenceBitsTpe) - } - ) let children = childrenStatements00 |> List.map (fun xs -> xs.props) - {t = t; sel = p.arg; acnOuterMaxSize = nestingScope.acnOuterMaxSize; uperOuterMaxSize = nestingScope.uperOuterMaxSize; + {SequenceProofGen.t = t; sq = o; sel = p.arg; acnOuterMaxSize = nestingScope.acnOuterMaxSize; uperOuterMaxSize = nestingScope.uperOuterMaxSize; nestingLevel = nestingScope.nestingLevel; nestingIx = nestingScope.nestingIx; uperMaxOffset = nestingScope.uperOffset; acnMaxOffset = nestingScope.acnOffset; acnSiblingMaxSize = nestingScope.acnSiblingMaxSize; uperSiblingMaxSize = nestingScope.uperSiblingMaxSize; - children = presenceBitsInfo @ children} + children = children} let allStmts = let presenceBits = presenceBits |> List.map Some let children = childrenStatements00 |> List.map (fun s -> s.joinedBodies lm codec) diff --git a/BackendAst/DAstUPer.fs b/BackendAst/DAstUPer.fs index 673738438..93cd2312b 100644 --- a/BackendAst/DAstUPer.fs +++ b/BackendAst/DAstUPer.fs @@ -753,8 +753,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com | Decode, Copy -> Some (ToC (child._c_name + "_exist")) | _ -> None - let typeInfo = {uperMaxSizeBits=child.uperMaxSizeInBits; acnMaxSizeBits=child.acnMaxSizeInBits; typeKind=childContentResult |> Option.bind (fun c -> c.typeEncodingKind)} - let props = {info = Some (Asn1Child child).toAsn1AcnAst; sel=Some childSel; uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits; typeInfo=typeInfo; typeKind = Asn1AcnTypeKind.Asn1 child.Type.Kind.baseKind} + let props = {info=(Asn1Child child).toAsn1AcnAst; sel=childSel; uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits} let newAcc = {childIx=s.childIx + 1I; uperAccBits=s.uperAccBits + child.uperMaxSizeInBits; acnAccBits=s.acnAccBits + child.acnMaxSizeInBits} match childContentResult with @@ -803,15 +802,12 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let childrenStatements00, _ = nonAcnChildren |> foldMap handleChild {childIx=nbPresenceBits; uperAccBits=nbPresenceBits; acnAccBits=nbPresenceBits} let seqProofGen = - let presenceBitsInfo = presenceBits |> List.mapi (fun i _ -> - {info = None; sel=None; uperMaxOffset = bigint i; acnMaxOffset = bigint i; - typeInfo = {uperMaxSizeBits = 1I; acnMaxSizeBits = 1I; typeKind = Some (AcnBooleanEncodingType None)}; typeKind = Asn1AcnTypeKind.Asn1 t.Kind}) let children = childrenStatements00 |> List.map (fun xs -> xs.props) - {t = t; sel = p.arg; acnOuterMaxSize = nestingScope.acnOuterMaxSize; uperOuterMaxSize = nestingScope.uperOuterMaxSize; + {SequenceProofGen.t = t; sq = o; sel = p.arg; acnOuterMaxSize = nestingScope.acnOuterMaxSize; uperOuterMaxSize = nestingScope.uperOuterMaxSize; nestingLevel = nestingScope.nestingLevel; nestingIx = nestingScope.nestingIx; uperMaxOffset = nestingScope.uperOffset; acnMaxOffset = nestingScope.acnOffset; acnSiblingMaxSize = nestingScope.acnSiblingMaxSize; uperSiblingMaxSize = nestingScope.uperSiblingMaxSize; - children = presenceBitsInfo @ children} + children = children} let allStmts = let children = childrenStatements00 |> List.map (fun s -> s.stmt |> Option.bind (fun stmt -> stmt.body)) presenceBits @ children diff --git a/FrontEndAst/Asn1AcnAst.fs b/FrontEndAst/Asn1AcnAst.fs index 780656456..f2a7512a4 100644 --- a/FrontEndAst/Asn1AcnAst.fs +++ b/FrontEndAst/Asn1AcnAst.fs @@ -819,9 +819,9 @@ and ReferenceType = { refCons : AnyConstraint list } -type Asn1AcnTypeKind = +type Asn1AcnType = | Acn of AcnInsertedType - | Asn1 of Asn1TypeKind + | Asn1 of Asn1Type type TypeAssignment = { Name:StringLoc diff --git a/FrontEndAst/Language.fs b/FrontEndAst/Language.fs index b8f03e52b..a29d67a93 100644 --- a/FrontEndAst/Language.fs +++ b/FrontEndAst/Language.fs @@ -67,17 +67,11 @@ type TypeInfo = { | UPER -> this.uperMaxSizeBits | _ -> raise (BugErrorException $"Unexpected encoding: {enc}") -// type TypeKind = -// | Asn1Tpe Asn1AcnAst.Asn1TypeKind -// | AcnTpe - type SequenceChildProps = { - info: Asn1AcnAst.SeqChildInfo option // None for presence bits - sel: Selection option // None for presence bits + info: Asn1AcnAst.SeqChildInfo + sel: Selection uperMaxOffset: bigint acnMaxOffset: bigint - typeInfo: TypeInfo // TODO: Remove? - typeKind: Asn1AcnAst.Asn1AcnTypeKind } with member this.maxOffset (enc: Asn1Encoding): bigint = match enc with @@ -87,6 +81,7 @@ type SequenceChildProps = { type SequenceProofGen = { t: Asn1AcnAst.Asn1Type + sq: Asn1AcnAst.Sequence sel: Selection acnOuterMaxSize: bigint uperOuterMaxSize: bigint @@ -105,8 +100,8 @@ type SequenceProofGen = { | UPER -> this.uperSiblingMaxSize | _ -> raise (BugErrorException $"Unexpected encoding: {enc}") - member this.maxSize (enc: Asn1Encoding): BigInteger = - this.children |> List.map (fun c -> c.typeInfo.maxSize enc) |> List.sum + // member this.maxSize (enc: Asn1Encoding): BigInteger = + // this.children |> List.map (fun c -> c.typeInfo.maxSize enc) |> List.sum member this.outerMaxSize (enc: Asn1Encoding): bigint = match enc with @@ -342,6 +337,7 @@ type ILangGeneric () = abstract member adaptAcnFuncBody: AcnFuncBody -> isValidFuncName: string option -> Asn1AcnAst.Asn1Type -> Codec -> AcnFuncBody abstract member generateSequenceAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list + abstract member generateIntegerAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Integer -> NestingScope -> Selection -> Codec -> string list abstract member generateSequenceOfLikeAuxiliaries: Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> string list * string option // TODO: Bad name abstract member generateOptionalAuxiliaries: Asn1Encoding -> SequenceOptionalChild -> Codec -> string list * string @@ -377,6 +373,7 @@ type ILangGeneric () = default this.adaptAcnFuncBody f _ _ _ = f default this.generateSequenceAuxiliaries _ _ _ _ _ _ = [] + default this.generateIntegerAuxiliaries _ _ _ _ _ _ = [] default this.generateSequenceOfLikeAuxiliaries _ _ _ _ = [], None default this.generateOptionalAuxiliaries _ soc _ = // By default, languages do not have wrapped optional and have an `exist` field: they "attach" the child field themselves diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index 04e8e56f6..fcfbd165f 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -322,6 +322,10 @@ type LangGeneric_scala() = let fds = generateSequenceAuxiliaries enc t sq nestingScope sel codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) + override this.generateIntegerAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (int: Asn1AcnAst.Integer) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateIntegerAuxiliaries enc t int nestingScope sel codec + fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) + override this.generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (o: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): string list * string option = let fds, call = generateSequenceOfLikeAuxiliaries enc o pg codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]), Some (show (ExprTree call)) @@ -380,17 +384,20 @@ type LangGeneric_scala() = [show (ExprTree precond)] override this.generatePostcond (enc: Asn1Encoding) (funcNameBase: string) (p: CallerScope) (t: Asn1AcnAst.Asn1Type) (codec: Codec) = - let errTpe = IntegerType Int - let postcondExpr = - match codec with - | Encode -> - let resPostcond = {Var.name = "res"; tpe = ClassType (eitherTpe errTpe (IntegerType Int))} - let decodePureId = $"{t.FT_TypeDefinition.[Scala].typeName}_ACN_Decode_pure" - generateEncodePostcondExpr t p.arg resPostcond decodePureId - | Decode -> - let resPostcond = {Var.name = "res"; tpe = ClassType (eitherMutTpe errTpe (fromAsn1TypeKind t.Kind))} - generateDecodePostcondExpr t resPostcond - Some (show (ExprTree postcondExpr)) + match enc with + | ACN -> + let errTpe = IntegerType Int + let postcondExpr = + match codec with + | Encode -> + let resPostcond = {Var.name = "res"; tpe = ClassType (eitherTpe errTpe (IntegerType Int))} + let decodePureId = $"{t.FT_TypeDefinition.[Scala].typeName}_ACN_Decode_pure" + generateEncodePostcondExpr t p.arg resPostcond decodePureId + | Decode -> + let resPostcond = {Var.name = "res"; tpe = ClassType (eitherMutTpe errTpe (fromAsn1TypeKind t.Kind))} + generateDecodePostcondExpr t resPostcond + Some (show (ExprTree postcondExpr)) + | _ -> Some (show (ExprTree (BoolLit true))) override this.generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec): string list = generateSequenceChildProof enc stmts pg codec diff --git a/StgScala/ProofAst.fs b/StgScala/ProofAst.fs index 8eb1d4c71..8f281ec06 100644 --- a/StgScala/ProofAst.fs +++ b/StgScala/ProofAst.fs @@ -545,6 +545,8 @@ let bitIndexACN (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBit let resetAtACN (recv: Expr) (arg: Expr): Expr = MethodCall { id = "resetAt"; recv = recv; args = [arg] } +let withMovedBitIndexACN (recv: Expr) (diff: Expr): Expr = MethodCall { id = "withMovedBitIndex"; recv = recv; args = [diff] } + let invariant (recv: Expr): Expr = FunctionCall { prefix = [bitStreamId]; id = "invariant"; tps = []; args = [selCurrentBitACN recv; selCurrentByteACN recv; selBufLength recv] } let getBitCountUnsigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetBitCountUnsigned"; tps = []; args = [arg] } @@ -631,6 +633,9 @@ let arrayRangesEq (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr): Expr = let arrayBitRangesEq (a1: Expr) (a2: Expr) (fromBit: Expr) (toBit: Expr): Expr = FunctionCall { prefix = []; id = "arrayBitRangesEq"; tps = []; args = [a1; a2; fromBit; toBit] } +let arrayBitRangesEqSlicedLemma (a1: Expr) (a2: Expr) (fromBit: Expr) (toBit: Expr) (fromSlice: Expr) (toSlice: Expr): Expr = + FunctionCall { prefix = []; id = "arrayBitRangesEqSlicedLemma"; tps = []; args = [a1; a2; fromBit; toBit; fromSlice; toSlice] } + let listRangesEqReflexiveLemma (arr: Expr): Expr = FunctionCall { prefix = []; id = "listRangesEqReflexiveLemma"; tps = []; args = [arr] } @@ -715,10 +720,10 @@ let fromAcnInsertedType (t: Asn1AcnAst.AcnInsertedType): Type = | Asn1AcnAst.AcnInsertedType.AcnReferenceToEnumerated enm -> ClassType {id = enm.enumerated.typeDef[Scala].typeName; tps = []} | Asn1AcnAst.AcnInsertedType.AcnReferenceToIA5String _ -> ClassType (vecTpe (IntegerType UByte)) -let fromAsn1AcnTypeKind (t: Asn1AcnAst.Asn1AcnTypeKind): Type = +let fromAsn1AcnType (t: Asn1AcnAst.Asn1AcnType): Type = match t with - | Asn1AcnAst.Asn1AcnTypeKind.Acn t -> fromAcnInsertedType t - | Asn1AcnAst.Asn1AcnTypeKind.Asn1 t -> fromAsn1TypeKind t + | Asn1AcnAst.Asn1AcnType.Acn t -> fromAcnInsertedType t + | Asn1AcnAst.Asn1AcnType.Asn1 t -> fromAsn1TypeKind t.Kind let fromAsn1AcnChildInfo (t: Asn1AcnAst.SeqChildInfo): Type = match t with diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 044771dc1..a694b213b 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -973,10 +973,101 @@ let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: let nme = seqParent.id.lastItem Some {Var.name = nme; tpe = tpe} -let generateSequencePrefixLemma (enc: Asn1Encoding) - (t: Asn1AcnAst.Asn1Type) - (nestingScope: NestingScope) - (sq: Asn1AcnAst.Sequence): FunDef = +type PrimitivePrefixLemma = { + prefix: string list + id: string + extraConstArgs: Expr list +} +type ComposedPrefixLemma = { + id: string +} +type PrefixLemmaInfo = +| PrimitivePrefixLemma of PrimitivePrefixLemma +| ComposedPrefixLemma of ComposedPrefixLemma + +let readPrefixLemmaIdentifier (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bool): PrefixLemmaInfo = + let forIntClass (intCls:Asn1AcnAst.IntegerClass) (encCls: IntEncodingClass) (range: BigIntegerUperRange): PrimitivePrefixLemma = + match encCls with + | PositiveInteger_ConstSize_8 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_8_prefixLemma"; extraConstArgs = []} + | PositiveInteger_ConstSize_big_endian_16 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma"; extraConstArgs = []} + | PositiveInteger_ConstSize_big_endian_32 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_32_prefixLemma"; extraConstArgs = []} + | PositiveInteger_ConstSize_big_endian_64 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_64_prefixLemma"; extraConstArgs = []} + | PositiveInteger_ConstSize_little_endian_16 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_16_prefixLemma"; extraConstArgs = []} + | PositiveInteger_ConstSize_little_endian_32 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_32_prefixLemma"; extraConstArgs = []} + | PositiveInteger_ConstSize_little_endian_64 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_64_prefixLemma"; extraConstArgs = []} + | PositiveInteger_ConstSize bits -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_prefixLemma"; extraConstArgs = [int32lit bits]} + | TwosComplement_ConstSize_8 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_8_prefixLemma"; extraConstArgs = []} + | TwosComplement_ConstSize_big_endian_16 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_16_prefixLemma"; extraConstArgs = []} + | TwosComplement_ConstSize_big_endian_32 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_32_prefixLemma"; extraConstArgs = []} + | TwosComplement_ConstSize_big_endian_64 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_64_prefixLemma"; extraConstArgs = []} + | TwosComplement_ConstSize_little_endian_16 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_16_prefixLemma"; extraConstArgs = []} + | TwosComplement_ConstSize_little_endian_32 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_32_prefixLemma"; extraConstArgs = []} + | TwosComplement_ConstSize_little_endian_64 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_64_prefixLemma"; extraConstArgs = []} + | TwosComplement_ConstSize _ -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_prefixLemma"; extraConstArgs = []} + | Integer_uPER -> + match range with + | Full -> {prefix = [codecId]; id = "decodeUnconstrainedWholeNumber_prefixLemma"; extraConstArgs = []} + | PosInf min -> {prefix = [codecId]; id = "decodeConstrainedPosWholeNumber_prefixLemma"; extraConstArgs = [ulonglit min]} + | Concrete (min, max) -> + if intCls.IsPositive then {prefix = [codecId]; id = "decodeConstrainedPosWholeNumber_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} + else {prefix = [codecId]; id = "decodeConstrainedWholeNumber_prefixLemma"; extraConstArgs = [longlit min; longlit max]} + | _ -> failwith $"TODO: {range}" + | _ -> failwith $"TODO: {encCls}" + + if isOptional then + ComposedPrefixLemma {id = $"{ToC id.dropModule.AsString}_prefixLemma"} + else + match t with + | Asn1 t -> + match t.Kind with + | Integer int -> PrimitivePrefixLemma (forIntClass int.intClass int.acnEncodingClass int.uperRange) + | Boolean _ -> PrimitivePrefixLemma {prefix = [bitStreamId]; id = "readBitPrefixLemma"; extraConstArgs = []} + | ReferenceType rt -> + let id = + if rt.hasExtraConstrainsOrChildrenOrAcnArgs then $"{ToC id.dropModule.AsString}_prefixLemma" + else $"{t.FT_TypeDefinition.[Scala].typeName}_prefixLemma" + ComposedPrefixLemma {id = id} + | _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO + | Acn (AcnInteger int) -> PrimitivePrefixLemma (forIntClass int.intClass int.acnEncodingClass int.uperRange) + | Acn (AcnBoolean _) -> PrimitivePrefixLemma {prefix = [bitStreamId]; id = "readBitPrefixLemma"; extraConstArgs = []} + | _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO + +let selectCodecReadPrefixLemma (prefixLemmaInfo: PrefixLemmaInfo) (cdcSnap: Expr) (cdc: Expr): Expr * Expr = + match prefixLemmaInfo with + | PrimitivePrefixLemma info -> + if info.prefix = [bitStreamId] then selBitStream cdcSnap, selBitStream cdc + else if info.prefix = [codecId] then selBase cdcSnap, selBase cdc + else cdcSnap, cdc + | ComposedPrefixLemma _ -> cdcSnap, cdc + +type PrefixLemmaData = { + baseId: string + decodeId: string + decodePureId: string + paramsAcn: Var list + acnTps: Type list + c1: Var + c2: Var + sz: Var + c2Reset: Var + c1Res: Var + decodingRes1: Var + c2Res: Var + decodingRes2: Var + v1: Var + v2: Var + decodedAcn1: Var list + decodedAcn2: Var list + v1SizeExpr: SizeExprRes + v1SizeVar: Var + subPat1: Pattern + subPat2: Pattern +} + +let generatePrefixLemma (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (mkProof: PrefixLemmaData -> Expr): FunDef = let codecTpe = runtimeCodecTypeFor enc let c1 = {Var.name = "c1"; tpe = ClassType codecTpe} let c2 = {Var.name = "c2"; tpe = ClassType codecTpe} @@ -1028,77 +1119,87 @@ let generateSequencePrefixLemma (enc: Asn1Encoding) LetSpec (decodingRes2, TupleSelect (Var dec2, 2)) ] + let v1 = {Var.name = "v1"; tpe = tpe} + let v2 = {Var.name = "v2"; tpe = tpe} + let decodedAcn1 = acnTps |> List.indexed |> List.map (fun (i, tpe) -> {Var.name = $"acn1_{i + 1}"; tpe = tpe}) + let decodedAcn2 = acnTps |> List.indexed |> List.map (fun (i, tpe) -> {Var.name = $"acn2_{i + 1}"; tpe = tpe}) + + let subPat1, subPat2 = + if acnTps.IsEmpty then + Wildcard (Some v1), Wildcard (Some v2) + else + let subPat1 = TuplePattern { + binder = None + subPatterns = Wildcard (Some v1) :: (decodedAcn1 |> List.map (fun v -> Wildcard (Some v))) + } + let subPat2 = TuplePattern { + binder = None + subPatterns = Wildcard (Some v2) :: (decodedAcn2 |> List.map (fun v -> Wildcard (Some v))) + } + subPat1, subPat2 + + let acnsEq = List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2)) + let v1SizeExpr = asn1SizeExpr t.acnAlignment t.Kind (Var v1) (bitIndexACN (Var c1)) 0I 0I + let v1SizeVar = {Var.name = "v1Size"; tpe = IntegerType Long} + let prop = + let prop = And ([Equals (bitIndexACN (Var c1Res), bitIndexACN (Var c2Res)); Equals (Var v1, Var v2)] @ acnsEq) + IfExpr { + cond = Equals (Var v1SizeVar, Var sz) + thn = MatchExpr { + scrut = Var decodingRes2 + cases = [ + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [subPat2] + } + rhs = prop + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = BoolLit false + } + ] + } + els = BoolLit true + } + let postcond = - let v1 = {Var.name = "v1"; tpe = tpe} - let v2 = {Var.name = "v2"; tpe = tpe} - let decodedAcn1 = acnTps |> List.indexed |> List.map (fun (i, tpe) -> {Var.name = $"acn1_{i + 1}"; tpe = tpe}) - let decodedAcn2 = acnTps |> List.indexed |> List.map (fun (i, tpe) -> {Var.name = $"acn2_{i + 1}"; tpe = tpe}) - - let subPat1, subPat2 = - if acnTps.IsEmpty then - Wildcard (Some v1), Wildcard (Some v2) - else - let subPat1 = TuplePattern { - binder = None - subPatterns = Wildcard (Some v1) :: (decodedAcn1 |> List.map (fun v -> Wildcard (Some v))) - } - let subPat2 = TuplePattern { - binder = None - subPatterns = Wildcard (Some v2) :: (decodedAcn2 |> List.map (fun v -> Wildcard (Some v))) - } - subPat1, subPat2 - - let acnsEq = List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2)) - let v1SizeExpr = asn1SizeExpr t.acnAlignment t.Kind (Var v1) (bitIndexACN (Var c1)) 0I 0I - let v1SizeVar = {Var.name = "v1Size"; tpe = IntegerType Long} - let prop = - Or [ - Not (Equals (Var v1SizeVar, Var sz)) - And ([Equals (bitIndexACN (Var c1Res), bitIndexACN (Var c2Res)); Equals (Var v1, Var v2)] @ acnsEq) - ] let boundProp = letsIn (v1SizeExpr.bdgs @ [v1SizeVar, v1SizeExpr.resSize]) prop MatchExpr { - scrut = mkTuple [Var decodingRes1; Var decodingRes2] + scrut = Var decodingRes1 cases = [ { - pattern = TuplePattern { + pattern = ADTPattern { binder = None - subPatterns = [ - ADTPattern { - binder = None - id = rightMutId - subPatterns = [subPat1] - } - ADTPattern { - binder = None - id = rightMutId - subPatterns = [subPat2] - } - ] + id = rightMutId + subPatterns = [subPat1] } rhs = boundProp } { - pattern = TuplePattern { + pattern = ADTPattern { binder = None - subPatterns = [ - ADTPattern { - binder = None - id = leftMutId - subPatterns = [Wildcard None] - } - Wildcard None - ] + id = leftMutId + subPatterns = [Wildcard None] } rhs = BoolLit true } - { - pattern = Wildcard None - rhs = BoolLit false - } ] } + let proof = mkProof {baseId = baseId; decodeId = decodeId; decodePureId = decodePureId; paramsAcn = paramsAcn; + acnTps = acnTps; c1 = c1; c2 = c2; sz = sz; c2Reset = c2Reset; + c1Res = c1Res; decodingRes1 = decodingRes1; c2Res = c2Res; decodingRes2 = decodingRes2; + v1 = v1; v2 = v2; decodedAcn1 = decodedAcn1; decodedAcn2 = decodedAcn2; + v1SizeExpr = v1SizeExpr; v1SizeVar = v1SizeVar; subPat1 = subPat1; subPat2 = subPat2 + } + { FunDef.id = $"{baseId}_prefixLemma" prms = [c1; c2; sz] @ paramsAcn @@ -1106,9 +1207,158 @@ let generateSequencePrefixLemma (enc: Asn1Encoding) specs = preSpecs postcond = Some ({Var.name = "_"; tpe = UnitType}, postcond) returnTpe = UnitType - body = UnitLit + body = proof } +let generatePrefixLemmaInteger (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (int: Integer): FunDef = + let mkIntProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkIntProof + +let generatePrefixLemmaSequence (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (sq: Sequence): FunDef = + + let tpe = fromAsn1TypeKind t.Kind + + let childrenSizes = [0..sq.children.Length] |> List.map (fun i -> {Var.name = $"size_1_{i}"; tpe = IntegerType Long}) + + let mkUnfoldedDecodeWrapper (data: PrefixLemmaData) (id: Identifier) (c: Var): FunDef = + let cpy = {Var.name = $"{c.name}Cpy"; tpe = c.tpe} + let call = FunctionCall {prefix = []; id = data.decodeId; tps = []; args = [Var cpy]} + let body = letsIn [cpy, Snapshot (Var c)] (Unfold call) + { + FunDef.id = id; + prms = [] + annots = [] + specs = [] + postcond = None + returnTpe = UnitType + body = body + } + + let mkFieldSubproofFn (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo): FunDef = + let origC1 = data.c1 + let origC2Reset = data.c2Reset + let c1, c2 = + if ix = 0 then origC1, origC2Reset + else {Var.name = $"c1_{ix + 1}"; tpe = origC1.tpe}, {Var.name = $"c2_{ix + 1}"; tpe = origC1.tpe} + + let overallOffset = if ix = 0 then longlit 0I else childrenSizes |> List.take ix |> List.map Var |> plus + let childSize = childrenSizes.[ix] + + let specs = + if ix = 0 then [] + else [ + Precond (Equals (selBuf (Var c1), selBuf (Var origC1))) + Precond (Equals (selBuf (Var c2), selBuf (Var origC2Reset))) + Precond (Equals (bitIndexACN (Var c1), plus [bitIndexACN (Var origC1); overallOffset])) + Precond (Equals (bitIndexACN (Var c1), bitIndexACN (Var c2))) + ] + + let name = + match child with + | Asn1Child child -> child.Name.Value + | AcnChild child -> child.Name.Value + + let slicedLemmaApp = (arrayBitRangesEqSlicedLemma + (selBuf (Var c1)) + (selBuf (Var c2)) + (longlit 0I) + (Minus (plus [bitIndexACN (Var c1); Var data.v1SizeVar], overallOffset)) + (longlit 0I) + (plus [bitIndexACN (Var c1); Var childSize])) + + let c2Moved = {Var.name = "c2Moved"; tpe = c1.tpe} + let c2MovedValue = withMovedBitIndexACN (Var c2) (Var childSize) + let c2MovedAssertions = [ + Assert (Equals (bitIndexACN (Var c2Moved), plus [bitIndexACN (Var c1); Var childSize])) + Assert (arrayBitRangesEq (selBuf (Var c1)) (selBuf (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) + ] + + let asn1Tpe, id, isOpt, existArg = + match child with + | Asn1Child child -> + let existArg = + match child.Optionality with + | Some (Optional _) -> + [isDefinedMutExpr (FieldSelect (Var data.decodingRes1, child._scala_name))] + | _ -> [] + Asn1 child.Type, child.Type.id, child.Optionality.IsSome, existArg + | AcnChild child -> Acn child.Type, child.id, false, [] + let prefixLemmaInfo = readPrefixLemmaIdentifier asn1Tpe id isOpt + let cdcSnapRecv, cdcRecv = selectCodecReadPrefixLemma prefixLemmaInfo (Var c1) (Var c2Moved) + let prefixLemmaApp = + match prefixLemmaInfo with + | PrimitivePrefixLemma info -> + FunctionCall {prefix = info.prefix; id = info.id; tps = []; args = [cdcSnapRecv; cdcRecv] @ existArg @ info.extraConstArgs} + | ComposedPrefixLemma info -> + FunctionCall {prefix = []; id = info.id; tps = []; args = [cdcSnapRecv; cdcRecv] @ existArg @ [Var childSize]} + + let proof = mkBlock [ + slicedLemmaApp + letsIn [c2Moved, c2MovedValue] (mkBlock ( + c2MovedAssertions @ [prefixLemmaApp] + )) + ] + + { + FunDef.id = $"proof_{ToC name}" + prms = if ix = 0 then [] else [c1; c2] + annots = [Opaque; InlineOnce] + specs = specs + postcond = None // TODO + returnTpe = UnitType + body = proof + } + + let mkSeqProof (data: PrefixLemmaData): Expr = + let bodyWithC1 = mkUnfoldedDecodeWrapper data "bodyWithC1" data.c1 + let bodyWithC2 = mkUnfoldedDecodeWrapper data "bodyWithC2" data.c2Reset + + let subproofsFns = sq.children |> List.indexed |> List.map (fun (i, c) -> mkFieldSubproofFn data i c) + let proof = LetRec {fds = subproofsFns; body = UnitLit} + + let rightMutCase = + letsIn (data.v1SizeExpr.bdgs @ [data.v1SizeVar, data.v1SizeExpr.resSize]) ( + IfExpr { + cond = Equals (Var data.v1SizeVar, Var data.sz) + thn = proof + els = UnitLit + } + ) + LetRec { + fds = [bodyWithC1; bodyWithC2] + body = MatchExpr { + scrut = Var data.decodingRes1 + cases = [ + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [data.subPat1] + } + rhs = rightMutCase + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = UnitLit + } + ] + } + } + + generatePrefixLemma enc t nestingScope mkSeqProof + + let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) (body: string) (codec: Codec) @@ -1311,62 +1561,69 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) [fd; fdPure], ret - let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Var) (oldCdc: Var) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec) (rest: Expr): Expr = - let nbChildren = pg.children.Length - assert (snapshots.Length = nbChildren) - assert (stmts.Length = nbChildren) - - let rec assertionsConditions (tpe: TypeEncodingKind option): Expr option = - match tpe with - | Some (OptionEncodingType tpe) -> assertionsConditions (Some tpe) - | Some (Asn1IntegerEncodingType (Some encodingTpe)) -> - match encodingTpe with - | FullyConstrainedPositive (min, max) | FullyConstrained (min, max) -> - // TODO: The RT library does not add 1, why? - let call = getBitCountUnsigned (ulonglit (max - min)) - // TODO: Case min = max? - let nBits = if max = min then 0I else bigint (ceil ((log (double (max - min))) / (log 2.0))) - let cond = Equals (call, int32lit nBits) - Some cond - | _ -> None + let nbPresenceBits = countNbPresenceBits pg.sq + let nbTotalChildren = nbPresenceBits + pg.sq.children.Length + assert (snapshots.Length = nbTotalChildren) + assert (stmts.Length = nbTotalChildren) + assert (pg.children.Length = pg.sq.children.Length) + + let rec assertionsConditions (info: Asn1AcnAst.SeqChildInfo): Expr option = + let intRangeAssertion (int: BigIntegerUperRange): Expr option = + match int with + | Concrete (min, max) -> + // TODO: The RT library does not add 1, why? + let call = getBitCountUnsigned (ulonglit (max - min)) + // TODO: Case min = max? + let nBits = if max = min then 0I else bigint (ceil ((log (double (max - min))) / (log 2.0))) + let cond = Equals (call, int32lit nBits) + Some cond + | _ -> None + match info with + | Asn1Child child -> + match child.Type.Kind with + | Integer int -> intRangeAssertion int.uperRange + | _ -> None + | AcnChild child -> + match child.Type with + | AcnInteger int -> intRangeAssertion int.uperRange | _ -> None - let addAssert (tpe: TypeEncodingKind option): Expr = + let addAssert (tpe: Asn1AcnAst.SeqChildInfo): Expr = assertionsConditions tpe |> Option.map (fun cond -> Assert cond) |> Option.defaultValue (mkBlock []) let outerMaxSize = pg.outerMaxSize enc - let thisMaxSize = pg.maxSize enc + let thisMaxSize = (bigint nbPresenceBits) + (pg.sq.children |> List.sumBy (fun c -> c.maxSizeInBits enc)) let fstSnap = snapshots.Head let isNested = pg.nestingLevel > 0I - + let childrenWithPresenceBits = (List.replicate nbPresenceBits (None: SequenceChildProps option)) @ (pg.children |> List.map Some) let sizeRess = - pg.children |> + childrenWithPresenceBits |> List.indexed |> List.map (fun (ix, c) -> let childVar = {Var.name = $"size_{pg.nestingIx + bigint ix}"; tpe = IntegerType Long} - match c.info with + match c with | Some info -> let recv = match codec with - | Encode -> SelectionExpr (joinedSelection c.sel.Value) - | Decode -> SelectionExpr c.sel.Value.asIdentifier - let resSize = seqSizeExprHelperChild info (bigint ix) (Some recv) (bitIndexACN (Var snapshots.[ix])) pg.nestingLevel pg.nestingIx + | Encode -> SelectionExpr (joinedSelection info.sel) + | Decode -> SelectionExpr info.sel.asIdentifier + let resSize = seqSizeExprHelperChild info.info (bigint ix) (Some recv) (bitIndexACN (Var snapshots.[ix])) pg.nestingLevel pg.nestingIx {extraBdgs = resSize.bdgs; childVar = childVar; childSize = resSize.resSize} | None -> // presence bits {extraBdgs = []; childVar = childVar; childSize = longlit 1I} ) - let annotatePostPreciseSize (ix: int) (snap: Var) (child: SequenceChildProps): Expr = + let annotatePostPreciseSize (ix: int) (snap: Var) (child: SequenceChildProps option): Expr = let previousSizes = sizeRess |> List.take ix |> List.map (fun res -> Var res.childVar) let sizeRes = sizeRess.[ix] let chk = Check (Equals (bitIndexACN (Var cdc), plus (bitIndexACN (Var oldCdc) :: previousSizes @ [Var sizeRes.childVar]))) letsGhostIn sizeRes.allBindings (Ghost chk) - let annotatePost (ix: int) (snap: Var) (child: SequenceChildProps) (stmt: string option) (offsetAcc: bigint): Expr = - let sz = child.typeInfo.maxSize enc + let annotatePost (ix: int) (snap: Var) (child: SequenceChildProps option) (stmt: string option) (offsetAcc: bigint): Expr = + let sz = child |> Option.map (fun c -> c.info.maxSizeInBits enc) |> Option.defaultValue 1I let relativeOffset = offsetAcc - (pg.maxOffset enc) let offsetCheckOverall = Check (Leq (bitIndexACN (Var cdc), plus [bitIndexACN (Var oldCdc); (longlit offsetAcc)])) let offsetCheckNested = @@ -1378,7 +1635,7 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va | Decode -> [Check ((Equals (selBuf (Var cdc), selBuf (Var oldCdc))))] let offsetWidening = match pg.siblingMaxSize enc with - | Some siblingMaxSize when ix = nbChildren - 1 && siblingMaxSize <> thisMaxSize -> + | Some siblingMaxSize when ix = nbTotalChildren - 1 && siblingMaxSize <> thisMaxSize -> let diff = siblingMaxSize - thisMaxSize [ Check (Leq (bitIndexACN (Var cdc), plus [bitIndexACN (Var oldCdc); longlit (offsetAcc + diff)])) @@ -1387,24 +1644,25 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va | _ -> [] let checks = offsetCheckOverall :: offsetCheckNested @ bufCheck @ offsetWidening let validateOffsetLemma = - if stmt.IsSome && ix < nbChildren - 1 then + if stmt.IsSome && ix < nbTotalChildren - 1 then [validateOffsetBitsIneqLemma (selBitStream (Var snap)) (selBitStream (Var cdc)) (longlit (outerMaxSize - offsetAcc + sz)) (longlit sz)] else [] let preciseSize = annotatePostPreciseSize ix snap child mkBlock [Ghost (mkBlock (validateOffsetLemma @ checks)); preciseSize] - let annotate (ix: int, (snap: Var, child: SequenceChildProps, stmt: string option)) (offsetAcc: bigint, rest: Expr): bigint * Expr = - let sz = child.typeInfo.maxSize enc + let annotate (ix: int, (snap: Var, child: SequenceChildProps option, stmt: string option)) (offsetAcc: bigint, rest: Expr): bigint * Expr = + let sz = child |> Option.map (fun c -> c.info.maxSizeInBits enc) |> Option.defaultValue 1I //assert (thisMaxSize <= (pg.siblingMaxSize enc |> Option.defaultValue thisMaxSize)) // TODO: Somehow does not always hold with UPER? let preAnnots = - if stmt.IsSome then [addAssert child.typeInfo.typeKind] - else [] + match stmt, child with + | Some _, Some c -> [addAssert c.info] + | _ -> [] let postAnnots = annotatePost ix snap child stmt offsetAcc let encDec = stmt |> Option.map EncDec |> Option.toList let body = mkBlock (preAnnots @ encDec @ [postAnnots; rest]) offsetAcc - sz, LetGhost {bdg = snap; e = Snapshot (Var cdc); body = body} - let stmts = List.zip3 snapshots pg.children stmts |> List.indexed + let stmts = List.zip3 snapshots childrenWithPresenceBits stmts |> List.indexed List.foldBack annotate stmts ((pg.maxOffset enc) + thisMaxSize, rest) |> snd let generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec): string list = @@ -1414,7 +1672,8 @@ let generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) ( let cdc = {Var.name = $"codec"; tpe = ClassType codecTpe} let oldCdc = {Var.name = $"oldCdc"; tpe = ClassType codecTpe} if enc = ACN then - let snapshots = [1 .. pg.children.Length] |> List.map (fun i -> {Var.name = $"codec_{pg.nestingLevel}_{pg.nestingIx + bigint i}"; tpe = ClassType codecTpe}) + let nbPresenceBits = countNbPresenceBits pg.sq + let snapshots = [1 .. nbPresenceBits + pg.sq.children.Length] |> List.map (fun i -> {Var.name = $"codec_{pg.nestingLevel}_{pg.nestingIx + bigint i}"; tpe = ClassType codecTpe}) let wrappedStmts = annotateSequenceChildStmt enc snapshots cdc oldCdc stmts pg codec let postCondLemmas = let cond = Leq (bitIndexACN (Var cdc), plus [bitIndexACN (Var snapshots.Head); longlit (pg.outerMaxSize enc)]) @@ -1427,56 +1686,6 @@ let generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) ( let exprStr = show (ExprTree expr) [exprStr] - -type PrefixLemmaInfo = { - prefix: string list - id: string - extraArgs: Expr list -} -let readPrefixLemmaIdentifier (t: Asn1AcnAst.Asn1AcnTypeKind) (id: ReferenceToType) (isOptional: bool): PrefixLemmaInfo = - let forIntClass (intCls:Asn1AcnAst.IntegerClass) (encCls: IntEncodingClass) (range: BigIntegerUperRange): PrefixLemmaInfo = - match encCls with - | PositiveInteger_ConstSize_8 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_8_prefixLemma"; extraArgs = []} - | PositiveInteger_ConstSize_big_endian_16 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma"; extraArgs = []} - | PositiveInteger_ConstSize_big_endian_32 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_32_prefixLemma"; extraArgs = []} - | PositiveInteger_ConstSize_big_endian_64 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_64_prefixLemma"; extraArgs = []} - | PositiveInteger_ConstSize_little_endian_16 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_16_prefixLemma"; extraArgs = []} - | PositiveInteger_ConstSize_little_endian_32 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_32_prefixLemma"; extraArgs = []} - | PositiveInteger_ConstSize_little_endian_64 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_64_prefixLemma"; extraArgs = []} - | PositiveInteger_ConstSize _ -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_prefixLemma"; extraArgs = []} - | TwosComplement_ConstSize_8 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_8_prefixLemma"; extraArgs = []} - | TwosComplement_ConstSize_big_endian_16 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_16_prefixLemma"; extraArgs = []} - | TwosComplement_ConstSize_big_endian_32 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_32_prefixLemma"; extraArgs = []} - | TwosComplement_ConstSize_big_endian_64 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_64_prefixLemma"; extraArgs = []} - | TwosComplement_ConstSize_little_endian_16 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_16_prefixLemma"; extraArgs = []} - | TwosComplement_ConstSize_little_endian_32 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_32_prefixLemma"; extraArgs = []} - | TwosComplement_ConstSize_little_endian_64 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_64_prefixLemma"; extraArgs = []} - | TwosComplement_ConstSize _ -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_prefixLemma"; extraArgs = []} - | Integer_uPER -> - match range with - | Full -> {prefix = [codecId]; id = "decodeUnconstrainedWholeNumber_prefixLemma"; extraArgs = []} - | PosInf min -> {prefix = [codecId]; id = "decodeConstrainedPosWholeNumber_prefixLemma"; extraArgs = [ulonglit min]} - | Concrete (min, max) -> - if intCls.IsPositive then {prefix = [codecId]; id = "decodeConstrainedPosWholeNumber_prefixLemma"; extraArgs = [ulonglit min; ulonglit max]} - else {prefix = [codecId]; id = "decodeConstrainedWholeNumber_prefixLemma"; extraArgs = [longlit min; longlit max]} - | _ -> failwith $"TODO: {range}" - | _ -> failwith $"TODO: {encCls}" - - if isOptional then - {prefix = []; id = $"{ToC id.dropModule.AsString}_prefixLemma"; extraArgs = []} - else - match t with - | Asn1 (Integer int) -> forIntClass int.intClass int.acnEncodingClass int.uperRange - | Acn (AcnInteger int) -> forIntClass int.intClass int.acnEncodingClass int.uperRange - | Asn1 (Boolean _) | Acn (AcnBoolean _) -> {prefix = [bitStreamId]; id = "readBitPrefixLemma"; extraArgs = []} - | _ -> - {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraArgs = []} // TODO - -let selectCodecReadPrefixLemma (prefixLemmaInfo: PrefixLemmaInfo) (cdcSnap: Expr) (cdc: Expr): Expr * Expr = - if prefixLemmaInfo.prefix = [bitStreamId] then selBitStream cdcSnap, selBitStream cdc - else if prefixLemmaInfo.prefix = [codecId] then selBase cdcSnap, selBase cdc - else cdcSnap, cdc - let generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): Expr option = if sq.children.IsEmpty then None else @@ -1576,8 +1785,16 @@ let generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1 *) let generateSequenceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = - if enc = ACN && codec = Decode then [generateSequencePrefixLemma enc t nestingScope sq] - else [] + [] + // if enc = ACN && codec = Decode then [generatePrefixLemmaSequence enc t nestingScope sq] + // else [] + +let generateIntegerAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (int: Asn1AcnAst.Integer) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + // If `tasInfo` is Some, then there is a pair of encode/decode functions that are generated wrapping a call to encode/decode the integer + // In such cases, we generate a "read prefix" lemma that is just an application of the appropriate ACN integer lemma + [] + // if enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaInteger enc t nestingScope int] + // else [] let generateSequenceOfLikeProof (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = None @@ -1850,20 +2067,17 @@ let generateOptionalPrefixLemma (enc: Asn1Encoding) (soc: SequenceOptionalChild) let c2 = {Var.name = "c2"; tpe = ClassType codecTpe} // The `existVar` does not exist for always present/absent let existVar = soc.existVar |> Option.map (fun v -> {Var.name = v; tpe = BooleanType}) - let sizeExpr = longlit soc.child.Type.Kind.baseKind.acnMaxSizeInBits + let sz = {Var.name = "sz"; tpe = IntegerType Long} + let maxSizeExpr = longlit soc.child.Type.Kind.baseKind.acnMaxSizeInBits let preconds = [ Precond (Equals (selBufLength (Var c1), selBufLength (Var c2))) - Precond (validateOffsetBitsACN (Var c1) sizeExpr) + Precond (validateOffsetBitsACN (Var c1) maxSizeExpr) + Precond (And [Leq (longlit 0I, Var sz); Leq (Var sz, maxSizeExpr)]) Precond (arrayBitRangesEq (selBuf (Var c1)) (selBuf (Var c2)) (longlit 0I) - (plus [ - bitIndexACN (Var c1) - existVar |> - Option.map (fun exist -> IfExpr {cond = Var exist; thn = sizeExpr; els = longlit 0I}) |> - Option.defaultValue sizeExpr - ]) + (plus [bitIndexACN (Var c1); Var sz]) ) ] let elemTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind @@ -1894,9 +2108,15 @@ let generateOptionalPrefixLemma (enc: Asn1Encoding) (soc: SequenceOptionalChild) let c1Cpy = {Var.name = "c1Cpy"; tpe = ClassType codecTpe} let c2ResetCpy = {Var.name = "c2ResetCpy"; tpe = ClassType codecTpe} - let underlyingPrefixLemma = readPrefixLemmaIdentifier (Asn1 soc.child.Type.Kind.baseKind) soc.child.Type.id false + let underlyingPrefixLemma = readPrefixLemmaIdentifier (Asn1 soc.child.Type.toAsn1AcnAst) soc.child.Type.id false let c1Recv, c2Recv = selectCodecReadPrefixLemma underlyingPrefixLemma (Var c1) (Var c2) - let underlyingPrefixLemmaCall = FunctionCall {prefix = underlyingPrefixLemma.prefix; id = underlyingPrefixLemma.id; tps = []; args = [c1Recv; c2Recv] @ underlyingPrefixLemma.extraArgs} + let underlyingPrefixLemmaCall = + match underlyingPrefixLemma with + | PrimitivePrefixLemma info -> + FunctionCall {prefix = info.prefix; id = info.id; tps = []; args = [c1Recv; c2Recv] @ info.extraConstArgs} + | ComposedPrefixLemma info -> + FunctionCall {prefix = []; id = info.id; tps = []; args = [c1Recv; c2Recv] @ [Var sz]} + let body = (letsIn [ (c1Cpy, Snapshot (Var c1)) (c2ResetCpy, Snapshot (Var c2Reset)) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index a370c99af..2d209af29 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -243,8 +243,7 @@ object BitStream { @ghost @pure @opaque @inlineOnce def readBytePrefixLemma(bs1: BitStream, bs2: BitStream): Unit = { require(bs1.buf.length == bs2.buf.length) - require(BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 8 <= bs1.buf.length.toLong * 8L) - require(BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 8 <= BitStream.bitIndex(bs2.buf.length, bs2.currentByte, bs2.currentBit )) + require(bs1.validate_offset_bits(8)) require(arrayBitRangesEq( bs1.buf, bs2.buf, diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index 9c5ca030c..ca2b9c403 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -199,8 +199,8 @@ case class Codec(bitStream: BitStream) { ghostExpr { val nBits = GetBitCountUnsigned(v) val w2 = this - assert( w1.bitStream.buf.length == w2.bitStream.buf.length - && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits + assert( w1.bitStream.buf.length == w2.bitStream.buf.length + && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits && w1.isPrefixOf(w2) ) val (r1, r2) = reader(w1, w2) @@ -213,7 +213,7 @@ case class Codec(bitStream: BitStream) { val w1 = old(this) val w2 = this val nBits = GetBitCountUnsigned(v) - w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits + w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) @@ -229,7 +229,6 @@ case class Codec(bitStream: BitStream) { * @return Unsigned integer with nBits decoded from bitstream. * */ - // @opaque @inlineOnce def decodeUnsignedInteger(nBits: Int): ULong = { require(nBits >= 0 && nBits <= NO_OF_BITS_IN_LONG) require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nBits)) @@ -379,7 +378,7 @@ case class Codec(bitStream: BitStream) { val range = stainless.math.wrapping(max - min) val nBits = GetBitCountUnsigned(range.toRawULong) w1.bitStream.buf.length == w2.bitStream.buf.length - && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits + && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits && w1.isPrefixOf(w2) && { @@ -548,14 +547,14 @@ case class Codec(bitStream: BitStream) { check(vGot == v) } - }.ensuring(_ => + }.ensuring(_ => val w1 = old(this) val w2 = this val encV: ULong = stainless.math.wrapping(v - min).toRawULong val nBits = GetLengthForEncodingUnsigned(stainless.math.wrapping(v - min).toRawULong) * 8L + 8L - buf.length == old(this).buf.length + buf.length == old(this).buf.length &&& BitStream.bitIndex(this.bitStream.buf.length, this.bitStream.currentByte, this.bitStream.currentBit) == BitStream.bitIndex(old(this).bitStream.buf.length, old(this).bitStream.currentByte, old(this).bitStream.currentBit) + GetLengthForEncodingUnsigned(stainless.math.wrapping(v - min).toRawULong) * 8L + 8L - &&& w1.isPrefixOf(w2) + &&& w1.isPrefixOf(w2) &&& { val (r1, r2) = reader(w1, w2) BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) @@ -667,10 +666,10 @@ case class Codec(bitStream: BitStream) { readNLSBBitsMSBFirst(nBits).toRawULong } val res: ULong = ULong.fromRaw(v + min) - if(res < min) then + if(res < min) then assert(ULong.fromRaw(-1L) >= min) - ULong.fromRaw(Long.MaxValue) - else + ULong.fromRaw(Long.MaxValue) + else assert(res >= min) res }//.ensuring(res => min <= res) @@ -703,7 +702,7 @@ case class Codec(bitStream: BitStream) { @ghost val this2 = snapshot(this) // encode number appendLSBBitsMSBFirst(v & onesLSBLong(nBits), nBits) - + ghostExpr { BitStream.lemmaIsPrefixTransitive(this1.bitStream, this2.bitStream, this.bitStream) val this2Reset = this2.bitStream.resetAt(this1.bitStream) @@ -722,7 +721,7 @@ case class Codec(bitStream: BitStream) { val w1 = old(this) val w2 = this val nBits = NO_OF_BITS_IN_BYTE + GetLengthForEncodingSigned(v) * NO_OF_BITS_IN_BYTE - w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits + w1.bitStream.buf.length == w2.bitStream.buf.length && BitStream.bitIndex(w2.bitStream.buf.length, w2.bitStream.currentByte, w2.bitStream.currentBit) == BitStream.bitIndex(w1.bitStream.buf.length, w1.bitStream.currentByte, w1.bitStream.currentBit) + nBits && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) @@ -787,9 +786,9 @@ case class Codec(bitStream: BitStream) { /** * Facade function for real encoding - * + * * Unused in PUS-C - * + * * @param vValDouble real input in IEEE754 double format */ @extern @@ -841,8 +840,8 @@ case class Codec(bitStream: BitStream) { * |1|S|0|0|a|b|c|d| * +-+-+-+-+-+-+-+-+ * - * - * + * + * */ private def encodeRealBitString(vVal: Long): Unit = { // Require from CalculateMantissaAndExponent diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 45fec0217..487300dec 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -26,7 +26,75 @@ object ACN { (ACN(Codec(r1)), ACN(Codec(r2))) } - // For showing invertibility of encoding - not fully integrated yet + // TODO: Placeholder + def readPrefixLemma_TODO(acn1: ACN, acn2: ACN): Unit = () + + @ghost @pure @opaque @inlineOnce + def dec_Int_TwosComplement_ConstSize_8_prefixLemma(acn1: ACN, acn2: ACN): Unit = { + require(acn1.base.bitStream.buf.length == acn2.base.bitStream.buf.length) + require(acn1.base.bitStream.validate_offset_bits(8)) + require(arrayBitRangesEq( + acn1.base.bitStream.buf, + acn2.base.bitStream.buf, + 0, + acn1.base.bitStream.bitIndex + 8 + )) + + val acn2Reset = acn2.resetAt(acn1) + val (acn1Res, b1) = acn1.dec_Int_TwosComplement_ConstSize_8_pure() + val (acn2Res, b2) = acn2Reset.dec_Int_TwosComplement_ConstSize_8_pure() + + { + BitStream.readBytePrefixLemma(acn1.base.bitStream, acn2.base.bitStream) + }.ensuring { _ => + acn1Res.base.bitStream.bitIndex == acn2Res.base.bitStream.bitIndex && b1 == b2 + } + } + + @ghost @pure @opaque @inlineOnce + def dec_Int_PositiveInteger_ConstSize_8_prefixLemma(acn1: ACN, acn2: ACN): Unit = { + require(acn1.base.bitStream.buf.length == acn2.base.bitStream.buf.length) + require(acn1.base.bitStream.validate_offset_bits(8)) + require(arrayBitRangesEq( + acn1.base.bitStream.buf, + acn2.base.bitStream.buf, + 0, + acn1.base.bitStream.bitIndex + 8 + )) + + val acn2Reset = acn2.resetAt(acn1) + val (acn1Res, b1) = acn1.dec_Int_PositiveInteger_ConstSize_8_pure() + val (acn2Res, b2) = acn2Reset.dec_Int_PositiveInteger_ConstSize_8_pure() + + { + BitStream.readBytePrefixLemma(acn1.base.bitStream, acn2.base.bitStream) + }.ensuring { _ => + acn1Res.base.bitStream.bitIndex == acn2Res.base.bitStream.bitIndex && b1 == b2 + } + } + + @ghost @pure @opaque @inlineOnce + def dec_Int_PositiveInteger_ConstSize_prefixLemma(acn1: ACN, acn2: ACN, nBits: Int): Unit = { + require(0 <= nBits && nBits <= 64) + require(acn1.base.bitStream.buf.length == acn2.base.bitStream.buf.length) + require(acn1.base.bitStream.validate_offset_bits(nBits)) + require(arrayBitRangesEq( + acn1.base.bitStream.buf, + acn2.base.bitStream.buf, + 0, + acn1.base.bitStream.bitIndex + nBits + )) + + val acn2Reset = acn2.resetAt(acn1) + val (acn1Res, l1) = acn1.dec_Int_PositiveInteger_ConstSize_pure(nBits) + val (acn2Res, l2) = acn2Reset.dec_Int_PositiveInteger_ConstSize_pure(nBits) + + { + BitStream.readNLeastSignificantBitsPrefixLemma(acn1.base.bitStream, acn2.base.bitStream, nBits) + }.ensuring { _ => + acn1Res.base.bitStream.bitIndex == acn2Res.base.bitStream.bitIndex && l1 == l2 + } + } @ghost @pure @opaque @inlineOnce def dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma(acn1: ACN, acn2: ACN): Unit = { From 01411c4cc15a6c2868957b92e9226cd43f7b5d3e Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Fri, 9 Aug 2024 09:35:00 +0200 Subject: [PATCH 21/35] More on prefix lemma proofs --- BackendAst/DAstACN.fs | 25 +++- BackendAst/DAstUPer.fs | 6 +- CommonTypes/CommonTypes.fs | 40 +++++- FrontEndAst/Language.fs | 14 +- StgScala/LangGeneric_scala.fs | 12 ++ StgScala/ProofGen.fs | 249 ++++++++++++++++++++++++++-------- 6 files changed, 275 insertions(+), 71 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index f45795b61..0036d3437 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -647,7 +647,16 @@ let createEnumCommon (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTyp let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (defOrRef:TypeDefinitionOrReference) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = let typeDefinitionName = defOrRef.longTypedefName2 lm.lg.hasModules //getTypeDefinitionName t.id.tasInfo typeDefinition - let funcBody = createEnumCommon r lm codec t.id o defOrRef typeDefinitionName icdStgFileName None t.acnMinSizeInBits t.acnMaxSizeInBits t.unitsOfMeasure + let funcBodyOrig = createEnumCommon r lm codec t.id o defOrRef typeDefinitionName icdStgFileName None t.acnMinSizeInBits t.acnMaxSizeInBits t.unitsOfMeasure + let funcBody (errCode: ErrorCode) + (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) + (nestingScope: NestingScope) + (p: CallerScope) = + let res = funcBodyOrig errCode acnArgs nestingScope p + res |> Option.map (fun res -> + let aux = lm.lg.generateEnumAuxiliaries ACN t o nestingScope p.arg codec + {res with auxiliaries = res.auxiliaries @ aux}) + let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us @@ -827,13 +836,14 @@ let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = let pp, resultExpr = adaptArgument lm codec p let nullType = lm.acn.Null_pattern + let aux = lm.lg.generateNullTypeAuxiliaries ACN t o nestingScope p.arg codec match o.acnProperties.encodingPattern with | None -> match codec, lm.lg.decodingKind with | Decode, Copy -> // Copy-decoding backend expect all values to be declared even if they are "dummies" - Some ({AcnFuncBodyResult.funcBody = lm.acn.Null_declare pp; errCodes = []; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=Some pp; typeEncodingKind = Some (AcnNullEncodingType None); auxiliaries=[]; icdResult=None}) + Some ({AcnFuncBodyResult.funcBody = lm.acn.Null_declare pp; errCodes = []; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=Some pp; typeEncodingKind = Some (AcnNullEncodingType None); auxiliaries=aux; icdResult=None}) | _ -> None | Some encPattern -> let arrsBits, arrBytes, nBitsSize = @@ -851,7 +861,7 @@ let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - Some ({AcnFuncBodyResult.funcBody = ret; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= lm.lg.acn.null_valIsUnReferenced; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnNullEncodingType (Some encPattern)); auxiliaries=[]; icdResult = Some icd}) + Some ({AcnFuncBodyResult.funcBody = ret; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= lm.lg.acn.null_valIsUnReferenced; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnNullEncodingType (Some encPattern)); auxiliaries=aux; icdResult = Some icd}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us @@ -1021,7 +1031,8 @@ let createAcnStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF InternalItem_string_with_alpha pp errCode.errCodeName td i (BigInteger (o.uperCharSet.Length-1)) arrAsciiCodes (BigInteger (o.uperCharSet.Length)) nBits codec let nSizeInBits = GetNumberOfBitsForNonNegativeInteger (o.maxSize.uper - o.minSize.uper) let sqfProofGen = { - SequenceOfLikeProofGen.acnOuterMaxSize = nestingScope.acnOuterMaxSize + SequenceOfLikeProofGen.t = Asn1TypeOrAcnRefIA5.AcnRefIA5 t + acnOuterMaxSize = nestingScope.acnOuterMaxSize uperOuterMaxSize = nestingScope.uperOuterMaxSize nestingLevel = nestingScope.nestingLevel nestingIx = nestingScope.nestingIx @@ -1275,7 +1286,8 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted let childNestingScope = {nestingScope with nestingLevel = nestingScope.nestingLevel + 1I; parents = (p, t) :: nestingScope.parents} let internalItem, ns = chFunc.funcBody us acnArgs childNestingScope ({p with arg = lm.lg.getArrayItem p.arg i child.isIA5String}) let sqfProofGen = { - SequenceOfLikeProofGen.acnOuterMaxSize = nestingScope.acnOuterMaxSize + SequenceOfLikeProofGen.t = Asn1TypeOrAcnRefIA5.Asn1 t + acnOuterMaxSize = nestingScope.acnOuterMaxSize uperOuterMaxSize = nestingScope.uperOuterMaxSize nestingLevel = nestingScope.nestingLevel nestingIx = nestingScope.nestingIx @@ -2417,7 +2429,8 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel choice_Enum pp access childrenStatements extField errCode.errCodeName codec, resultExpr | CEC_presWhen -> choice_preWhen pp access childrenStatements errCode.errCodeName codec, resultExpr let choiceContent = lm.lg.generateChoiceProof ACN t o choiceContent p.arg codec - Some ({AcnFuncBodyResult.funcBody = choiceContent; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (ChoiceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries; icdResult = Some icd}), ns + let aux = lm.lg.generateChoiceAuxiliaries ACN t o nestingScope p.arg codec + Some ({AcnFuncBodyResult.funcBody = choiceContent; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (ChoiceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries@aux; icdResult = Some icd}), ns let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) diff --git a/BackendAst/DAstUPer.fs b/BackendAst/DAstUPer.fs index 93cd2312b..4bd109e7a 100644 --- a/BackendAst/DAstUPer.fs +++ b/BackendAst/DAstUPer.fs @@ -455,7 +455,8 @@ let createIA5StringFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Co let pp, resultExpr = joinedOrAsIdentifier lm codec p let sqfProofGen = { - SequenceOfLikeProofGen.acnOuterMaxSize = nestingScope.acnOuterMaxSize + SequenceOfLikeProofGen.t = Asn1TypeOrAcnRefIA5.Asn1 t + acnOuterMaxSize = nestingScope.acnOuterMaxSize uperOuterMaxSize = nestingScope.uperOuterMaxSize nestingLevel = nestingScope.nestingLevel nestingIx = nestingScope.nestingIx @@ -616,7 +617,8 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C let internalItem = chFunc.funcBody childNestingScope chp fromACN let sqfProofGen = { - SequenceOfLikeProofGen.acnOuterMaxSize = nestingScope.acnOuterMaxSize + SequenceOfLikeProofGen.t = Asn1TypeOrAcnRefIA5.Asn1 t + acnOuterMaxSize = nestingScope.acnOuterMaxSize uperOuterMaxSize = nestingScope.uperOuterMaxSize nestingLevel = nestingScope.nestingLevel nestingIx = nestingScope.nestingIx diff --git a/CommonTypes/CommonTypes.fs b/CommonTypes/CommonTypes.fs index e1cb35903..59a5ea3e1 100644 --- a/CommonTypes/CommonTypes.fs +++ b/CommonTypes/CommonTypes.fs @@ -505,7 +505,7 @@ type ReferenceToType with match this with | ReferenceToType path -> match path with - | (MD _) :: (TA _) :: path -> select path + | (MD _) :: (TA _) :: path -> select path | _ -> select path member this.tasInfo = @@ -642,7 +642,11 @@ and FE_PrimitiveTypeDefinition = { typeName : string //e.g. MyInt, Asn1SccInt, Asn1SccUInt programUnit : string //the program unit where this type is defined kind : FE_PrimitiveTypeDefinitionKind -} +} with + member this.dealiased: FE_PrimitiveTypeDefinition = + match this.kind with + | PrimitiveNewSubTypeDefinition sub -> sub.dealiased + | _ -> this type FE_NonPrimitiveTypeDefinitionKind<'SUBTYPE> = | NonPrimitiveNewTypeDefinition //type @@ -680,6 +684,11 @@ with | true when this.programUnit = callerProgramUnit -> this | true -> {this with typeName = z this.typeName; encoding_range = z this.encoding_range; index = z this.index; alpha = z this.alpha; alpha_set = z this.alpha_set; alpha_index = z this.alpha_index} + member this.dealiased: FE_StringTypeDefinition = + match this.kind with + | NonPrimitiveNewSubTypeDefinition sub -> sub.dealiased + | _ -> this + type FE_SizeableTypeDefinition = { asn1Name : string asn1Module : string option @@ -698,6 +707,11 @@ with | true when this.programUnit = callerProgramUnit -> this | true -> {this with typeName = z this.typeName; index = z this.index; array = z this.array; length_index = z this.length_index} + member this.dealiased: FE_SizeableTypeDefinition = + match this.kind with + | NonPrimitiveNewSubTypeDefinition sub -> sub.dealiased + | _ -> this + type FE_SequenceTypeDefinition = { asn1Name : string asn1Module : string option @@ -715,6 +729,11 @@ with | true when this.programUnit = callerProgramUnit -> this | true -> {this with typeName = z this.typeName; exist = z this.exist} + member this.dealiased: FE_SequenceTypeDefinition = + match this.kind with + | NonPrimitiveNewSubTypeDefinition sub -> sub.dealiased + | _ -> this + type FE_ChoiceTypeDefinition = { asn1Name : string asn1Module : string option @@ -733,6 +752,11 @@ with | true when this.programUnit = callerProgramUnit -> this | true -> {this with typeName = z this.typeName; index_range = z this.index_range; selection = z this.selection} + member this.dealiased: FE_ChoiceTypeDefinition = + match this.kind with + | NonPrimitiveNewSubTypeDefinition sub -> sub.dealiased + | _ -> this + type FE_EnumeratedTypeDefinition = { asn1Name : string asn1Module : string option @@ -754,6 +778,10 @@ with | true when this.programUnit = callerProgramUnit -> this | true -> {this with typeName = z this.typeName; index_range = z this.index_range} + member this.dealiased: FE_EnumeratedTypeDefinition = + match this.kind with + | NonPrimitiveNewSubTypeDefinition sub -> sub.dealiased + | _ -> this type FE_TypeDefinition = | FE_PrimitiveTypeDefinition of FE_PrimitiveTypeDefinition @@ -797,6 +825,14 @@ type FE_TypeDefinition = | FE_ChoiceTypeDefinition a -> a.kind.BaseKind | FE_EnumeratedTypeDefinition a -> a.kind.BaseKind + member this.dealiased = + match this with + | FE_PrimitiveTypeDefinition t -> FE_PrimitiveTypeDefinition t.dealiased + | FE_SequenceTypeDefinition t -> FE_SequenceTypeDefinition t.dealiased + | FE_StringTypeDefinition t -> FE_StringTypeDefinition t.dealiased + | FE_SizeableTypeDefinition t -> FE_SizeableTypeDefinition t.dealiased + | FE_ChoiceTypeDefinition t -> FE_ChoiceTypeDefinition t.dealiased + | FE_EnumeratedTypeDefinition t -> FE_EnumeratedTypeDefinition t.dealiased member this.asn1Name = match this with diff --git a/FrontEndAst/Language.fs b/FrontEndAst/Language.fs index a29d67a93..d17b51f60 100644 --- a/FrontEndAst/Language.fs +++ b/FrontEndAst/Language.fs @@ -170,8 +170,13 @@ with | SqOf sqf -> sqf.isFixedSize | StrType st -> st.isFixedSize +type Asn1TypeOrAcnRefIA5 = +| Asn1 of Asn1AcnAst.Asn1Type +| AcnRefIA5 of Asn1AcnAst.AcnReferenceToIA5String + // TODO: rename type SequenceOfLikeProofGen = { + t: Asn1TypeOrAcnRefIA5 acnOuterMaxSize: bigint uperOuterMaxSize: bigint nestingLevel: bigint @@ -339,8 +344,11 @@ type ILangGeneric () = abstract member generateSequenceAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list abstract member generateIntegerAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Integer -> NestingScope -> Selection -> Codec -> string list abstract member generateSequenceOfLikeAuxiliaries: Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> string list * string option - // TODO: Bad name abstract member generateOptionalAuxiliaries: Asn1Encoding -> SequenceOptionalChild -> Codec -> string list * string + abstract member generateChoiceAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Choice -> NestingScope -> Selection -> Codec -> string list + abstract member generateNullTypeAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.NullType -> NestingScope -> Selection -> Codec -> string list + abstract member generateEnumAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Enumerated -> NestingScope -> Selection -> Codec -> string list + abstract member generatePrecond: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Codec -> string list abstract member generatePostcond: Asn1Encoding -> funcNameBase: string -> p: CallerScope -> t: Asn1AcnAst.Asn1Type -> Codec -> string option abstract member generateSequenceChildProof: Asn1Encoding -> stmts: string option list -> SequenceProofGen -> Codec -> string list @@ -378,6 +386,10 @@ type ILangGeneric () = default this.generateOptionalAuxiliaries _ soc _ = // By default, languages do not have wrapped optional and have an `exist` field: they "attach" the child field themselves [], soc.childBody {soc.p with arg = soc.p.arg.dropLast} soc.existVar + default this.generateChoiceAuxiliaries _ _ _ _ _ _ = [] + default this.generateNullTypeAuxiliaries _ _ _ _ _ _ = [] + default this.generateEnumAuxiliaries _ _ _ _ _ _ = [] + default this.generatePrecond _ _ _ = [] default this.generatePostcond _ _ _ _ _ = None default this.generateSequenceChildProof _ stmts _ _ = stmts |> List.choose id diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index fcfbd165f..50c9a8b77 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -335,6 +335,18 @@ type LangGeneric_scala() = let innerFns = fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) innerFns, show (ExprTree call) + override this.generateChoiceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (ch: Asn1AcnAst.Choice) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateChoiceAuxiliaries enc t ch nestingScope sel codec + fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) + + override this.generateNullTypeAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nt: Asn1AcnAst.NullType) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateNullTypeAuxiliaries enc t nt nestingScope sel codec + fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) + + override this.generateEnumAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (enm: Asn1AcnAst.Enumerated) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateEnumAuxiliaries enc t enm nestingScope sel codec + fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) + override this.adaptAcnFuncBody (funcBody: AcnFuncBody) (isValidFuncName: string option) (t: Asn1AcnAst.Asn1Type) (codec: Codec): AcnFuncBody = let shouldWrap = match t.Kind with diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index a694b213b..6fc1d1f6b 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -434,6 +434,20 @@ and choiceSizeExpr (choice: Asn1AcnAst.Choice) ) {bdgs = []; resSize = MatchExpr {scrut = obj; cases = cases}} +let optionalSizeExpr (child: Asn1AcnAst.Asn1Child) + (obj: Expr) + (offset: Expr) + (nestingLevel: bigint) + (nestingIx: bigint): SizeExprRes = + let sz = + match child.Type.Kind with + | Choice _ | Sequence _ | SequenceOf _ -> + {bdgs = []; resSize = callSize (getMutExpr obj) offset} + | _ -> asn1SizeExpr child.Type.acnAlignment child.Type.Kind (getMutExpr obj) offset nestingLevel nestingIx + match child.Optionality with + | Some AlwaysPresent -> sz + | Some AlwaysAbsent -> {sz with resSize = longlit 0I} + | _ -> {sz with resSize = IfExpr {cond = isDefinedMutExpr obj; thn = sz.resSize; els = longlit 0I}} let seqSizeFunDefs (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence): FunDef list = @@ -901,7 +915,11 @@ let rec tryFindFirstParentACNDependency (parents: Asn1AcnAst.Asn1Type list) (dep match parent.ActualType.Kind with | Sequence _ -> let directAcns = collectNestedAcnChildren parent.Kind - directAcns |> List.tryFind (fun acn -> List.endsWith acn.id.fieldPath dep.asStringList) |> + assert (directAcns |> List.forall (fun acn -> List.isPrefixOf parent.id.ToScopeNodeList acn.id.ToScopeNodeList)) + directAcns |> List.tryFind (fun acn -> + let suffix = ReferenceToType (acn.id.ToScopeNodeList |> List.skip parent.id.ToScopeNodeList.Length) + List.endsWith suffix.fieldPath dep.asStringList + ) |> Option.map (fun acn -> parent, acn) |> Option.orElse (tryFindFirstParentACNDependency rest dep) | _ -> tryFindFirstParentACNDependency rest dep @@ -918,9 +936,9 @@ let rec firstOutermostSeqParent (parents: Asn1AcnAst.Asn1Type list): Asn1AcnAst. // * In case this is a Sequence, the corresponding decoded ACN inserted field, stored in a local variable // In both cases, the variable names are the same, so we can (ab)use this fact and not worry from where // we got the ACN dependency. -let acnExternDependenciesVariableDecode (t: Asn1AcnAst.Asn1Type) (nestingScope: NestingScope): Var list = +let acnExternDependenciesVariableDecode (t: Asn1AcnAst.Asn1Type) (parents: Asn1AcnAst.Asn1Type list): Var list = t.externalDependencies |> List.map (fun dep -> - let acnDep = tryFindFirstParentACNDependency (nestingScope.parents |> List.map snd) dep + let acnDep = tryFindFirstParentACNDependency parents dep assert acnDep.IsSome let _, acnParam = acnDep.Value let nme = ToC (acnParam.id.dropModule.AcnAbsPath.StrJoin "_") @@ -1015,7 +1033,7 @@ let readPrefixLemmaIdentifier (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) | _ -> failwith $"TODO: {encCls}" if isOptional then - ComposedPrefixLemma {id = $"{ToC id.dropModule.AsString}_prefixLemma"} + ComposedPrefixLemma {id = $"{ToC id.dropModule.AsString}_Optional_prefixLemma"} else match t with | Asn1 t -> @@ -1023,10 +1041,20 @@ let readPrefixLemmaIdentifier (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) | Integer int -> PrimitivePrefixLemma (forIntClass int.intClass int.acnEncodingClass int.uperRange) | Boolean _ -> PrimitivePrefixLemma {prefix = [bitStreamId]; id = "readBitPrefixLemma"; extraConstArgs = []} | ReferenceType rt -> - let id = - if rt.hasExtraConstrainsOrChildrenOrAcnArgs then $"{ToC id.dropModule.AsString}_prefixLemma" - else $"{t.FT_TypeDefinition.[Scala].typeName}_prefixLemma" - ComposedPrefixLemma {id = id} + match rt.resolvedType.ActualType.Kind with + | BitString _ -> + // TODO: Why don't we have a wrapper function for bitstrings? + PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO + | IA5String str -> + match str.acnEncodingClass with + | Acn_Enc_String_uPER _ -> ComposedPrefixLemma {id = $"{t.ActualType.FT_TypeDefinition.[Scala].typeName}_prefixLemma"} + | _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO + | OctetString _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO + | _ -> + let id = + if rt.hasExtraConstrainsOrChildrenOrAcnArgs then $"{ToC id.dropModule.AsString}_prefixLemma" + else $"{t.ActualType.FT_TypeDefinition.[Scala].typeName}_prefixLemma" + ComposedPrefixLemma {id = id} | _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO | Acn (AcnInteger int) -> PrimitivePrefixLemma (forIntClass int.intClass int.acnEncodingClass int.uperRange) | Acn (AcnBoolean _) -> PrimitivePrefixLemma {prefix = [bitStreamId]; id = "readBitPrefixLemma"; extraConstArgs = []} @@ -1064,16 +1092,20 @@ type PrefixLemmaData = { subPat2: Pattern } -let generatePrefixLemma (enc: Asn1Encoding) - (t: Asn1AcnAst.Asn1Type) - (nestingScope: NestingScope) - (mkProof: PrefixLemmaData -> Expr): FunDef = +let generatePrefixLemmaCommon (enc: Asn1Encoding) + (tpe: Type) + (maxSize: bigint) + (baseId: string) + (paramsAcn: Var list) + (acnTps: Type list) + (mkSizeExpr: Var -> Var -> SizeExprRes) + (nestingScope: NestingScope) + (mkProof: PrefixLemmaData -> Expr): FunDef = let codecTpe = runtimeCodecTypeFor enc let c1 = {Var.name = "c1"; tpe = ClassType codecTpe} let c2 = {Var.name = "c2"; tpe = ClassType codecTpe} let sz = {Var.name = "sz"; tpe = IntegerType Long} - let tpe = fromAsn1TypeKind t.Kind - let maxSizeExpr = longlit t.Kind.acnMaxSizeInBits + let maxSizeExpr = longlit maxSize let preconds = [ Precond (Equals (selBufLength (Var c1), selBufLength (Var c2))) Precond (validateOffsetBitsACN (Var c1) maxSizeExpr) @@ -1085,17 +1117,6 @@ let generatePrefixLemma (enc: Asn1Encoding) (plus [bitIndexACN (Var c1); Var sz]) ) ] - let isTopLevel = nestingScope.parents.IsEmpty - let paramsAcn, acnTps = - if isTopLevel then [], [] - else - let paramsAcn = acnExternDependenciesVariableDecode t nestingScope - let acns = collectNestedAcnChildren t.Kind - let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) - paramsAcn, acnTps - let baseId = - if isTopLevel then t.FT_TypeDefinition.[Scala].typeName - else ToC t.id.dropModule.AsString let decodeId = $"{baseId}_ACN_Decode" let decodePureId = $"{decodeId}_pure" let c2Reset = {Var.name = "c2Reset"; tpe = ClassType codecTpe} @@ -1139,7 +1160,7 @@ let generatePrefixLemma (enc: Asn1Encoding) subPat1, subPat2 let acnsEq = List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2)) - let v1SizeExpr = asn1SizeExpr t.acnAlignment t.Kind (Var v1) (bitIndexACN (Var c1)) 0I 0I + let v1SizeExpr = mkSizeExpr v1 c1 let v1SizeVar = {Var.name = "v1Size"; tpe = IntegerType Long} let prop = let prop = And ([Equals (bitIndexACN (Var c1Res), bitIndexACN (Var c2Res)); Equals (Var v1, Var v2)] @ acnsEq) @@ -1210,13 +1231,85 @@ let generatePrefixLemma (enc: Asn1Encoding) body = proof } + +let generatePrefixLemma (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (mkProof: PrefixLemmaData -> Expr): FunDef = + let tpe = fromAsn1TypeKind t.Kind + let isTopLevel = nestingScope.parents.IsEmpty + let paramsAcn, acnTps = + if isTopLevel then [], [] + else + let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) + let acns = collectNestedAcnChildren t.Kind + let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) + paramsAcn, acnTps + let baseId = + if isTopLevel then t.FT_TypeDefinition.[Scala].typeName + else ToC t.id.dropModule.AsString + let mkSizeExpr = fun v1 c1 -> asn1SizeExpr t.acnAlignment t.Kind (Var v1) (bitIndexACN (Var c1)) 0I 0I + generatePrefixLemmaCommon enc tpe t.acnMaxSizeInBits baseId paramsAcn acnTps mkSizeExpr nestingScope mkProof + let generatePrefixLemmaInteger (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nestingScope: NestingScope) (int: Integer): FunDef = - let mkIntProof (data: PrefixLemmaData): Expr = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaChoice (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (ch: Asn1AcnAst.Choice): FunDef = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaNullType (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (nt: Asn1AcnAst.NullType): FunDef = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaEnum (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (enm: Asn1AcnAst.Enumerated): FunDef = + let mkProof (data: PrefixLemmaData): Expr = UnitLit // TODO - generatePrefixLemma enc t nestingScope mkIntProof + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaSequenceOfLike (enc: Asn1Encoding) + (t: Asn1TypeOrAcnRefIA5) + (nestingScope: NestingScope) + (sqf: SequenceOfLike): FunDef = + let mkSqOfLikeProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + let tpe = fromSequenceOfLike sqf + let mkSizeExpr = + // TODO: Alignment? + match sqf with + | SqOf _ -> fun v1 c1 -> {bdgs = []; resSize = callSize (Var v1) (bitIndexACN (Var c1))} + | _ -> + let maxElemSz = sqf.maxElemSizeInBits enc + fun v1 _ -> {bdgs = []; resSize = Mult (longlit maxElemSz, vecSize (Var v1))} + let baseId, paramsAcn, acnTps = + match t with + | Asn1TypeOrAcnRefIA5.Asn1 t -> + let isTopLevel = nestingScope.parents.IsEmpty + let baseId = + if isTopLevel then t.FT_TypeDefinition.[Scala].typeName + else ToC t.id.dropModule.AsString + let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) + let acns = collectNestedAcnChildren t.Kind + let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) + baseId, paramsAcn, acnTps + | Asn1TypeOrAcnRefIA5.AcnRefIA5 t -> ToC t.tasName.Value, [], [] // TODO: RM + generatePrefixLemmaCommon enc tpe (sqf.maxSizeInBits enc) baseId paramsAcn acnTps mkSizeExpr nestingScope mkSqOfLikeProof let generatePrefixLemmaSequence (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) @@ -1280,16 +1373,21 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) Assert (arrayBitRangesEq (selBuf (Var c1)) (selBuf (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) ] - let asn1Tpe, id, isOpt, existArg = + let asn1Tpe, id, isOpt, existArg, paramsAcn = match child with | Asn1Child child -> let existArg = match child.Optionality with | Some (Optional _) -> - [isDefinedMutExpr (FieldSelect (Var data.decodingRes1, child._scala_name))] + [isDefinedMutExpr (FieldSelect (Var data.v1, child._scala_name))] + | _ -> [] + let paramsAcn = + match child.Type.Kind with + | ReferenceType rt when rt.hasExtraConstrainsOrChildrenOrAcnArgs -> + acnExternDependenciesVariableDecode child.Type (t :: (nestingScope.parents |> List.map snd)) | _ -> [] - Asn1 child.Type, child.Type.id, child.Optionality.IsSome, existArg - | AcnChild child -> Acn child.Type, child.id, false, [] + Asn1 child.Type, child.Type.id, child.Optionality.IsSome, existArg, paramsAcn + | AcnChild child -> Acn child.Type, child.id, false, [], [] let prefixLemmaInfo = readPrefixLemmaIdentifier asn1Tpe id isOpt let cdcSnapRecv, cdcRecv = selectCodecReadPrefixLemma prefixLemmaInfo (Var c1) (Var c2Moved) let prefixLemmaApp = @@ -1297,7 +1395,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | PrimitivePrefixLemma info -> FunctionCall {prefix = info.prefix; id = info.id; tps = []; args = [cdcSnapRecv; cdcRecv] @ existArg @ info.extraConstArgs} | ComposedPrefixLemma info -> - FunctionCall {prefix = []; id = info.id; tps = []; args = [cdcSnapRecv; cdcRecv] @ existArg @ [Var childSize]} + FunctionCall {prefix = []; id = info.id; tps = []; args = [cdcSnapRecv; cdcRecv] @ [Var childSize] @ existArg @ (paramsAcn |> List.map Var)} let proof = mkBlock [ slicedLemmaApp @@ -1308,7 +1406,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) { FunDef.id = $"proof_{ToC name}" - prms = if ix = 0 then [] else [c1; c2] + prms = if ix = 0 then paramsAcn else [c1; c2] @ paramsAcn annots = [Opaque; InlineOnce] specs = specs postcond = None // TODO @@ -1374,11 +1472,14 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) let recPVal = {Var.name = recSel.arg.receiverId; tpe = tpe} let precond = [Precond (validateOffsetBitsACN (Var cdc) (longlit t.acnMaxSizeInBits))] let isValidFuncName = $"{t.FT_TypeDefinition.[Scala].typeName}_IsConstraintValid" - + let baseId = + match t.ActualType.Kind with + // | SequenceOf _ -> t.FT_TypeDefinition.[Scala].typeName + | _ -> ToC t.id.dropModule.AsString // Computing external ACN dependencies for decoding // We also pass them to the encoding function because its postcondition // refers to the decoding function, which needs them - let paramsAcn = acnExternDependenciesVariableDecode t nestingScope + let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) // All ACN fields present in this SEQUENCE, including nested ones // Encoding functions will return them so that we can refer to them in the postcondition when calling the decoding function let acns = collectNestedAcnChildren t.Kind @@ -1404,7 +1505,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) let outermostPVal = {Var.name = "pVal"; tpe = fromAsn1TypeKind (nestingScope.parents |> List.last |> snd).Kind} let acnExtVars = acnExternDependenciesVariableEncode t nestingScope |> Option.toList let resPostcond = {Var.name = "res"; tpe = ClassType (eitherTpe errTpe retTpe)} - let decodePureId = $"{ToC t.id.dropModule.AsString}_ACN_Decode_pure" + let decodePureId = $"{baseId}_ACN_Decode_pure" let szRecv = {Var.name = recSel.arg.asLastOrSelf.receiverId; tpe = tpe} let sz = match t.Kind with @@ -1416,7 +1517,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) asn1SizeExpr t.acnAlignment t.Kind (Var szRecv) (bitIndexACN (Old (Var cdc))) 0I 0I let postcondExpr = generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits recSel.arg resPostcond acnTps sz [] decodePureId (paramsAcn |> List.map Var) let fd = { - id = $"{ToC t.id.dropModule.AsString}_ACN_Encode" + id = $"{baseId}_ACN_Encode" prms = [cdc; outermostPVal] @ acnExtVars @ paramsAcn @ [recPVal] specs = precond annots = [Opaque; InlineOnce] @@ -1515,7 +1616,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) } let fd = { - id = $"{ToC t.id.dropModule.AsString}_ACN_Decode" + id = $"{baseId}_ACN_Decode" prms = [cdc] @ paramsAcn specs = precond annots = [Opaque; InlineOnce] @@ -1550,7 +1651,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) varRes, FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var varCpy] @ (paramsAcn |> List.map Var)}] (mkTuple [Var varCpy; Var varRes])) { - FunDef.id = $"{ToC t.id.dropModule.AsString}_ACN_Decode_pure" + FunDef.id = $"{baseId}_ACN_Decode_pure" prms = [cdc] @ paramsAcn annots = [GhostAnnot; Pure] specs = precond @@ -1785,16 +1886,27 @@ let generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1 *) let generateSequenceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = - [] - // if enc = ACN && codec = Decode then [generatePrefixLemmaSequence enc t nestingScope sq] - // else [] + if enc = ACN && codec = Decode then [generatePrefixLemmaSequence enc t nestingScope sq] + else [] let generateIntegerAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (int: Asn1AcnAst.Integer) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = // If `tasInfo` is Some, then there is a pair of encode/decode functions that are generated wrapping a call to encode/decode the integer // In such cases, we generate a "read prefix" lemma that is just an application of the appropriate ACN integer lemma - [] - // if enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaInteger enc t nestingScope int] - // else [] + if enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaInteger enc t nestingScope int] + else [] + +let generateChoiceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (ch: Asn1AcnAst.Choice) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if enc = ACN && codec = Decode then [generatePrefixLemmaChoice enc t nestingScope ch] + else [] + +let generateNullTypeAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nt: Asn1AcnAst.NullType) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaNullType enc t nestingScope nt] + else [] + +let generateEnumAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (enm: Asn1AcnAst.Enumerated) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaEnum enc t nestingScope enm] + else [] + let generateSequenceOfLikeProof (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = None @@ -2059,9 +2171,33 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) | StrType _ -> mkBlock ((sizeLemmaCall |> Option.map Ghost |> Option.toList) @ [Var rightBdg]) letsIn [sqfVar, eitherMutMatchExpr scrut (Some leftBdg) leftBody (Some rightBdg) rightBody] (mkBlock []) let call = letsGhostIn [cdcBeforeLoop, Snapshot (Var cdc)] call - [fd], call + let prefixLemma = + match pg.t with + | Asn1TypeOrAcnRefIA5.Asn1 _ -> [generatePrefixLemmaSequenceOfLike enc pg.t pg.nestingScope sqf] + | Asn1TypeOrAcnRefIA5.AcnRefIA5 _ -> [] + fd :: prefixLemma, call let generateOptionalPrefixLemma (enc: Asn1Encoding) (soc: SequenceOptionalChild): FunDef = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + + // let isTopLevel = soc.nestingScope.parents.IsEmpty + // let paramsAcn, acnTps = + // if isTopLevel then [], [] + // else + let paramsAcn = acnExternDependenciesVariableDecode soc.child.toAsn1AcnAst.Type (soc.nestingScope.parents |> List.map snd) + // let acns = collectNestedAcnChildren soc.t.Kind + // let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) + // paramsAcn, acnTps + let baseId = $"{ToC soc.child.Type.id.dropModule.AsString}_Optional" + // The `existVar` does not exist for always present/absent + let existVar = soc.existVar |> Option.map (fun v -> {Var.name = v; tpe = BooleanType}) + let mkSizeExpr = fun v1 c1 -> optionalSizeExpr soc.child.toAsn1AcnAst (Var v1) (bitIndexACN (Var c1)) 0I 0I + let elemTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind + let tpe = ClassType (optionMutTpe elemTpe) + generatePrefixLemmaCommon enc tpe soc.child.Type.toAsn1AcnAst.acnMaxSizeInBits baseId ((existVar |> Option.toList) @ paramsAcn) [] mkSizeExpr soc.nestingScope mkProof + + (* let codecTpe = runtimeCodecTypeFor enc let c1 = {Var.name = "c1"; tpe = ClassType codecTpe} let c2 = {Var.name = "c2"; tpe = ClassType codecTpe} @@ -2129,14 +2265,15 @@ let generateOptionalPrefixLemma (enc: Asn1Encoding) (soc: SequenceOptionalChild) ])) { - FunDef.id = $"{ToC soc.child.Type.id.dropModule.AsString}_prefixLemma" - prms = [c1; c2] @ (existVar |> Option.toList) + FunDef.id = $"{ToC soc.child.Type.id.dropModule.AsString}_Optional_prefixLemma" + prms = [c1; c2] @ (existVar |> Option.toList) @ [sz] annots = [GhostAnnot; Pure; Opaque; InlineOnce] specs = preSpecs postcond = Some ({Var.name = "_"; tpe = UnitType}, postcond) returnTpe = UnitType body = body } + *) let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): FunDef list * Expr = if soc.child.Optionality.IsNone then [], EncDec (soc.childBody soc.p soc.existVar) @@ -2158,20 +2295,12 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) let isValidFuncName = soc.child.Type.Kind.isValidFunction |> Option.bind (fun vf -> vf.funcName) let sizeExprOf (recv: Expr): SizeExprRes = - let sz = - match childAsn1Tpe.Kind with - | Choice _ | Sequence _ | SequenceOf _ -> - {bdgs = []; resSize = callSize (getMutExpr recv) (bitIndexACN (Old (Var cdc)))} - | _ -> asn1SizeExpr childAsn1Tpe.acnAlignment childAsn1Tpe.Kind (getMutExpr recv) (bitIndexACN (Old (Var cdc))) 0I 0I - match soc.child.Optionality with - | Some AlwaysPresent -> sz - | Some AlwaysAbsent -> {sz with resSize = longlit 0I} - | _ -> {sz with resSize = IfExpr {cond = isDefinedMutExpr recv; thn = sz.resSize; els = longlit 0I}} + optionalSizeExpr soc.child.toAsn1AcnAst recv (bitIndexACN (Old (Var cdc))) 0I 0I // Computing external ACN dependencies for decoding // We also pass them to the encoding function because its postcondition // refers to the decoding function, which needs them - let paramsAcn = acnExternDependenciesVariableDecode soc.child.Type.toAsn1AcnAst soc.nestingScope + let paramsAcn = acnExternDependenciesVariableDecode soc.child.Type.toAsn1AcnAst (soc.nestingScope.parents |> List.map snd) match codec with | Encode -> @@ -2296,4 +2425,4 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) body = pureBody } let prefixLemma = generateOptionalPrefixLemma enc soc - [fd; fdPure], ret + [fd; fdPure; prefixLemma], ret From f16c5d92aff57837d45814b1ba9462f15d1bb46b Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Fri, 9 Aug 2024 12:52:23 +0200 Subject: [PATCH 22/35] Add an option to generate invertibility conditions and lemmas --- BackendAst/DAstACN.fs | 30 +++---- BackendAst/DAstUPer.fs | 14 +-- CommonTypes/CommonTypes.fs | 1 + FrontEndAst/Language.fs | 60 ++++++------- FrontEndAst/LspAst.fs | 3 +- StgScala/LangGeneric_scala.fs | 54 +++++------ StgScala/ProofGen.fs | 165 ++++++++++++++++++---------------- asn1scc/Program.fs | 52 ++++++----- 8 files changed, 197 insertions(+), 182 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index 0036d3437..7c8c1ab2c 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -272,11 +272,11 @@ let private createAcnFunction (r: Asn1AcnAst.AstRoot) (c_name: string): ((AcnFuncBodyResult option)*State) = let funcBody = handleSavePosition funcBody t.SaveBitStreamPosition c_name t.id lm codec let ret = handleAlignmentForAsn1Types r lm codec t.acnAlignment funcBody - let ret = lm.lg.adaptAcnFuncBody ret isValidFuncName t codec + let ret = lm.lg.adaptAcnFuncBody r ret isValidFuncName t codec ret st errCode prms nestingScope p let funcBody = handleAlignmentForAsn1Types r lm codec t.acnAlignment funcBody - let funcBody = lm.lg.adaptAcnFuncBody funcBody isValidFuncName t codec + let funcBody = lm.lg.adaptAcnFuncBody r funcBody isValidFuncName t codec let p : CallerScope = lm.lg.getParamType t codec let varName = p.arg.receiverId @@ -286,8 +286,8 @@ let private createAcnFunction (r: Asn1AcnAst.AstRoot) match funcNameAndtasInfo with | None -> None, None, [], None, ns | Some funcName -> - let precondAnnots = lm.lg.generatePrecond ACN t codec - let postcondAnnots = lm.lg.generatePostcond ACN funcNameBase p t codec + let precondAnnots = lm.lg.generatePrecond r ACN t codec + let postcondAnnots = lm.lg.generatePostcond r ACN funcNameBase p t codec let content, ns1a = funcBody ns errCode [] (NestingScope.init t.acnMaxSizeInBits t.uperMaxSizeInBits []) p let bodyResult_funcBody, errCodes, bodyResult_localVariables, bBsIsUnreferenced, bVarNameIsUnreferenced, auxiliaries, icdResult = match content with @@ -541,7 +541,7 @@ let createIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Comm (p: CallerScope) = let res = funcBodyOrig errCode acnArgs nestingScope p res |> Option.map (fun res -> - let aux = lm.lg.generateIntegerAuxiliaries ACN t o nestingScope p.arg codec + let aux = lm.lg.generateIntegerAuxiliaries r ACN t o nestingScope p.arg codec {res with auxiliaries = res.auxiliaries @ aux}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) @@ -654,7 +654,7 @@ let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (lm: (p: CallerScope) = let res = funcBodyOrig errCode acnArgs nestingScope p res |> Option.map (fun res -> - let aux = lm.lg.generateEnumAuxiliaries ACN t o nestingScope p.arg codec + let aux = lm.lg.generateEnumAuxiliaries r ACN t o nestingScope p.arg codec {res with auxiliaries = res.auxiliaries @ aux}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) @@ -836,7 +836,7 @@ let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = let pp, resultExpr = adaptArgument lm codec p let nullType = lm.acn.Null_pattern - let aux = lm.lg.generateNullTypeAuxiliaries ACN t o nestingScope p.arg codec + let aux = lm.lg.generateNullTypeAuxiliaries r ACN t o nestingScope p.arg codec match o.acnProperties.encodingPattern with | None -> @@ -1050,7 +1050,7 @@ let createAcnStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF ixVariable = i } let introSnap = nestingScope.nestingLevel = 0I - let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries ACN (StrType o) sqfProofGen codec + let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries r ACN (StrType o) sqfProofGen codec let funcBodyContent, localVariables = match o.minSize with @@ -1304,7 +1304,7 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted elemDecodeFn = None // TODO: elemDecodeFn ixVariable = i } - let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries ACN (SqOf o) sqfProofGen codec + let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries r ACN (SqOf o) sqfProofGen codec let ret = match o.acnEncodingClass with @@ -2049,7 +2049,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let combinedBody (p: CallerScope) (existVar: string option): string = ((presentWhenStmts |> Option.toList) @ (childBody |> Option.toList) |> List.map (fun f -> f p existVar)).StrJoin "\n" let soc = {SequenceOptionalChild.t = t; sq = o; child = child; existVar = existVar; p = {p with arg = childSel}; nestingScope = childNestingScope; childBody = combinedBody} - let optAux, theCombinedBody = lm.lg.generateOptionalAuxiliaries ACN soc codec + let optAux, theCombinedBody = lm.lg.generateOptionalAuxiliaries r ACN soc codec optAux, Some theCombinedBody let stmts = {body = theCombinedBody; lvs = presentWhenLvs @ childLvs; errCodes = presentWhenErrs @ childErrs; icdComments = []} @@ -2137,7 +2137,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let presenceBits = presenceBits |> List.map Some let children = childrenStatements00 |> List.map (fun s -> s.joinedBodies lm codec) presenceBits @ children - let childrenStatements = lm.lg.generateSequenceChildProof ACN allStmts seqProofGen codec + let childrenStatements = lm.lg.generateSequenceChildProof r ACN allStmts seqProofGen codec let childrenLocalvars = childrenStatements0 |> List.collect(fun s -> s.lvs) let childrenExistVar = childrenStatements00 |> List.choose(fun res -> res.existVar) @@ -2161,8 +2161,8 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let resultExpr = p.arg.asIdentifier Some resultExpr, [lm.uper.sequence_build resultExpr (typeDefinition.longTypedefName2 lm.lg.hasModules) p.arg.isOptional (existSeq@childrenResultExpr)] | _ -> None, [] - let proof = lm.lg.generateSequenceProof ACN t o nestingScope p.arg codec - let aux = lm.lg.generateSequenceAuxiliaries ACN t o nestingScope p.arg codec + let proof = lm.lg.generateSequenceProof r ACN t o nestingScope p.arg codec + let aux = lm.lg.generateSequenceAuxiliaries r ACN t o nestingScope p.arg codec let seqContent = (saveInitialBitStrmStatements@childrenStatements@(post_encoding_function |> Option.toList)@seqBuild@proof) |> nestChildItems lm codec match existsAcnChildWithNoUpdates with @@ -2428,8 +2428,8 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let extField = getExternalField r deps t.id choice_Enum pp access childrenStatements extField errCode.errCodeName codec, resultExpr | CEC_presWhen -> choice_preWhen pp access childrenStatements errCode.errCodeName codec, resultExpr - let choiceContent = lm.lg.generateChoiceProof ACN t o choiceContent p.arg codec - let aux = lm.lg.generateChoiceAuxiliaries ACN t o nestingScope p.arg codec + let choiceContent = lm.lg.generateChoiceProof r ACN t o choiceContent p.arg codec + let aux = lm.lg.generateChoiceAuxiliaries r ACN t o nestingScope p.arg codec Some ({AcnFuncBodyResult.funcBody = choiceContent; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (ChoiceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries@aux; icdResult = Some icd}), ns diff --git a/BackendAst/DAstUPer.fs b/BackendAst/DAstUPer.fs index 4bd109e7a..cc5c71432 100644 --- a/BackendAst/DAstUPer.fs +++ b/BackendAst/DAstUPer.fs @@ -100,8 +100,8 @@ let internal createUperFunction (r:Asn1AcnAst.AstRoot) emptyStatement, [], [], true, isValidFuncName.IsNone, [] | Some bodyResult -> bodyResult.funcBody, bodyResult.errCodes, bodyResult.localVariables, bodyResult.bBsIsUnReferenced, bodyResult.bValIsUnReferenced, bodyResult.auxiliaries let lvars = bodyResult_localVariables |> List.map(fun (lv:LocalVariable) -> lm.lg.getLocalVariableDeclaration lv) |> Seq.distinct - let precondAnnots = lm.lg.generatePrecond UPER t codec - let postcondAnnots = lm.lg.generatePostcond UPER typeDef.typeName p t codec + let precondAnnots = lm.lg.generatePrecond r UPER t codec + let postcondAnnots = lm.lg.generatePostcond r UPER typeDef.typeName p t codec let func = Some(EmitTypeAssignment varName sStar funcName isValidFuncName (lm.lg.getLongTypedefName typeDefinition) lvars bodyResult_funcBody soSparkAnnotations sInitialExp (t.uperMaxSizeInBits = 0I) bBsIsUnreferenced bVarNameIsUnreferenced soInitFuncName funcDefAnnots precondAnnots postcondAnnots codec) let errCodStr = errCodes |> List.map(fun x -> (EmitTypeAssignment_def_err_code x.errCodeName) (BigInteger x.errCodeValue)) @@ -474,7 +474,7 @@ let createIA5StringFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Co ixVariable = i } let introSnap = nestingScope.nestingLevel = 0I - let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries (if fromACN then ACN else UPER) (StrType o) sqfProofGen codec + let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries r (if fromACN then ACN else UPER) (StrType o) sqfProofGen codec let funcBodyContent,localVariables = match o.minSize with @@ -635,7 +635,7 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C elemDecodeFn = None // TODO: elemDecodeFn ixVariable = i } - let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries (if fromACN then ACN else UPER) (SqOf o) sqfProofGen codec + let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries r (if fromACN then ACN else UPER) (SqOf o) sqfProofGen codec let absOffset = nestingScope.uperOffset let remBits = nestingScope.uperOuterMaxSize - nestingScope.uperOffset @@ -813,7 +813,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let allStmts = let children = childrenStatements00 |> List.map (fun s -> s.stmt |> Option.bind (fun stmt -> stmt.body)) presenceBits @ children - let childrenStatements = lm.lg.generateSequenceChildProof UPER allStmts seqProofGen codec + let childrenStatements = lm.lg.generateSequenceChildProof r UPER allStmts seqProofGen codec let childrenStatements0 = childrenStatements00 |> List.choose(fun s -> s.stmt) let childrenLocalVars = childrenStatements0 |> List.collect(fun s -> s.lvs) @@ -906,12 +906,12 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Commo let introSnap = nestingScope.nestingLevel = 0I let pp, resultExpr = joinedOrAsIdentifier lm codec p let ret = choice pp (lm.lg.getAccess p.arg) childrenContent (BigInteger (children.Length - 1)) sChoiceIndexName errCode.errCodeName td nIndexSizeInBits introSnap codec - let ret = lm.lg.generateChoiceProof ACN t o ret p.arg codec + let ret = lm.lg.generateChoiceProof r ACN t o ret p.arg codec Some ({UPERFuncBodyResult.funcBody = ret; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ChoiceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries}) | Some baseFuncName -> let pp, resultExpr = adaptArgumentPtr lm codec p let funcBodyContent = callBaseTypeFunc lm pp baseFuncName codec - let ret = lm.lg.generateChoiceProof ACN t o funcBodyContent p.arg codec + let ret = lm.lg.generateChoiceProof r ACN t o funcBodyContent p.arg codec Some ({UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None; auxiliaries=[]}) let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) diff --git a/CommonTypes/CommonTypes.fs b/CommonTypes/CommonTypes.fs index 59a5ea3e1..2f2d48b4b 100644 --- a/CommonTypes/CommonTypes.fs +++ b/CommonTypes/CommonTypes.fs @@ -960,6 +960,7 @@ type CommandLineSettings = { blm : (ProgrammingLanguage*ILangBasic) list userRtlFunctionsToGenerate : string list enum_Items_To_Enable_Efficient_Enumerations : uint + stainlessInvertibility: bool } with member this.SIntMax = diff --git a/FrontEndAst/Language.fs b/FrontEndAst/Language.fs index d17b51f60..c043979ae 100644 --- a/FrontEndAst/Language.fs +++ b/FrontEndAst/Language.fs @@ -340,21 +340,21 @@ type ILangGeneric () = abstract member getBoardNames : Targets option -> string list abstract member getBoardDirs : Targets option -> string list - abstract member adaptAcnFuncBody: AcnFuncBody -> isValidFuncName: string option -> Asn1AcnAst.Asn1Type -> Codec -> AcnFuncBody - abstract member generateSequenceAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list - abstract member generateIntegerAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Integer -> NestingScope -> Selection -> Codec -> string list - abstract member generateSequenceOfLikeAuxiliaries: Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> string list * string option - abstract member generateOptionalAuxiliaries: Asn1Encoding -> SequenceOptionalChild -> Codec -> string list * string - abstract member generateChoiceAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Choice -> NestingScope -> Selection -> Codec -> string list - abstract member generateNullTypeAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.NullType -> NestingScope -> Selection -> Codec -> string list - abstract member generateEnumAuxiliaries: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Enumerated -> NestingScope -> Selection -> Codec -> string list - - abstract member generatePrecond: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Codec -> string list - abstract member generatePostcond: Asn1Encoding -> funcNameBase: string -> p: CallerScope -> t: Asn1AcnAst.Asn1Type -> Codec -> string option - abstract member generateSequenceChildProof: Asn1Encoding -> stmts: string option list -> SequenceProofGen -> Codec -> string list - abstract member generateSequenceProof: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list - abstract member generateChoiceProof: Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Choice -> stmt: string -> Selection -> Codec -> string - abstract member generateSequenceOfLikeProof: Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> SequenceOfLikeProofGenResult option + abstract member adaptAcnFuncBody: Asn1AcnAst.AstRoot -> AcnFuncBody -> isValidFuncName: string option -> Asn1AcnAst.Asn1Type -> Codec -> AcnFuncBody + abstract member generateSequenceAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list + abstract member generateIntegerAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Integer -> NestingScope -> Selection -> Codec -> string list + abstract member generateSequenceOfLikeAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> string list * string option + abstract member generateOptionalAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> SequenceOptionalChild -> Codec -> string list * string + abstract member generateChoiceAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Choice -> NestingScope -> Selection -> Codec -> string list + abstract member generateNullTypeAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.NullType -> NestingScope -> Selection -> Codec -> string list + abstract member generateEnumAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Enumerated -> NestingScope -> Selection -> Codec -> string list + + abstract member generatePrecond: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Codec -> string list + abstract member generatePostcond: Asn1AcnAst.AstRoot -> Asn1Encoding -> funcNameBase: string -> p: CallerScope -> t: Asn1AcnAst.Asn1Type -> Codec -> string option + abstract member generateSequenceChildProof: Asn1AcnAst.AstRoot -> Asn1Encoding -> stmts: string option list -> SequenceProofGen -> Codec -> string list + abstract member generateSequenceProof: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list + abstract member generateChoiceProof: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Choice -> stmt: string -> Selection -> Codec -> string + abstract member generateSequenceOfLikeProof: Asn1AcnAst.AstRoot -> Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> SequenceOfLikeProofGenResult option abstract member generateIntFullyConstraintRangeAssert: topLevelTd: string -> CallerScope -> Codec -> string option abstract member generateOctetStringInvariants: Asn1AcnAst.Asn1Type -> Asn1AcnAst.OctetString -> string list @@ -379,23 +379,23 @@ type ILangGeneric () = default this.removeFunctionFromBody (sourceCode: string) (functionName: string) : string = sourceCode - default this.adaptAcnFuncBody f _ _ _ = f - default this.generateSequenceAuxiliaries _ _ _ _ _ _ = [] - default this.generateIntegerAuxiliaries _ _ _ _ _ _ = [] - default this.generateSequenceOfLikeAuxiliaries _ _ _ _ = [], None - default this.generateOptionalAuxiliaries _ soc _ = + default this.adaptAcnFuncBody _ f _ _ _ = f + default this.generateSequenceAuxiliaries _ _ _ _ _ _ _ = [] + default this.generateIntegerAuxiliaries _ _ _ _ _ _ _ = [] + default this.generateSequenceOfLikeAuxiliaries _ _ _ _ _ = [], None + default this.generateOptionalAuxiliaries _ _ soc _ = // By default, languages do not have wrapped optional and have an `exist` field: they "attach" the child field themselves [], soc.childBody {soc.p with arg = soc.p.arg.dropLast} soc.existVar - default this.generateChoiceAuxiliaries _ _ _ _ _ _ = [] - default this.generateNullTypeAuxiliaries _ _ _ _ _ _ = [] - default this.generateEnumAuxiliaries _ _ _ _ _ _ = [] - - default this.generatePrecond _ _ _ = [] - default this.generatePostcond _ _ _ _ _ = None - default this.generateSequenceChildProof _ stmts _ _ = stmts |> List.choose id - default this.generateSequenceProof _ _ _ _ _ _ = [] - default this.generateChoiceProof _ _ _ stmt _ _ = stmt - default this.generateSequenceOfLikeProof _ _ _ _ = None + default this.generateChoiceAuxiliaries _ _ _ _ _ _ _ = [] + default this.generateNullTypeAuxiliaries _ _ _ _ _ _ _ = [] + default this.generateEnumAuxiliaries _ _ _ _ _ _ _ = [] + + default this.generatePrecond _ _ _ _ = [] + default this.generatePostcond _ _ _ _ _ _ = None + default this.generateSequenceChildProof _ _ stmts _ _ = stmts |> List.choose id + default this.generateSequenceProof _ _ _ _ _ _ _ = [] + default this.generateChoiceProof _ _ _ _ stmt _ _ = stmt + default this.generateSequenceOfLikeProof _ _ _ _ _ = None default this.generateIntFullyConstraintRangeAssert _ _ _ = None default this.generateOctetStringInvariants _ _ = [] diff --git a/FrontEndAst/LspAst.fs b/FrontEndAst/LspAst.fs index a55a16424..7b6ac59dd 100644 --- a/FrontEndAst/LspAst.fs +++ b/FrontEndAst/LspAst.fs @@ -111,7 +111,8 @@ let defaultCommandLineSettings = blm = [] userRtlFunctionsToGenerate= [] enum_Items_To_Enable_Efficient_Enumerations = System.UInt32.MaxValue - } + stainlessInvertibility = false + } type LspWorkSpace = { logger : (string->int) diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index 50c9a8b77..97d016a05 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -318,36 +318,36 @@ type LangGeneric_scala() = override this.bitStringValueToByteArray (v : BitStringValue) = FsUtils.bitStringValueToByteArray (StringLoc.ByValue v) - override this.generateSequenceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = - let fds = generateSequenceAuxiliaries enc t sq nestingScope sel codec + override this.generateSequenceAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateSequenceAuxiliaries r enc t sq nestingScope sel codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) - override this.generateIntegerAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (int: Asn1AcnAst.Integer) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = - let fds = generateIntegerAuxiliaries enc t int nestingScope sel codec + override this.generateIntegerAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (int: Asn1AcnAst.Integer) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateIntegerAuxiliaries r enc t int nestingScope sel codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) - override this.generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (o: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): string list * string option = - let fds, call = generateSequenceOfLikeAuxiliaries enc o pg codec + override this.generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (o: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): string list * string option = + let fds, call = generateSequenceOfLikeAuxiliaries r enc o pg codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]), Some (show (ExprTree call)) - override this.generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): string list * string = - let fds, call = generateOptionalAuxiliaries enc soc codec + override this.generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): string list * string = + let fds, call = generateOptionalAuxiliaries r enc soc codec let innerFns = fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) innerFns, show (ExprTree call) - override this.generateChoiceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (ch: Asn1AcnAst.Choice) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = - let fds = generateChoiceAuxiliaries enc t ch nestingScope sel codec + override this.generateChoiceAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (ch: Asn1AcnAst.Choice) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateChoiceAuxiliaries r enc t ch nestingScope sel codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) - override this.generateNullTypeAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nt: Asn1AcnAst.NullType) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = - let fds = generateNullTypeAuxiliaries enc t nt nestingScope sel codec + override this.generateNullTypeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nt: Asn1AcnAst.NullType) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateNullTypeAuxiliaries r enc t nt nestingScope sel codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) - override this.generateEnumAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (enm: Asn1AcnAst.Enumerated) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = - let fds = generateEnumAuxiliaries enc t enm nestingScope sel codec + override this.generateEnumAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (enm: Asn1AcnAst.Enumerated) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateEnumAuxiliaries r enc t enm nestingScope sel codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) - override this.adaptAcnFuncBody (funcBody: AcnFuncBody) (isValidFuncName: string option) (t: Asn1AcnAst.Asn1Type) (codec: Codec): AcnFuncBody = + override this.adaptAcnFuncBody (r: Asn1AcnAst.AstRoot) (funcBody: AcnFuncBody) (isValidFuncName: string option) (t: Asn1AcnAst.Asn1Type) (codec: Codec): AcnFuncBody = let shouldWrap = match t.Kind with | Asn1AcnAst.ReferenceType rt -> rt.hasExtraConstrainsOrChildrenOrAcnArgs @@ -376,7 +376,7 @@ type LangGeneric_scala() = match res with | Some res -> assert (not nestingScope.parents.IsEmpty) - let fds, call = wrapAcnFuncBody t res.funcBody codec nestingScope p recP + let fds, call = wrapAcnFuncBody r t res.funcBody codec nestingScope p recP let fdsStr = fds |> List.map (fun fd -> show (FunDefTree fd)) let callStr = show (ExprTree call) // TODO: Hack to determine how to change the "result variable" @@ -391,11 +391,11 @@ type LangGeneric_scala() = newFuncBody - override this.generatePrecond (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (codec: Codec): string list = - let precond = generatePrecond enc t codec + override this.generatePrecond (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (codec: Codec): string list = + let precond = generatePrecond r enc t codec [show (ExprTree precond)] - override this.generatePostcond (enc: Asn1Encoding) (funcNameBase: string) (p: CallerScope) (t: Asn1AcnAst.Asn1Type) (codec: Codec) = + override this.generatePostcond (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (funcNameBase: string) (p: CallerScope) (t: Asn1AcnAst.Asn1Type) (codec: Codec) = match enc with | ACN -> let errTpe = IntegerType Int @@ -404,26 +404,26 @@ type LangGeneric_scala() = | Encode -> let resPostcond = {Var.name = "res"; tpe = ClassType (eitherTpe errTpe (IntegerType Int))} let decodePureId = $"{t.FT_TypeDefinition.[Scala].typeName}_ACN_Decode_pure" - generateEncodePostcondExpr t p.arg resPostcond decodePureId + generateEncodePostcondExpr r t p.arg resPostcond decodePureId | Decode -> let resPostcond = {Var.name = "res"; tpe = ClassType (eitherMutTpe errTpe (fromAsn1TypeKind t.Kind))} - generateDecodePostcondExpr t resPostcond + generateDecodePostcondExpr r t resPostcond Some (show (ExprTree postcondExpr)) | _ -> Some (show (ExprTree (BoolLit true))) - override this.generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec): string list = - generateSequenceChildProof enc stmts pg codec + override this.generateSequenceChildProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec): string list = + generateSequenceChildProof r enc stmts pg codec - override this.generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = - let proof = generateSequenceProof enc t sq nestingScope sel codec + override this.generateSequenceProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let proof = generateSequenceProof r enc t sq nestingScope sel codec proof |> Option.map (fun p -> show (ExprTree p)) |> Option.toList // override this.generateChoiceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (ch: Asn1AcnAst.Choice) (stmt: string) (sel: Selection) (codec: Codec): string = // let proof = generateChoiceProof enc t ch stmt sel codec // show (ExprTree proof) - override this.generateSequenceOfLikeProof (enc: Asn1Encoding) (o: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = - generateSequenceOfLikeProof enc o pg codec + override this.generateSequenceOfLikeProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (o: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = + generateSequenceOfLikeProof r enc o pg codec override this.generateIntFullyConstraintRangeAssert (topLevelTd: string) (p: CallerScope) (codec: Codec): string option = None diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 6fc1d1f6b..85d188c42 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -767,7 +767,8 @@ let generateSequenceSubtypeDefinitions (dealiased: string) (t: Asn1AcnAst.Asn1Ty [show (FunDefTree fd)] -let generateEncodePostcondExprCommon (tpe: Type) +let generateEncodePostcondExprCommon (r: Asn1AcnAst.AstRoot) + (tpe: Type) (maxSize: bigint) (pVal: Selection) (resPostcond: Var) @@ -784,52 +785,54 @@ let generateEncodePostcondExprCommon (tpe: Type) let acnVarsPatBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn{ix + 1}"; tpe = tpe}) let invertibility = - let prefix = isPrefixOfACN oldCdc (Var cdc) - let r1 = {Var.name = "r1"; tpe = ClassType codecTpe} - let r2 = {Var.name = "r2"; tpe = ClassType codecTpe} - let readerCall = acnReader oldCdc (Var cdc) - let lemmaCall = validateOffsetBitsContentIrrelevancyLemma (selBitStream oldCdc) (selBuf (Var cdc)) (longlit maxSize) - let decodePureCall = FunctionCall {prefix = []; id = decodePureId; tps = []; args = (Var r1) :: decodeExtraArgs} - let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} - let decodingRes = {Var.name = "decodingRes"; tpe = ClassType (eitherMutTpe (IntegerType Int) tpe)} - let resGot = {Var.name = "resGot"; tpe = tpe} - let acnVarsGotBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acnGot{ix + 1}"; tpe = tpe}) - let acnEq = List.zip acnVarsGotBdg acnVarsPatBdg |> List.map (fun (acnGot, acn) -> Equals (Var acnGot, Var acn)) - let eq = And ([ - Equals (Var resGot, Var szRecv) - Equals (Var r2Got, Var cdc) - ] @ acnEq) - let decodeResPatmat = - let rightPat = - let subpat = - if acnTps.IsEmpty then Wildcard (Some resGot) - else TuplePattern {binder = None; subPatterns = Wildcard (Some resGot) :: (acnVarsGotBdg |> List.map (fun v -> Wildcard (Some v)))} - ADTPattern { - binder = None - id = rightMutId - subPatterns = [subpat] - } - MatchExpr { - scrut = Var decodingRes - cases = [ - { - pattern = ADTPattern {binder = None; id = leftMutId; subPatterns = [Wildcard None]} - rhs = BoolLit false - } - { - pattern = rightPat - rhs = eq + if not r.args.stainlessInvertibility then [] + else + let prefix = isPrefixOfACN oldCdc (Var cdc) + let r1 = {Var.name = "r1"; tpe = ClassType codecTpe} + let r2 = {Var.name = "r2"; tpe = ClassType codecTpe} + let readerCall = acnReader oldCdc (Var cdc) + let lemmaCall = validateOffsetBitsContentIrrelevancyLemma (selBitStream oldCdc) (selBuf (Var cdc)) (longlit maxSize) + let decodePureCall = FunctionCall {prefix = []; id = decodePureId; tps = []; args = (Var r1) :: decodeExtraArgs} + let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} + let decodingRes = {Var.name = "decodingRes"; tpe = ClassType (eitherMutTpe (IntegerType Int) tpe)} + let resGot = {Var.name = "resGot"; tpe = tpe} + let acnVarsGotBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acnGot{ix + 1}"; tpe = tpe}) + let acnEq = List.zip acnVarsGotBdg acnVarsPatBdg |> List.map (fun (acnGot, acn) -> Equals (Var acnGot, Var acn)) + let eq = And ([ + Equals (Var resGot, Var szRecv) + Equals (Var r2Got, Var cdc) + ] @ acnEq) + let decodeResPatmat = + let rightPat = + let subpat = + if acnTps.IsEmpty then Wildcard (Some resGot) + else TuplePattern {binder = None; subPatterns = Wildcard (Some resGot) :: (acnVarsGotBdg |> List.map (fun v -> Wildcard (Some v)))} + ADTPattern { + binder = None + id = rightMutId + subPatterns = [subpat] } - ] - } - let boundCall = - letTuple [r1; r2] readerCall ( - mkBlock [ - lemmaCall - letTuple [r2Got; decodingRes] decodePureCall decodeResPatmat - ] - ) - [prefix; Locally boundCall] + MatchExpr { + scrut = Var decodingRes + cases = [ + { + pattern = ADTPattern {binder = None; id = leftMutId; subPatterns = [Wildcard None]} + rhs = BoolLit false + } + { + pattern = rightPat + rhs = eq + } + ] + } + let boundCall = + letTuple [r1; r2] readerCall ( + mkBlock [ + lemmaCall + letTuple [r2Got; decodingRes] decodePureCall decodeResPatmat + ] + ) + [prefix; Locally boundCall] let rightBody = And (extraCondsPre @ [ Equals (selBufLength oldCdc, selBufLength (Var cdc)) @@ -854,12 +857,12 @@ let generateEncodePostcondExprCommon (tpe: Type) ] } -let generatePrecond (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (codec: Codec): Expr = +let generatePrecond (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (codec: Codec): Expr = let codecTpe = runtimeCodecTypeFor ACN let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} validateOffsetBitsACN (Var cdc) (longlit (t.maxSizeInBits enc)) -let generateDecodePostcondExprCommon (resPostcond: Var) (resRightMut: Var) (sz: SizeExprRes) (extraCondsPre: Expr list) (extraCondsPost: Expr list): Expr = +let generateDecodePostcondExprCommon (r: Asn1AcnAst.AstRoot) (resPostcond: Var) (resRightMut: Var) (sz: SizeExprRes) (extraCondsPre: Expr list) (extraCondsPost: Expr list): Expr = let codecTpe = runtimeCodecTypeFor ACN let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} let oldCdc = Old (Var cdc) @@ -870,7 +873,7 @@ let generateDecodePostcondExprCommon (resPostcond: Var) (resRightMut: Var) (sz: let rightBody = letsIn sz.bdgs rightBody eitherMutMatchExpr (Var resPostcond) None (BoolLit true) (Some resRightMut) rightBody -let generateEncodePostcondExpr (t: Asn1AcnAst.Asn1Type) (pVal: Selection) (resPostcond: Var) (decodePureId: string): Expr = +let generateEncodePostcondExpr (r: Asn1AcnAst.AstRoot) (t: Asn1AcnAst.Asn1Type) (pVal: Selection) (resPostcond: Var) (decodePureId: string): Expr = let codecTpe = runtimeCodecTypeFor ACN let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} let oldCdc = Old (Var cdc) @@ -882,9 +885,9 @@ let generateEncodePostcondExpr (t: Asn1AcnAst.Asn1Type) (pVal: Selection) (resPo // Note that we don't have a "ReferenceType" in such cases, so we have to explicitly call `size` and not rely on asn1SizeExpr... {bdgs = []; resSize = callSize (Var szRecv) (bitIndexACN oldCdc)} | _ -> asn1SizeExpr t.acnAlignment t.Kind (Var szRecv) (bitIndexACN oldCdc) 0I 0I - generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits pVal resPostcond [] sz [] decodePureId [] + generateEncodePostcondExprCommon r tpe t.acnMaxSizeInBits pVal resPostcond [] sz [] decodePureId [] -let generateDecodePostcondExpr (t: Asn1AcnAst.Asn1Type) (resPostcond: Var): Expr = +let generateDecodePostcondExpr (r: Asn1AcnAst.AstRoot) (t: Asn1AcnAst.Asn1Type) (resPostcond: Var): Expr = let codecTpe = runtimeCodecTypeFor ACN let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} let oldCdc = Old (Var cdc) @@ -906,7 +909,7 @@ let generateDecodePostcondExpr (t: Asn1AcnAst.Asn1Type) (resPostcond: Var): Expr | _ -> let isValidFuncName = $"{t.FT_TypeDefinition.[Scala].typeName}_IsConstraintValid" [isRightExpr (FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var szRecv]})] - generateDecodePostcondExprCommon resPostcond szRecv sz [] (strSize @ cstrIsValid) + generateDecodePostcondExprCommon r resPostcond szRecv sz [] (strSize @ cstrIsValid) let rec tryFindFirstParentACNDependency (parents: Asn1AcnAst.Asn1Type list) (dep: RelativePath): (Asn1AcnAst.Asn1Type * Asn1AcnAst.AcnChild) option = match parents with @@ -1457,7 +1460,8 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) generatePrefixLemma enc t nestingScope mkSeqProof -let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) +let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) + (t: Asn1AcnAst.Asn1Type) (body: string) (codec: Codec) (nestingScope: NestingScope) @@ -1515,7 +1519,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) // If we do, we must "inline" the size definition which will contain the size of these extra ACN fields and if not, we can just call size // We always inline here since it is ok even if we don't have extra ACN fields asn1SizeExpr t.acnAlignment t.Kind (Var szRecv) (bitIndexACN (Old (Var cdc))) 0I 0I - let postcondExpr = generateEncodePostcondExprCommon tpe t.acnMaxSizeInBits recSel.arg resPostcond acnTps sz [] decodePureId (paramsAcn |> List.map Var) + let postcondExpr = generateEncodePostcondExprCommon r tpe t.acnMaxSizeInBits recSel.arg resPostcond acnTps sz [] decodePureId (paramsAcn |> List.map Var) let fd = { id = $"{baseId}_ACN_Encode" prms = [cdc; outermostPVal] @ acnExtVars @ paramsAcn @ [recPVal] @@ -1585,7 +1589,7 @@ let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) let cstrIsValid = isRightExpr (FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var szRecv]}) let postcondExpr = if acns.IsEmpty then - generateDecodePostcondExprCommon resPostcond szRecv sz [] [cstrIsValid] + generateDecodePostcondExprCommon r resPostcond szRecv sz [] [cstrIsValid] else assert (match t.Kind with Sequence _ -> true | _ -> false) let oldCdc = Old (Var cdc) @@ -1766,7 +1770,7 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va let stmts = List.zip3 snapshots childrenWithPresenceBits stmts |> List.indexed List.foldBack annotate stmts ((pg.maxOffset enc) + thisMaxSize, rest) |> snd -let generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec): string list = +let generateSequenceChildProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec): string list = if stmts.IsEmpty then stmts |> List.choose id else let codecTpe = runtimeCodecTypeFor enc @@ -1787,7 +1791,7 @@ let generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) ( let exprStr = show (ExprTree expr) [exprStr] -let generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): Expr option = +let generateSequenceProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): Expr option = if sq.children.IsEmpty then None else let codecTpe = runtimeCodecTypeFor enc @@ -1885,33 +1889,33 @@ let generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1 Some (Ghost (mkBlock (transitiveLemmas @ presenceBitsPrefixLemmaApps @ childrenPrefixLemmaApps @ [proof]))) *) -let generateSequenceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = - if enc = ACN && codec = Decode then [generatePrefixLemmaSequence enc t nestingScope sq] +let generateSequenceAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if r.args.stainlessInvertibility && enc = ACN && codec = Decode then [generatePrefixLemmaSequence enc t nestingScope sq] else [] -let generateIntegerAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (int: Asn1AcnAst.Integer) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = +let generateIntegerAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (int: Asn1AcnAst.Integer) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = // If `tasInfo` is Some, then there is a pair of encode/decode functions that are generated wrapping a call to encode/decode the integer // In such cases, we generate a "read prefix" lemma that is just an application of the appropriate ACN integer lemma - if enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaInteger enc t nestingScope int] + if r.args.stainlessInvertibility && enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaInteger enc t nestingScope int] else [] -let generateChoiceAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (ch: Asn1AcnAst.Choice) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = - if enc = ACN && codec = Decode then [generatePrefixLemmaChoice enc t nestingScope ch] +let generateChoiceAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (ch: Asn1AcnAst.Choice) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if r.args.stainlessInvertibility && enc = ACN && codec = Decode then [generatePrefixLemmaChoice enc t nestingScope ch] else [] -let generateNullTypeAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nt: Asn1AcnAst.NullType) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = - if enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaNullType enc t nestingScope nt] +let generateNullTypeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nt: Asn1AcnAst.NullType) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if r.args.stainlessInvertibility && enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaNullType enc t nestingScope nt] else [] -let generateEnumAuxiliaries (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (enm: Asn1AcnAst.Enumerated) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = - if enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaEnum enc t nestingScope enm] +let generateEnumAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (enm: Asn1AcnAst.Enumerated) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if r.args.stainlessInvertibility && enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaEnum enc t nestingScope enm] else [] -let generateSequenceOfLikeProof (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = +let generateSequenceOfLikeProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = None -let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): FunDef list * Expr = +let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): FunDef list * Expr = let sqfTpe = fromSequenceOfLike sqf let elemTpe = fromSequenceOfLikeElemTpe sqf let codecTpe = runtimeCodecTypeFor enc @@ -2172,12 +2176,14 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) letsIn [sqfVar, eitherMutMatchExpr scrut (Some leftBdg) leftBody (Some rightBdg) rightBody] (mkBlock []) let call = letsGhostIn [cdcBeforeLoop, Snapshot (Var cdc)] call let prefixLemma = - match pg.t with - | Asn1TypeOrAcnRefIA5.Asn1 _ -> [generatePrefixLemmaSequenceOfLike enc pg.t pg.nestingScope sqf] - | Asn1TypeOrAcnRefIA5.AcnRefIA5 _ -> [] + if r.args.stainlessInvertibility then + match pg.t with + | Asn1TypeOrAcnRefIA5.Asn1 _ -> [generatePrefixLemmaSequenceOfLike enc pg.t pg.nestingScope sqf] + | Asn1TypeOrAcnRefIA5.AcnRefIA5 _ -> [] + else [] fd :: prefixLemma, call -let generateOptionalPrefixLemma (enc: Asn1Encoding) (soc: SequenceOptionalChild): FunDef = +let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc: SequenceOptionalChild): FunDef = let mkProof (data: PrefixLemmaData): Expr = UnitLit // TODO @@ -2275,7 +2281,7 @@ let generateOptionalPrefixLemma (enc: Asn1Encoding) (soc: SequenceOptionalChild) } *) -let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): FunDef list * Expr = +let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): FunDef list * Expr = if soc.child.Optionality.IsNone then [], EncDec (soc.childBody soc.p soc.existVar) else let codecTpe = runtimeCodecTypeFor enc @@ -2328,7 +2334,7 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) match soc.child.Optionality with | Some (AlwaysPresent | AlwaysAbsent) -> [] | _ -> [isDefinedMutExpr (Var childVar)] - let postcondExpr = generateEncodePostcondExprCommon optChildTpe childAsn1Tpe.acnMaxSizeInBits soc.p.arg resPostcond [] sz [] fnIdPure (isDefined @ (paramsAcn |> List.map Var)) + let postcondExpr = generateEncodePostcondExprCommon r optChildTpe childAsn1Tpe.acnMaxSizeInBits soc.p.arg resPostcond [] sz [] fnIdPure (isDefined @ (paramsAcn |> List.map Var)) let retRes = rightExpr errTpe rightTpe (int32lit 0I) let body = letsGhostIn [(oldCdc, Snapshot (Var cdc))] (mkBlock (cstrCheck @ [encDec; retRes])) let fd = { @@ -2382,7 +2388,7 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) let someBdg = {Var.name = "v"; tpe = childTpe} let isRight = isRightExpr (FunctionCall {prefix = []; id = isValid; tps = []; args = [Var someBdg]}) optionMutMatchExpr (Var resvalVar) (Some someBdg) isRight (BoolLit true)) |> Option.toList - let postcondExpr = generateDecodePostcondExprCommon resPostcond resvalVar sz alwaysAbsentOrPresent cstrIsValid + let postcondExpr = generateDecodePostcondExprCommon r resPostcond resvalVar sz alwaysAbsentOrPresent cstrIsValid let body = letsGhostIn [(oldCdc, Snapshot (Var cdc))] (mkBlock [encDec; retInnerFd]) let fd = { @@ -2424,5 +2430,8 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) returnTpe = tupleType [ClassType codecTpe; fnRetTpe] body = pureBody } - let prefixLemma = generateOptionalPrefixLemma enc soc - [fd; fdPure; prefixLemma], ret + let prefixLemma = + if r.args.stainlessInvertibility then + [generateOptionalPrefixLemma r enc soc] + else [] + [fd; fdPure] @ prefixLemma, ret diff --git a/asn1scc/Program.fs b/asn1scc/Program.fs index 08e5848a1..282d00893 100644 --- a/asn1scc/Program.fs +++ b/asn1scc/Program.fs @@ -48,6 +48,7 @@ type CliArguments = | [] Init_Globals | [] Handle_Empty_Sequences | [] Include_Func of string + | [] StainlessInvertibility | [] Files of files:string list with interface IArgParserTemplate with @@ -80,11 +81,11 @@ with that has least one conflicting enumerant. 3 all enumerants of all of an enumerated types are renamed. -""" +""" | Enable_Efficient_Enumerations _ -> """Enable efficient enumerations. (Applicable only to C.) -This mode optimizes the generated C code for ASN.1 Enumerated types with multiple enumerants (e.g., 50 or more). -Instead of generating switch statements, asn1scc generates sorted arrays containing the possible values. -Lookups (e.g., for validation or index retrieval in uPER encoding) are performed using an optimized binary search. +This mode optimizes the generated C code for ASN.1 Enumerated types with multiple enumerants (e.g., 50 or more). +Instead of generating switch statements, asn1scc generates sorted arrays containing the possible values. +Lookups (e.g., for validation or index retrieval in uPER encoding) are performed using an optimized binary search. This results in more efficient and less verbose code. The argument is the minimum number of enumerants in an enumerated type to enable this mode. E.g., -eee 50 will enable this mode for enumerated types with 50 or more enumerants. @@ -112,6 +113,7 @@ E.g., -eee 50 will enable this mode for enumerated types with 50 or more enumera | Streaming_Mode -> "Streaming mode support" | Handle_Empty_Sequences -> "Adds a dummy integer member to empty ASN.1 SEQUENCE structures for compliant C code generation." | Include_Func _ -> "Include a function from the RTL. The function name is expected as argument. This argument can be repeated many times. This argument is supported only for C" + | StainlessInvertibility -> "(Scala backend only) Generate invertibility conditions and lemmas" let printVersion () = @@ -155,11 +157,11 @@ let checkCompositeFile comFile cmdoption extention= let c_macro = { - LanguageMacros.equal = new IEqual_c.IEqual_c() + LanguageMacros.equal = new IEqual_c.IEqual_c() init = new Init_c.Init_c() - typeDef = new ITypeDefinition_c.ITypeDefinition_c() - lg = new LangGeneric_c.LangGeneric_c(); - isvalid= new IsValid_c.IsValid_c() + typeDef = new ITypeDefinition_c.ITypeDefinition_c() + lg = new LangGeneric_c.LangGeneric_c(); + isvalid= new IsValid_c.IsValid_c() vars = new IVariables_c.IVariables_c() uper = new iuper_c.iuper_c() acn = new IAcn_c.IAcn_c() @@ -167,13 +169,13 @@ let c_macro = xer = new IXer_c.IXer_c() src = new ISrcBody_c.ISrcBody_c() } -let scala_macro = +let scala_macro = { - LanguageMacros.equal = new IEqual_scala.IEqual_scala() + LanguageMacros.equal = new IEqual_scala.IEqual_scala() init = new IInit_scala.IInit_scala() - typeDef = new ITypeDefinition_scala.ITypeDefinition_scala() - lg = new LangGeneric_scala.LangGeneric_scala(); - isvalid= new IIsValid_scala.IIsValid_scala() + typeDef = new ITypeDefinition_scala.ITypeDefinition_scala() + lg = new LangGeneric_scala.LangGeneric_scala(); + isvalid= new IIsValid_scala.IIsValid_scala() vars = new IVariables_scala.IVariables_scala() uper = new IUper_scala.IUper_scala() acn = new IAcn_scala.IAcn_scala() @@ -181,12 +183,12 @@ let scala_macro = xer = new IXer_scala.IXer_scala() src = new ISrcBody_scala.ISrcBody_scala() } -let ada_macro = +let ada_macro = { - LanguageMacros.equal = new IEqual_a.IEqual_a(); + LanguageMacros.equal = new IEqual_a.IEqual_a(); init = new Init_a.Init_a() - typeDef = new ITypeDefinition_a.ITypeDefinition_a(); - lg = new LangGeneric_a.LangGeneric_a(); + typeDef = new ITypeDefinition_a.ITypeDefinition_a(); + lg = new LangGeneric_a.LangGeneric_a(); isvalid= new IsValid_a.IsValid_a() vars = new IVariables_a.IVariables_a() uper = new iuper_a.iuper_a() @@ -194,7 +196,7 @@ let ada_macro = atc = new ITestCases_a.ITestCases_a() xer = new IXer_a.IXer_a() src = new ISrcBody_a.ISrcBody_a() - } + } let allMacros = [ (C, c_macro); (Scala, scala_macro); (Ada, ada_macro)] let getLanguageMacro (l:ProgrammingLanguage) = allMacros |> List.filter(fun (lang,_) -> lang = l) |> List.head |> snd @@ -268,17 +270,18 @@ let checkArgument (cliArgs : CliArguments list) arg = | Mapping_Functions_Module mfm -> () | Streaming_Mode -> () | Handle_Empty_Sequences -> () - | Include_Func fnName -> + | Include_Func fnName -> //check that the target language is C match cliArgs |> List.exists (fun a -> a = C_lang) with - | true -> + | true -> // check if the function exists in the RTL match c_macro.lg.RtlFuncNames |> List.exists (fun name -> name = fnName ) with | true -> () - | false -> + | false -> let availableFunctions = c_macro.lg.RtlFuncNames |> String.concat "\n" raise (UserException (sprintf "Function '%s' does not exist in the C RTL.\nThe available functions to choose are:\n\n%s" fnName availableFunctions)) | false -> raise (UserException ("The -if option is supported only for C.")) + | StainlessInvertibility -> () let createInput (fileName:string) : Input = { @@ -302,7 +305,7 @@ let constructCommandLineSettings args (parserResults: ParseResults enum_Items_To_Enable_Efficient_Enumerations = match parserResults.TryGetResult <@ Enable_Efficient_Enumerations @> with | None -> System.UInt32.MaxValue - | Some n -> + | Some n -> match n with | Some n -> n | None -> 0u @@ -351,14 +354,15 @@ let constructCommandLineSettings args (parserResults: ParseResults | _ -> Some (FieldPrefixUserValue vl) targetLanguages = args |> List.choose(fun a -> match a with C_lang -> Some (CommonTypes.ProgrammingLanguage.C) | Ada_Lang -> Some (CommonTypes.ProgrammingLanguage.Ada) | Scala_Lang -> Some (CommonTypes.ProgrammingLanguage.Scala) | _ -> None) - + userRtlFunctionsToGenerate = args |> List.choose(fun a -> match a with Include_Func fnName -> Some fnName | _ -> None) - + objectIdentifierMaxLength = 20I handleEmptySequences = parserResults.Contains <@ Handle_Empty_Sequences @> blm = [(ProgrammingLanguage.C, new LangGeneric_c.LangBasic_c());(ProgrammingLanguage.Ada, new LangGeneric_a.LangBasic_ada());(ProgrammingLanguage.Scala, new LangGeneric_scala.LangBasic_scala()) ] + stainlessInvertibility = args |> List.exists (fun a -> match a with StainlessInvertibility -> true | _ -> false) } let main0 argv = From 3255f5bfddf554d94549dbea3e3205f9784788ad Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Mon, 12 Aug 2024 16:59:21 +0200 Subject: [PATCH 23/35] Prefix lemma subproofs --- BackendAst/DAstACN.fs | 2 +- FrontEndAst/AcnCreateFromAntlr.fs | 92 ++- FrontEndAst/Asn1AcnAst.fs | 4 + FrontEndAst/Language.fs | 2 +- StgScala/ProofAst.fs | 161 ++-- StgScala/ProofGen.fs | 740 ++++++++++++++---- .../scala/asn1scala/asn1jvm_Bitstream.scala | 35 +- .../main/scala/asn1scala/asn1jvm_Codec.scala | 40 +- .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 30 + 9 files changed, 846 insertions(+), 260 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index 7c8c1ab2c..a8ae68a84 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -1031,7 +1031,7 @@ let createAcnStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF InternalItem_string_with_alpha pp errCode.errCodeName td i (BigInteger (o.uperCharSet.Length-1)) arrAsciiCodes (BigInteger (o.uperCharSet.Length)) nBits codec let nSizeInBits = GetNumberOfBitsForNonNegativeInteger (o.maxSize.uper - o.minSize.uper) let sqfProofGen = { - SequenceOfLikeProofGen.t = Asn1TypeOrAcnRefIA5.AcnRefIA5 t + SequenceOfLikeProofGen.t = Asn1TypeOrAcnRefIA5.AcnRefIA5 (typeId, t) acnOuterMaxSize = nestingScope.acnOuterMaxSize uperOuterMaxSize = nestingScope.uperOuterMaxSize nestingLevel = nestingScope.nestingLevel diff --git a/FrontEndAst/AcnCreateFromAntlr.fs b/FrontEndAst/AcnCreateFromAntlr.fs index bf07160ab..058ed9f79 100644 --- a/FrontEndAst/AcnCreateFromAntlr.fs +++ b/FrontEndAst/AcnCreateFromAntlr.fs @@ -141,6 +141,27 @@ let private getStringEncodingProperty errLoc (props:GenericAcnProperty list) = | Some (GP_BCD ) -> raise(SemanticError(errLoc ,"The encoding property was expected to be 'ASCII' or empty")) | Some (GP_Ascii ) -> Some (AcnGenericTypes.StrAscii) +let private substAcnArg (acnParamSubst: Map) (arg: AcnGenericTypes.RelativePath): AcnGenericTypes.RelativePath = + match arg with + | RelativePath [] -> arg + | RelativePath (hd :: rest) -> + acnParamSubst.TryFind hd.Value |> + Option.map (fun subst -> match subst with RelativePath subst -> RelativePath (subst @ rest)) |> + Option.defaultValue arg + +let private substAcnArgs (acnParamSubst: Map) (acnArgs : AcnGenericTypes.RelativePath list): AcnGenericTypes.RelativePath list = + acnArgs |> List.map (substAcnArg acnParamSubst) + +let private addAcnSubst (acnParamSubst: Map) + (acnParams: AcnParameter list) + (acnArgs : AcnGenericTypes.RelativePath list): Map = + assert (acnParams.Length = acnArgs.Length) + let add (curr: Map) (p: AcnParameter, acnArg: AcnGenericTypes.RelativePath): Map = + let substed = substAcnArg curr acnArg + curr |> Map.add p.name substed + + List.fold add acnParamSubst (List.zip acnParams acnArgs) + let checkIntHasEnoughSpace acnEncodingClass (hasMappingFunction:bool) acnErrLoc0 asn1Min asn1Max = let check_ (minEnc : BigInteger) (maxEnc:BigInteger) = match minEnc <= asn1Min && asn1Max <= maxEnc with @@ -428,7 +449,15 @@ let private mergeStringType (asn1: Asn1Ast.AstRoot) (t: Asn1Ast.Asn1Type option) acnEncodingClass = acnEncodingClass; acnMinSizeInBits=acnMinSizeInBits; acnMaxSizeInBits = acnMaxSizeInBits;isNumeric=isNumeric; typeDef=typeDef}, us1 -let private mergeOctetStringType (asn1: Asn1Ast.AstRoot) (loc: SrcLoc) (acnErrLoc: SrcLoc option) (props: GenericAcnProperty list) cons withcons (tdarg: GetTypeDefinition_arg) (us: Asn1AcnMergeState) = +let private mergeOctetStringType (asn1: Asn1Ast.AstRoot) + (loc: SrcLoc) + (acnErrLoc: SrcLoc option) + (props: GenericAcnProperty list) + cons + withcons + (tdarg: GetTypeDefinition_arg) + (acnParamSubst: Map) + (us: Asn1AcnMergeState) = let sizeUperRange = uPER.getOctetStringUperRange cons loc let sizeUperAcnRange = uPER.getOctetStringUperRange (cons@withcons) loc @@ -447,15 +476,29 @@ let private mergeOctetStringType (asn1: Asn1Ast.AstRoot) (loc: SrcLoc) (acnErrLo match acnErrLoc with | Some acnErrLoc -> {SizeableAcnProperties.sizeProp = getSizeableSizeProperty minSize.acn maxSize.acn acnErrLoc props} | None -> {SizeableAcnProperties.sizeProp = None} - + let sizeDetArg = acnProperties.sizeProp |> Option.bind (fun p -> + match p with + | SzExternalField f -> Some f + | SzNullTerminated _ -> None + ) + let acnArgsSubsted = substAcnArgs acnParamSubst (sizeDetArg |> Option.toList) let alignment = tryGetProp props (fun x -> match x with ALIGNTONEXT e -> Some e | _ -> None) let acnEncodingClass, acnMinSizeInBits, acnMaxSizeInBits= AcnEncodingClasses.GetOctetStringEncodingClass alignment loc acnProperties acnUperMinSizeInBits acnUperMaxSizeInBits minSize.acn maxSize.acn hasNCount let typeDef, us1 = getSizeableTypeDefinition tdarg us - {OctetString.acnProperties = acnProperties; cons = cons; withcons = withcons; minSize=minSize; maxSize =maxSize; uperMaxSizeInBits = uperMaxSizeInBits; uperMinSizeInBits=uperMinSizeInBits; acnEncodingClass = acnEncodingClass; acnMinSizeInBits=acnMinSizeInBits; acnMaxSizeInBits = acnMaxSizeInBits; typeDef=typeDef}, us1 - -let private mergeBitStringType (asn1:Asn1Ast.AstRoot) (namedBitList: NamedBit0 list) (loc:SrcLoc) (acnErrLoc: SrcLoc option) (props:GenericAcnProperty list) cons withcons (tdarg:GetTypeDefinition_arg) (us:Asn1AcnMergeState) = + {OctetString.acnProperties = acnProperties; cons = cons; withcons = withcons; minSize=minSize; maxSize =maxSize; uperMaxSizeInBits = uperMaxSizeInBits; uperMinSizeInBits=uperMinSizeInBits; acnEncodingClass = acnEncodingClass; acnMinSizeInBits=acnMinSizeInBits; acnMaxSizeInBits = acnMaxSizeInBits; acnArgs = acnArgsSubsted; typeDef=typeDef}, us1 + +let private mergeBitStringType (asn1:Asn1Ast.AstRoot) + (namedBitList: NamedBit0 list) + (loc:SrcLoc) + (acnErrLoc: SrcLoc option) + (props:GenericAcnProperty list) + cons + withcons + (tdarg:GetTypeDefinition_arg) + (acnParamSubst: Map) + (us:Asn1AcnMergeState) = let newNamedBitList = namedBitList |> List.map(fun nb -> let resolvedValue = @@ -481,6 +524,12 @@ let private mergeBitStringType (asn1:Asn1Ast.AstRoot) (namedBitList: NamedBit0 l match acnErrLoc with | Some acnErrLoc -> { SizeableAcnProperties.sizeProp = getSizeableSizeProperty minSize.acn maxSize.acn acnErrLoc props} | None -> {SizeableAcnProperties.sizeProp = None } + let sizeDetArg = acnProperties.sizeProp |> Option.bind (fun p -> + match p with + | SzExternalField f -> Some f + | SzNullTerminated _ -> None + ) + let acnArgsSubsted = substAcnArgs acnParamSubst (sizeDetArg |> Option.toList) let alignment = tryGetProp props (fun x -> match x with ALIGNTONEXT e -> Some e | _ -> None) let acnEncodingClass, acnMinSizeInBits, acnMaxSizeInBits= AcnEncodingClasses.GetBitStringEncodingClass alignment loc acnProperties acnUperMinSizeInBits uperMaxSizeInBits minSize.acn maxSize.acn hasNCount @@ -488,7 +537,7 @@ let private mergeBitStringType (asn1:Asn1Ast.AstRoot) (namedBitList: NamedBit0 l let typeDef, us1 = getSizeableTypeDefinition tdarg us {BitString.acnProperties = acnProperties; cons = cons; withcons = withcons; minSize=minSize; maxSize =maxSize; uperMaxSizeInBits = uperMaxSizeInBits; uperMinSizeInBits=uperMinSizeInBits; acnEncodingClass = acnEncodingClass; - acnMinSizeInBits=acnMinSizeInBits; acnMaxSizeInBits = acnMaxSizeInBits; typeDef=typeDef; namedBitList = newNamedBitList}, us1 + acnMinSizeInBits=acnMinSizeInBits; acnMaxSizeInBits = acnMaxSizeInBits; acnArgs = acnArgsSubsted; typeDef=typeDef; namedBitList = newNamedBitList}, us1 let private mergeNullType (args: CommandLineSettings) (acnErrLoc: SrcLoc option) (props: GenericAcnProperty list) (tdarg: GetTypeDefinition_arg) (us: Asn1AcnMergeState) = let getRtlTypeName (l:ProgrammingLanguage) = (args.getBasicLang l).getNullRtlTypeName @@ -510,7 +559,7 @@ let createAcnBooleanProperties (props: GenericAcnProperty list) (acnErrLoc: SrcL let trueValue = tryGetProp props (fun x -> match x with TRUE_VALUE e -> Some e | _ -> None) let falseValue = tryGetProp props (fun x -> match x with FALSE_VALUE e -> Some e | _ -> None) match trueValue, falseValue with - | Some tv, Some fv -> + | Some tv, Some fv -> //if both true and false values are defined, then the length of the values must be the same and greater than 0 if tv.Value.Length = 0 || fv.Value.Length = 0 then raise(SemanticError(acnErrLoc, "The length of the 'true-value' and 'false-value' properties must be greater than 0")) @@ -520,12 +569,12 @@ let createAcnBooleanProperties (props: GenericAcnProperty list) (acnErrLoc: SrcL raise(SemanticError(acnErrLoc, "The 'true-value' and 'false-value' properties must have different values")) else {BooleanAcnProperties.encodingPattern = Some( TrueFalseValueEncoding(tv, fv))} - | Some tv, None -> + | Some tv, None -> if tv.Value.Length = 0 then raise(SemanticError(acnErrLoc, "The length of the 'true-value' property must be greater than 0")) else {BooleanAcnProperties.encodingPattern = Some( TrueValueEncoding(tv))} - | None, Some fv -> + | None, Some fv -> if fv.Value.Length = 0 then raise(SemanticError(acnErrLoc, "The length of the 'false-value' property must be greater than 0")) else @@ -914,27 +963,6 @@ let rec mapAnyConstraint (asn1:Asn1Ast.AstRoot) (t:Asn1Ast.Asn1Type) (cons:Asn1A let oldBaseType = Asn1Ast.GetBaseTypeByName rf.modName rf.tasName asn1 mapAnyConstraint asn1 oldBaseType cons -let private substAcnArg (acnParamSubst: Map) (arg: AcnGenericTypes.RelativePath): AcnGenericTypes.RelativePath = - match arg with - | RelativePath [] -> arg - | RelativePath (hd :: rest) -> - acnParamSubst.TryFind hd.Value |> - Option.map (fun subst -> match subst with RelativePath subst -> RelativePath (subst @ rest)) |> - Option.defaultValue arg - -let private substAcnArgs (acnParamSubst: Map) (acnArgs : AcnGenericTypes.RelativePath list): AcnGenericTypes.RelativePath list = - acnArgs |> List.map (substAcnArg acnParamSubst) - -let private addAcnSubst (acnParamSubst: Map) - (acnParams: AcnParameter list) - (acnArgs : AcnGenericTypes.RelativePath list): Map = - assert (acnParams.Length = acnArgs.Length) - let add (curr: Map) (p: AcnParameter, acnArg: AcnGenericTypes.RelativePath): Map = - let substed = substAcnArg curr acnArg - curr |> Map.add p.name substed - - List.fold add acnParamSubst (List.zip acnParams acnArgs) - let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Module) (t:Asn1Ast.Asn1Type) (curPath : ScopeNode list) (typeDefPath : ScopeNode list) (enmItemTypeDefPath : ScopeNode list) @@ -998,12 +1026,12 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo | Asn1Ast.OctetString -> let cons = t.Constraints@refTypeCons |> List.collect fixConstraint |> List.map (ConstraintsMapping.getOctetStringConstraint asn1 t) let wcons = withCons |> List.collect fixConstraint |> List.map (ConstraintsMapping.getOctetStringConstraint asn1 t) - let o, us1 = mergeOctetStringType asn1 t.Location acnErrLoc combinedProperties cons wcons tfdArg us + let o, us1 = mergeOctetStringType asn1 t.Location acnErrLoc combinedProperties cons wcons tfdArg acnParamSubst us OctetString o, us1 | Asn1Ast.BitString namedBitList -> let cons = t.Constraints@refTypeCons |> List.collect fixConstraint |> List.map (ConstraintsMapping.getBitStringConstraint asn1 t) let wcons = withCons |> List.collect fixConstraint |> List.map (ConstraintsMapping.getBitStringConstraint asn1 t) - let o, us1 = mergeBitStringType asn1 namedBitList t.Location acnErrLoc combinedProperties cons wcons tfdArg us + let o, us1 = mergeBitStringType asn1 namedBitList t.Location acnErrLoc combinedProperties cons wcons tfdArg acnParamSubst us BitString o, us1 | Asn1Ast.NullType -> let constraints = [] diff --git a/FrontEndAst/Asn1AcnAst.fs b/FrontEndAst/Asn1AcnAst.fs index f2a7512a4..67a7b1898 100644 --- a/FrontEndAst/Asn1AcnAst.fs +++ b/FrontEndAst/Asn1AcnAst.fs @@ -466,6 +466,7 @@ type OctetString = { acnMaxSizeInBits : BigInteger acnMinSizeInBits : BigInteger acnEncodingClass : SizeableAcnEncodingClass + acnArgs : RelativePath list typeDef : Map } @@ -482,6 +483,7 @@ type BitString = { acnMaxSizeInBits : BigInteger acnMinSizeInBits : BigInteger acnEncodingClass : SizeableAcnEncodingClass + acnArgs : RelativePath list typeDef : Map namedBitList : NamedBit1 list } @@ -684,6 +686,8 @@ type Asn1Type = { )) | Choice ch -> ch.acnArgs | SequenceOf sqf -> sqf.acnArgs + | OctetString os -> os.acnArgs + | BitString bs -> bs.acnArgs | _ -> [] and Asn1TypeKind = diff --git a/FrontEndAst/Language.fs b/FrontEndAst/Language.fs index c043979ae..e10227fa8 100644 --- a/FrontEndAst/Language.fs +++ b/FrontEndAst/Language.fs @@ -172,7 +172,7 @@ with type Asn1TypeOrAcnRefIA5 = | Asn1 of Asn1AcnAst.Asn1Type -| AcnRefIA5 of Asn1AcnAst.AcnReferenceToIA5String +| AcnRefIA5 of ReferenceToType * Asn1AcnAst.AcnReferenceToIA5String // TODO: rename type SequenceOfLikeProofGen = { diff --git a/StgScala/ProofAst.fs b/StgScala/ProofAst.fs index 8f281ec06..1ada4785d 100644 --- a/StgScala/ProofAst.fs +++ b/StgScala/ProofAst.fs @@ -116,7 +116,9 @@ and Expr = | BoolLit of bool | IntLit of IntegerType * bigint | EncDec of string + | IntCast of Expr * IntegerType * IntegerType | This // TODO: Add type + | TripleQMark // TODO: Add type | SelectionExpr of string // TODO: Not ideal @@ -140,6 +142,7 @@ and FunctionCall = { id: Identifier tps: Type list args: Expr list + parameterless: bool } and ApplyLetRec = { id: Identifier @@ -149,6 +152,7 @@ and MethodCall = { recv: Expr id: Identifier args: Expr list + parameterless: bool } and IfExpr = { cond: Expr @@ -271,7 +275,8 @@ let rec substVars (vs: (Var * Expr) list) (inExpr: Expr): Expr = | Plus terms -> Plus (terms |> List.map loop) | Minus (lhs, rhs) -> Minus (loop lhs, loop rhs) | Leq (lhs, rhs) -> Leq (loop lhs, loop rhs) - | BoolLit _ | UnitLit | IntLit _ | EncDec _ | This | SelectionExpr _ -> inExpr + | IntCast (e, from, tto) -> IntCast (loop e, from, tto) + | BoolLit _ | UnitLit | IntLit _ | EncDec _ | This | TripleQMark | SelectionExpr _ -> inExpr if vs.IsEmpty then inExpr else loop inExpr let bitStreamId: Identifier = "BitStream" @@ -313,18 +318,18 @@ let cons (tpe: Type) (head: Expr) (tail: Expr): ClassCtor = {ct = consTpe tpe; a let consExpr (tpe: Type) (head: Expr) (tail: Expr): Expr = ClassCtor (cons tpe head tail) let nil (tpe: Type): ClassCtor = {ct = nilTpe tpe; args = []} let nilExpr (tpe: Type): Expr = ClassCtor (nil tpe) -let reverse (list: Expr): Expr = MethodCall {recv = list; id = "reverse"; args = []} -let isize (list: Expr): Expr = MethodCall {recv = list; id = "isize"; args = []} -let iupdated (list: Expr) (ix: Expr) (v: Expr): Expr = MethodCall {recv = list; id = "iupdated"; args = [ix; v]} +let reverse (list: Expr): Expr = MethodCall {recv = list; id = "reverse"; args = []; parameterless = true} +let isize (list: Expr): Expr = MethodCall {recv = list; id = "isize"; args = []; parameterless = true} +let iupdated (list: Expr) (ix: Expr) (v: Expr): Expr = MethodCall {recv = list; id = "iupdated"; args = [ix; v]; parameterless = true} -let iapply (list: Expr) (ix: Expr): Expr = MethodCall {recv = list; id = "iapply"; args = [ix]} +let iapply (list: Expr) (ix: Expr): Expr = MethodCall {recv = list; id = "iapply"; args = [ix]; parameterless = true} let vecTpe (tpe: Type): ClassType = {ClassType.id = vecId; tps = [tpe]} -let vecApply (vec: Expr) (ix: Expr): Expr = MethodCall {recv = vec; id = "apply"; args = [ix]} -let vecSize (vec: Expr): Expr = MethodCall {recv = vec; id = "size"; args = []} -let vecList (vec: Expr): Expr = MethodCall {recv = vec; id = "list"; args = []} -let vecAppend (vec: Expr) (v: Expr): Expr = MethodCall {recv = vec; id = "append"; args = [v]} -let vecEmpty (tpe: Type): Expr = FunctionCall {prefix = [vecId]; id = "empty"; tps = [tpe]; args = []} +let vecApply (vec: Expr) (ix: Expr): Expr = MethodCall {recv = vec; id = "apply"; args = [ix]; parameterless = true} +let vecSize (vec: Expr): Expr = MethodCall {recv = vec; id = "size"; args = []; parameterless = true} +let vecList (vec: Expr): Expr = MethodCall {recv = vec; id = "list"; args = []; parameterless = true} +let vecAppend (vec: Expr) (v: Expr): Expr = MethodCall {recv = vec; id = "append"; args = [v]; parameterless = true} +let vecEmpty (tpe: Type): Expr = FunctionCall {prefix = [vecId]; id = "empty"; tps = [tpe]; args = []; parameterless = true} let optionTpe (tpe: Type): ClassType = {ClassType.id = optionId; tps = [tpe]} let someTpe (tpe: Type): ClassType = {ClassType.id = someId; tps = [tpe]} @@ -342,10 +347,10 @@ let someMutExpr (tpe: Type) (e: Expr): Expr = ClassCtor (someMut tpe e) let noneMut (tpe: Type): ClassCtor = {ct = noneMutTpe tpe; args = []} let noneMutExpr (tpe: Type): Expr = ClassCtor (noneMut tpe) -let isDefinedExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "isDefined"; args = []} +let isDefinedExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "isDefined"; args = []; parameterless = true} let isDefinedMutExpr (recv: Expr): Expr = isDefinedExpr recv // TODO: We can't distinguish symbols right now -let getMutExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "get"; args = []} +let getMutExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "get"; args = []; parameterless = true} let getExpr (recv: Expr): Expr = getMutExpr recv // TODO: We can't distinguish symbols right now @@ -356,7 +361,7 @@ let left (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = leftTpe l r; args = [e let leftExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (left l r e) let right (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = rightTpe l r; args = [e]} let rightExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (right l r e) -let isRightExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "isRight"; args = []} +let isRightExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "isRight"; args = []; parameterless = true} let isRightMutExpr (recv: Expr): Expr = isRightExpr recv // TODO: We can't distinguish symbols right now let eitherMutTpe (l: Type) (r: Type): ClassType = {ClassType.id = eitherMutId; tps = [l; r]} @@ -470,7 +475,7 @@ let longlit (l: bigint): Expr = IntLit (Long, l) let ulonglit (l: bigint): Expr = IntLit (ULong, l) let plus (terms: Expr list): Expr = - assert (not terms.IsEmpty) + assert (not terms.IsEmpty) // We don't know what the type of the "0" is (if we were to return that in case there are no terms), so we enforce at least one element let rec flattenAdd (e: Expr): Expr list = match e with @@ -529,51 +534,58 @@ let letsIn (bdgs: (Var * Expr) list) (body: Expr): Expr = let letsGhostIn (bdgs: (Var * Expr) list) (body: Expr): Expr = List.foldBack (fun (v, e) body -> LetGhost {bdg = v; e = e; body = body}) bdgs body -let selBase (recv: Expr): Expr = FieldSelect (recv, "base") +let selBaseACN (recv: Expr): Expr = FieldSelect (recv, "base") -let selBitStream (recv: Expr): Expr = FieldSelect (selBase recv, "bitStream") +let selBitStreamCodec (recv: Expr): Expr = FieldSelect (recv, "bitStream") +let selBitStreamACN (recv: Expr): Expr = FieldSelect (selBaseACN recv, "bitStream") -let selBuf (recv: Expr): Expr = FieldSelect (selBase recv, "buf") +let selBufBitStream (recv: Expr): Expr = FieldSelect (recv, "buf") +let selBufCodec (recv: Expr): Expr = FieldSelect (selBitStreamCodec recv, "buf") +let selBufACN (recv: Expr): Expr = FieldSelect (selBaseACN recv, "buf") -let selBufLength (recv: Expr): Expr = ArrayLength (selBuf recv) +let selBufLengthBitStream (recv: Expr): Expr = ArrayLength recv +let selBufLengthCodec (recv: Expr): Expr = ArrayLength (selBufCodec recv) +let selBufLengthACN (recv: Expr): Expr = ArrayLength (selBufACN recv) -let selCurrentByteACN (recv: Expr): Expr = FieldSelect (selBitStream recv, "currentByte") +let selCurrentByteACN (recv: Expr): Expr = FieldSelect (selBitStreamACN recv, "currentByte") -let selCurrentBitACN (recv: Expr): Expr = FieldSelect (selBitStream recv, "currentBit") +let selCurrentBitACN (recv: Expr): Expr = FieldSelect (selBitStreamACN recv, "currentBit") -let bitIndexACN (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStream recv; args = [] } +let bitIndexBitStream (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = recv; args = []; parameterless = true } +let bitIndexCodec (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStreamCodec recv; args = []; parameterless = true } +let bitIndexACN (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStreamACN recv; args = []; parameterless = true } -let resetAtACN (recv: Expr) (arg: Expr): Expr = MethodCall { id = "resetAt"; recv = recv; args = [arg] } +let resetAtACN (recv: Expr) (arg: Expr): Expr = MethodCall { id = "resetAt"; recv = recv; args = [arg]; parameterless = true } -let withMovedBitIndexACN (recv: Expr) (diff: Expr): Expr = MethodCall { id = "withMovedBitIndex"; recv = recv; args = [diff] } +let withMovedBitIndexACN (recv: Expr) (diff: Expr): Expr = MethodCall { id = "withMovedBitIndex"; recv = recv; args = [diff]; parameterless = true } -let invariant (recv: Expr): Expr = FunctionCall { prefix = [bitStreamId]; id = "invariant"; tps = []; args = [selCurrentBitACN recv; selCurrentByteACN recv; selBufLength recv] } +let invariant (recv: Expr): Expr = FunctionCall { prefix = [bitStreamId]; id = "invariant"; tps = []; args = [selCurrentBitACN recv; selCurrentByteACN recv; selBufLengthACN recv]; parameterless = true } -let getBitCountUnsigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetBitCountUnsigned"; tps = []; args = [arg] } +let getBitCountUnsigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetBitCountUnsigned"; tps = []; args = [arg]; parameterless = true } -let validateOffsetBitsACN (recv: Expr) (offset: Expr): Expr = MethodCall { id = "validate_offset_bits"; recv = selBitStream recv; args = [offset] } +let validateOffsetBitsACN (recv: Expr) (offset: Expr): Expr = MethodCall { id = "validate_offset_bits"; recv = selBitStreamACN recv; args = [offset]; parameterless = true } -let isPrefixOfACN (recv: Expr) (other: Expr): Expr = MethodCall { id = "isPrefixOf"; recv = selBitStream recv; args = [selBitStream other] } +let isPrefixOfACN (recv: Expr) (other: Expr): Expr = MethodCall { id = "isPrefixOf"; recv = selBitStreamACN recv; args = [selBitStreamACN other]; parameterless = true } -let callSize (recv: Expr) (offset: Expr): Expr = MethodCall { id = "size"; recv = recv; args = [offset] } +let callSize (recv: Expr) (offset: Expr): Expr = MethodCall { id = "size"; recv = recv; args = [offset]; parameterless = true } // let sizeRange (recv: Expr) (offset: Expr) (from: Expr) (tto: Expr): Expr = MethodCall { id = "sizeRange"; recv = recv; args = [offset; from; tto] } -let getLengthForEncodingSigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetLengthForEncodingSigned"; tps = []; args = [arg] } +let getLengthForEncodingSigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetLengthForEncodingSigned"; tps = []; args = [arg]; parameterless = true } -let acnReader (oldCdc: Expr) (cdc: Expr): Expr = FunctionCall { prefix = [acnId]; id = "reader"; tps = []; args = [oldCdc; cdc] } +let acnReader (oldCdc: Expr) (cdc: Expr): Expr = FunctionCall { prefix = [acnId]; id = "reader"; tps = []; args = [oldCdc; cdc]; parameterless = true } let stringLength (recv: Expr): Expr = FieldSelect (recv, "nCount") -let indexOfOrLength (recv: Expr) (elem: Expr): Expr = MethodCall {recv = recv; id = "indexOfOrLength"; args = [elem]} +let indexOfOrLength (recv: Expr) (elem: Expr): Expr = MethodCall {recv = recv; id = "indexOfOrLength"; args = [elem]; parameterless = true} let stringCapacity (recv: Expr): Expr = ArrayLength (FieldSelect (recv, "arr")) -let alignedToByte (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToByte"; tps = []; args = [bits]} +let alignedToByte (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToByte"; tps = []; args = [bits]; parameterless = true} -let alignedToWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToWord"; tps = []; args = [bits]} +let alignedToWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToWord"; tps = []; args = [bits]; parameterless = true} -let alignedToDWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToDWord"; tps = []; args = [bits]} +let alignedToDWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToDWord"; tps = []; args = [bits]; parameterless = true} @@ -584,11 +596,11 @@ let alignedTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr): Exp | Some AcnGenericTypes.NextWord -> alignedToWord bits | Some AcnGenericTypes.NextDWord -> alignedToDWord bits -let alignedSizeToByte (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToByte"; tps = []; args = [bits; offset]} +let alignedSizeToByte (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToByte"; tps = []; args = [bits; offset]; parameterless = true} -let alignedSizeToWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToWord"; tps = []; args = [bits; offset]} +let alignedSizeToWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToWord"; tps = []; args = [bits; offset]; parameterless = true} -let alignedSizeToDWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToDWord"; tps = []; args = [bits; offset]} +let alignedSizeToDWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToDWord"; tps = []; args = [bits; offset]; parameterless = true} let alignedSizeTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr) (offset: Expr): Expr = match alignment with @@ -598,92 +610,92 @@ let alignedSizeTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr) | Some AcnGenericTypes.NextDWord -> alignedSizeToDWord bits offset let validReflexiveLemma (b: Expr): Expr = - FunctionCall { prefix = [bitStreamId]; id = "validReflexiveLemma"; tps = []; args = [selBitStream b] } + FunctionCall { prefix = [bitStreamId]; id = "validReflexiveLemma"; tps = []; args = [selBitStreamACN b]; parameterless = true } let validTransitiveLemma (b1: Expr) (b2: Expr) (b3: Expr): Expr = - FunctionCall { prefix = [bitStreamId]; id = "validTransitiveLemma"; tps = []; args = [selBitStream b1; selBitStream b2; selBitStream b3] } + FunctionCall { prefix = [bitStreamId]; id = "validTransitiveLemma"; tps = []; args = [selBitStreamACN b1; selBitStreamACN b2; selBitStreamACN b3]; parameterless = true } let validateOffsetBitsIneqLemma (b1: Expr) (b2: Expr) (b1ValidateOffsetBits: Expr) (advancedAtMostBits: Expr): Expr = - FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsIneqLemma"; tps = []; args = [b1; b2; b1ValidateOffsetBits; advancedAtMostBits] } + FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsIneqLemma"; tps = []; args = [b1; b2; b1ValidateOffsetBits; advancedAtMostBits]; parameterless = true } let validateOffsetBitsWeakeningLemma (b: Expr) (origOffset: Expr) (newOffset: Expr): Expr = - FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsWeakeningLemma"; tps = []; args = [b; origOffset; newOffset] } + FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsWeakeningLemma"; tps = []; args = [b; origOffset; newOffset]; parameterless = true } let validateOffsetBitsContentIrrelevancyLemma (b1: Expr) (buf: Expr) (bits: Expr): Expr = - FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsContentIrrelevancyLemma"; tps = []; args = [b1; buf; bits] } + FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsContentIrrelevancyLemma"; tps = []; args = [b1; buf; bits]; parameterless = true } let arrayRangesEqReflexiveLemma (arr: Expr): Expr = - FunctionCall { prefix = []; id = "arrayRangesEqReflexiveLemma"; tps = []; args = [arr] } + FunctionCall { prefix = []; id = "arrayRangesEqReflexiveLemma"; tps = []; args = [arr]; parameterless = true } let arrayRangesEqSlicedLemma (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr) (fromSlice: Expr) (toSlice: Expr): Expr = - FunctionCall { prefix = []; id = "arrayRangesEqSlicedLemma"; tps = []; args = [a1; a2; from; tto; fromSlice; toSlice] } + FunctionCall { prefix = []; id = "arrayRangesEqSlicedLemma"; tps = []; args = [a1; a2; from; tto; fromSlice; toSlice]; parameterless = true } let arrayUpdatedAtPrefixLemma (arr: Expr) (at: Expr) (v: Expr): Expr = - FunctionCall { prefix = []; id = "arrayUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v] } + FunctionCall { prefix = []; id = "arrayUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v]; parameterless = true } let arrayRangesEqTransitive (a1: Expr) (a2: Expr) (a3: Expr) (from: Expr) (mid: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "arrayRangesEqTransitive"; tps = []; args = [a1; a2; a3; from; mid; tto] } + FunctionCall { prefix = []; id = "arrayRangesEqTransitive"; tps = []; args = [a1; a2; a3; from; mid; tto]; parameterless = true } let arrayRangesEqImpliesEq (a1: Expr) (a2: Expr) (from: Expr) (at: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "arrayRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto] } + FunctionCall { prefix = []; id = "arrayRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto]; parameterless = true } let arrayRangesEq (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "arrayRangesEq"; tps = []; args = [a1; a2; from; tto] } + FunctionCall { prefix = []; id = "arrayRangesEq"; tps = []; args = [a1; a2; from; tto]; parameterless = true } let arrayBitRangesEq (a1: Expr) (a2: Expr) (fromBit: Expr) (toBit: Expr): Expr = - FunctionCall { prefix = []; id = "arrayBitRangesEq"; tps = []; args = [a1; a2; fromBit; toBit] } + FunctionCall { prefix = []; id = "arrayBitRangesEq"; tps = []; args = [a1; a2; fromBit; toBit]; parameterless = true } let arrayBitRangesEqSlicedLemma (a1: Expr) (a2: Expr) (fromBit: Expr) (toBit: Expr) (fromSlice: Expr) (toSlice: Expr): Expr = - FunctionCall { prefix = []; id = "arrayBitRangesEqSlicedLemma"; tps = []; args = [a1; a2; fromBit; toBit; fromSlice; toSlice] } + FunctionCall { prefix = []; id = "arrayBitRangesEqSlicedLemma"; tps = []; args = [a1; a2; fromBit; toBit; fromSlice; toSlice]; parameterless = true } let listRangesEqReflexiveLemma (arr: Expr): Expr = - FunctionCall { prefix = []; id = "listRangesEqReflexiveLemma"; tps = []; args = [arr] } + FunctionCall { prefix = []; id = "listRangesEqReflexiveLemma"; tps = []; args = [arr]; parameterless = true } let listRangesEqSlicedLemma (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr) (fromSlice: Expr) (toSlice: Expr): Expr = - FunctionCall { prefix = []; id = "listRangesEqSlicedLemma"; tps = []; args = [a1; a2; from; tto; fromSlice; toSlice] } + FunctionCall { prefix = []; id = "listRangesEqSlicedLemma"; tps = []; args = [a1; a2; from; tto; fromSlice; toSlice]; parameterless = true } let listUpdatedAtPrefixLemma (arr: Expr) (at: Expr) (v: Expr): Expr = - FunctionCall { prefix = []; id = "listUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v] } + FunctionCall { prefix = []; id = "listUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v]; parameterless = true } let listRangesEqTransitive (a1: Expr) (a2: Expr) (a3: Expr) (from: Expr) (mid: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "listRangesEqTransitive"; tps = []; args = [a1; a2; a3; from; mid; tto] } + FunctionCall { prefix = []; id = "listRangesEqTransitive"; tps = []; args = [a1; a2; a3; from; mid; tto]; parameterless = true } let listRangesEqImpliesEq (a1: Expr) (a2: Expr) (from: Expr) (at: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "listRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto] } + FunctionCall { prefix = []; id = "listRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto]; parameterless = true } let listRangesEq (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "listRangesEq"; tps = []; args = [a1; a2; from; tto] } + FunctionCall { prefix = []; id = "listRangesEq"; tps = []; args = [a1; a2; from; tto]; parameterless = true } let listRangesAppendDropEq (a1: Expr) (a2: Expr) (v: Expr) (from: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "listRangesAppendDropEq"; tps = []; args = [a1; a2; v; from; tto] } + FunctionCall { prefix = []; id = "listRangesAppendDropEq"; tps = []; args = [a1; a2; v; from; tto]; parameterless = true } let isnocIndex (ls: Expr) (v: Expr) (i: Expr): Expr = - FunctionCall { prefix = ["ListSpecs"]; id = "isnocIndex"; tps = []; args = [ls; v; i] } + FunctionCall { prefix = ["ListSpecs"]; id = "isnocIndex"; tps = []; args = [ls; v; i]; parameterless = true } let listApplyEqVecApply (vec: Expr) (i: Expr): Expr = - FunctionCall { prefix = ["Vector"]; id = "listApplyEqVecApply"; tps = []; args = [vec; i] } + FunctionCall { prefix = ["Vector"]; id = "listApplyEqVecApply"; tps = []; args = [vec; i]; parameterless = true } let vecRangesEqReflexiveLemma (arr: Expr): Expr = - FunctionCall { prefix = []; id = "vecRangesEqReflexiveLemma"; tps = []; args = [arr] } + FunctionCall { prefix = []; id = "vecRangesEqReflexiveLemma"; tps = []; args = [arr]; parameterless = true } let vecRangesEqSlicedLemma (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr) (fromSlice: Expr) (toSlice: Expr): Expr = - FunctionCall { prefix = []; id = "vecRangesEqSlicedLemma"; tps = []; args = [a1; a2; from; tto; fromSlice; toSlice] } + FunctionCall { prefix = []; id = "vecRangesEqSlicedLemma"; tps = []; args = [a1; a2; from; tto; fromSlice; toSlice]; parameterless = true } let vecUpdatedAtPrefixLemma (arr: Expr) (at: Expr) (v: Expr): Expr = - FunctionCall { prefix = []; id = "vecUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v] } + FunctionCall { prefix = []; id = "vecUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v]; parameterless = true } let vecRangesEqTransitive (a1: Expr) (a2: Expr) (a3: Expr) (from: Expr) (mid: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "vecRangesEqTransitive"; tps = []; args = [a1; a2; a3; from; mid; tto] } + FunctionCall { prefix = []; id = "vecRangesEqTransitive"; tps = []; args = [a1; a2; a3; from; mid; tto]; parameterless = true } let vecRangesEqImpliesEq (a1: Expr) (a2: Expr) (from: Expr) (at: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "vecRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto] } + FunctionCall { prefix = []; id = "vecRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto]; parameterless = true } let vecRangesEq (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "vecRangesEq"; tps = []; args = [a1; a2; from; tto] } + FunctionCall { prefix = []; id = "vecRangesEq"; tps = []; args = [a1; a2; from; tto]; parameterless = true } let vecRangesAppendDropEq (a1: Expr) (a2: Expr) (v: Expr) (from: Expr) (tto: Expr): Expr = - FunctionCall { prefix = []; id = "vecRangesAppendDropEq"; tps = []; args = [a1; a2; v; from; tto] } + FunctionCall { prefix = []; id = "vecRangesAppendDropEq"; tps = []; args = [a1; a2; v; from; tto]; parameterless = true } let fromIntClass (cls: Asn1AcnAst.IntegerClass): IntegerType = @@ -1053,13 +1065,13 @@ and ppExprBody (ctx: PrintCtx) (e: Expr): Line list = | MethodCall call -> let recv = ppExpr (ctx.nestExpr call.recv) call.recv let args = call.args |> List.map (fun a -> ppExpr (ctx.nestExpr a) a) - joinCallLike ctx (append ctx $".{call.id}" recv) args true + joinCallLike ctx (append ctx $".{call.id}" recv) args call.parameterless | FunctionCall call -> let id = if call.prefix.IsEmpty then call.id else (call.prefix.StrJoin ".") + "." + call.id let args = call.args |> List.map (fun a -> ppExpr (ctx.nestExpr a) a) let tps = if call.tps.IsEmpty then "" else "[" + (call.tps |> List.map ppType).StrJoin ", " + "]" - joinCallLike ctx [line (id + tps)] args true + joinCallLike ctx [line (id + tps)] args call.parameterless | LetRec lr -> let fds = lr.fds |> List.collect (fun fd -> ppFunDefLike (ctx.nest (LocalFunDefTree fd)) fd) @@ -1178,10 +1190,23 @@ and ppExprBody (ctx: PrintCtx) (e: Expr): Line list = | MatchExpr mexpr -> optP ctx (ppMatchExpr ctx mexpr) + | IntCast (e2, from, tto) -> + let e2 = ppExpr (ctx.nestExpr e2) e2 + let extMeth (id: string) = + joinCallLike ctx (append ctx $".{id}" e2) [] true + let objFn (id: string) = + joinCallLike ctx [line id] [e2] false + match from, tto with + | ULong, Long | UInt, Int | UShort, Short | UByte, Byte -> extMeth "toRaw" + | Long, ULong | Int, UInt | Short, UShort | Byte, UByte -> objFn "fromRaw" + | _ -> failwith $"Unsupported conversion {from} -> {tto}" + | SelectionExpr sel -> [line sel] | This -> [line "this"] + | TripleQMark -> [line "???"] + | EncDec stmt -> (stmt.Split [|'\n'|]) |> Array.toList |> List.map line diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 85d188c42..5a6d3d959 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -155,7 +155,7 @@ let sizeLemmaIdForType (tp: Asn1AcnAst.Asn1TypeKind) (align: AcnAlignment option | _ -> None let sizeLemmaCall (tp: Asn1AcnAst.Asn1TypeKind) (align: AcnAlignment option) (recv: Expr) (offset: Expr) (otherOffset: Expr): Expr option = - sizeLemmaIdForType tp align |> Option.map (fun id -> MethodCall {recv = recv; id = id; args = [offset; otherOffset]}) + sizeLemmaIdForType tp align |> Option.map (fun id -> MethodCall {recv = recv; id = id; args = [offset; otherOffset]; parameterless = true}) let stringInvariants (minSize: bigint) (maxSize: bigint) (recv: Expr): Expr = // TODO: If minSize = maxSize, we can still have '\0' before `maxSize`, right? @@ -439,16 +439,18 @@ let optionalSizeExpr (child: Asn1AcnAst.Asn1Child) (offset: Expr) (nestingLevel: bigint) (nestingIx: bigint): SizeExprRes = - let sz = + let sz (recv: Expr) = match child.Type.Kind with | Choice _ | Sequence _ | SequenceOf _ -> - {bdgs = []; resSize = callSize (getMutExpr obj) offset} - | _ -> asn1SizeExpr child.Type.acnAlignment child.Type.Kind (getMutExpr obj) offset nestingLevel nestingIx + {bdgs = []; resSize = callSize recv offset} + | _ -> asn1SizeExpr child.Type.acnAlignment child.Type.Kind recv offset nestingLevel nestingIx match child.Optionality with - | Some AlwaysPresent -> sz - | Some AlwaysAbsent -> {sz with resSize = longlit 0I} - | _ -> {sz with resSize = IfExpr {cond = isDefinedMutExpr obj; thn = sz.resSize; els = longlit 0I}} - + | Some AlwaysPresent -> sz (getMutExpr obj) + | Some AlwaysAbsent -> {bdgs = []; resSize = longlit 0I} + | Some (Optional _) -> + let res = sz (getMutExpr obj) + {res with resSize = IfExpr {cond = isDefinedMutExpr obj; thn = res.resSize; els = longlit 0I}} + | None -> sz obj let seqSizeFunDefs (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence): FunDef list = // TODO: Pour les int, on peut ajouter une assertion GetBitUnsignedCount(...) == resultat (ici et/ou ailleurs) @@ -568,6 +570,7 @@ let seqOfSizeFunDefs (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.SequenceOf): FunDe id = "sizeRange" tps = [] args = [ls; offset; from; tto] + parameterless = true } let offsetCondHelper (offset: Var) (from: Var) (tto: Var): Expr = @@ -678,6 +681,7 @@ let seqOfSizeFunDefs (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.SequenceOf): FunDe plus [Var from; int32lit 1I] Var tto ] + parameterless = true } let proofElsePart = mkBlock ([ elemSizeAssert elemSizeOffVar @@ -705,7 +709,7 @@ let seqOfSizeFunDefs (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.SequenceOf): FunDe returnTpe = UnitType body = proofBody } - let objCall = FunctionCall {prefix = [td]; id = objFd.id; tps = []; args = [FieldSelect (This, "arr"); Var offset; Var otherOffset; int32lit 0I; FieldSelect (This, "nCount")]} + let objCall = FunctionCall {prefix = [td]; id = objFd.id; tps = []; args = [FieldSelect (This, "arr"); Var offset; Var otherOffset; int32lit 0I; FieldSelect (This, "nCount")]; parameterless = true} let clsFd = {template with body = objCall} clsFd, objFd @@ -791,8 +795,8 @@ let generateEncodePostcondExprCommon (r: Asn1AcnAst.AstRoot) let r1 = {Var.name = "r1"; tpe = ClassType codecTpe} let r2 = {Var.name = "r2"; tpe = ClassType codecTpe} let readerCall = acnReader oldCdc (Var cdc) - let lemmaCall = validateOffsetBitsContentIrrelevancyLemma (selBitStream oldCdc) (selBuf (Var cdc)) (longlit maxSize) - let decodePureCall = FunctionCall {prefix = []; id = decodePureId; tps = []; args = (Var r1) :: decodeExtraArgs} + let lemmaCall = validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN oldCdc) (selBufACN (Var cdc)) (longlit maxSize) + let decodePureCall = FunctionCall {prefix = []; id = decodePureId; tps = []; args = (Var r1) :: decodeExtraArgs; parameterless = true} let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} let decodingRes = {Var.name = "decodingRes"; tpe = ClassType (eitherMutTpe (IntegerType Int) tpe)} let resGot = {Var.name = "resGot"; tpe = tpe} @@ -835,7 +839,7 @@ let generateEncodePostcondExprCommon (r: Asn1AcnAst.AstRoot) [prefix; Locally boundCall] let rightBody = And (extraCondsPre @ [ - Equals (selBufLength oldCdc, selBufLength (Var cdc)) + Equals (selBufLengthACN oldCdc, selBufLengthACN (Var cdc)) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) ] @ invertibility) let rightBody = letsIn sz.bdgs rightBody @@ -867,7 +871,7 @@ let generateDecodePostcondExprCommon (r: Asn1AcnAst.AstRoot) (resPostcond: Var) let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} let oldCdc = Old (Var cdc) let rightBody = And (extraCondsPre @ [ - Equals (selBuf oldCdc, selBuf (Var cdc)) + Equals (selBufACN oldCdc, selBufACN (Var cdc)) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) ] @ extraCondsPost) let rightBody = letsIn sz.bdgs rightBody @@ -908,7 +912,7 @@ let generateDecodePostcondExpr (r: Asn1AcnAst.AstRoot) (t: Asn1AcnAst.Asn1Type) | NullType _ -> [] | _ -> let isValidFuncName = $"{t.FT_TypeDefinition.[Scala].typeName}_IsConstraintValid" - [isRightExpr (FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var szRecv]})] + [isRightExpr (FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var szRecv]; parameterless = true})] generateDecodePostcondExprCommon r resPostcond szRecv sz [] (strSize @ cstrIsValid) let rec tryFindFirstParentACNDependency (parents: Asn1AcnAst.Asn1Type list) (dep: RelativePath): (Asn1AcnAst.Asn1Type * Asn1AcnAst.AcnChild) option = @@ -970,6 +974,8 @@ let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: )) | Choice ch -> ch.acnArgs | SequenceOf sqf -> sqf.acnArgs + | OctetString os -> os.acnArgs + | BitString bs -> bs.acnArgs | _ -> [] match firstOutermostSeqParent (nestingScope.parents |> List.map snd) with | None -> None @@ -994,82 +1000,178 @@ let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: let nme = seqParent.id.lastItem Some {Var.name = nme; tpe = tpe} -type PrimitivePrefixLemma = { +type PrimitiveDecodeInfo = { prefix: string list - id: string + decodePureId: string + prefixLemmaId: string extraConstArgs: Expr list } -type ComposedPrefixLemma = { - id: string +type ComposedDecodeInfo = { + decodePureId: string + prefixLemmaId: string } -type PrefixLemmaInfo = -| PrimitivePrefixLemma of PrimitivePrefixLemma -| ComposedPrefixLemma of ComposedPrefixLemma +type DecodeInfo = +| PrimitiveDecodeInfo of PrimitiveDecodeInfo +| ComposedDecodeInfo of ComposedDecodeInfo + +let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bool): DecodeInfo = + let forACNIntClass (encCls: IntEncodingClass): PrimitiveDecodeInfo = + match encCls with + | PositiveInteger_ConstSize_8 -> + let baseId = "dec_Int_PositiveInteger_ConstSize_8" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | PositiveInteger_ConstSize_big_endian_16 -> + let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_16" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | PositiveInteger_ConstSize_big_endian_32 -> + let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_32" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | PositiveInteger_ConstSize_big_endian_64 -> + let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_64" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | PositiveInteger_ConstSize_little_endian_16 -> + let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_16" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | PositiveInteger_ConstSize_little_endian_32 -> + let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_32" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | PositiveInteger_ConstSize_little_endian_64 -> + let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_64" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | PositiveInteger_ConstSize bits -> + let baseId = "dec_Int_PositiveInteger_ConstSize" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [int32lit bits]} + + | TwosComplement_ConstSize_8 -> + let baseId = "dec_Int_TwosComplement_ConstSize_8" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | TwosComplement_ConstSize_big_endian_16 -> + let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_16" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | TwosComplement_ConstSize_big_endian_32 -> + let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_32" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | TwosComplement_ConstSize_big_endian_64 -> + let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_64" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | TwosComplement_ConstSize_little_endian_16 -> + let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_16" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | TwosComplement_ConstSize_little_endian_32 -> + let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_32" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | TwosComplement_ConstSize_little_endian_64 -> + let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_64" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | TwosComplement_ConstSize _ -> + let baseId = "dec_Int_TwosComplement_ConstSize" + {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | Integer_uPER -> failwith "UPER encoding selected for ACN integers?" + + | _ -> failwith $"TODO: {encCls}" -let readPrefixLemmaIdentifier (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bool): PrefixLemmaInfo = - let forIntClass (intCls:Asn1AcnAst.IntegerClass) (encCls: IntEncodingClass) (range: BigIntegerUperRange): PrimitivePrefixLemma = + let forIntClass (intCls:Asn1AcnAst.IntegerClass) (encCls: IntEncodingClass) (range: BigIntegerUperRange): PrimitiveDecodeInfo = match encCls with - | PositiveInteger_ConstSize_8 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_8_prefixLemma"; extraConstArgs = []} - | PositiveInteger_ConstSize_big_endian_16 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_16_prefixLemma"; extraConstArgs = []} - | PositiveInteger_ConstSize_big_endian_32 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_32_prefixLemma"; extraConstArgs = []} - | PositiveInteger_ConstSize_big_endian_64 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_big_endian_64_prefixLemma"; extraConstArgs = []} - | PositiveInteger_ConstSize_little_endian_16 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_16_prefixLemma"; extraConstArgs = []} - | PositiveInteger_ConstSize_little_endian_32 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_32_prefixLemma"; extraConstArgs = []} - | PositiveInteger_ConstSize_little_endian_64 -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_little_endian_64_prefixLemma"; extraConstArgs = []} - | PositiveInteger_ConstSize bits -> {prefix = [acnId]; id = "dec_Int_PositiveInteger_ConstSize_prefixLemma"; extraConstArgs = [int32lit bits]} - | TwosComplement_ConstSize_8 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_8_prefixLemma"; extraConstArgs = []} - | TwosComplement_ConstSize_big_endian_16 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_16_prefixLemma"; extraConstArgs = []} - | TwosComplement_ConstSize_big_endian_32 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_32_prefixLemma"; extraConstArgs = []} - | TwosComplement_ConstSize_big_endian_64 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_big_endian_64_prefixLemma"; extraConstArgs = []} - | TwosComplement_ConstSize_little_endian_16 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_16_prefixLemma"; extraConstArgs = []} - | TwosComplement_ConstSize_little_endian_32 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_32_prefixLemma"; extraConstArgs = []} - | TwosComplement_ConstSize_little_endian_64 -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_little_endian_64_prefixLemma"; extraConstArgs = []} - | TwosComplement_ConstSize _ -> {prefix = [acnId]; id = "dec_Int_TwosComplement_ConstSize_prefixLemma"; extraConstArgs = []} | Integer_uPER -> match range with - | Full -> {prefix = [codecId]; id = "decodeUnconstrainedWholeNumber_prefixLemma"; extraConstArgs = []} - | PosInf min -> {prefix = [codecId]; id = "decodeConstrainedPosWholeNumber_prefixLemma"; extraConstArgs = [ulonglit min]} + | Full -> + let baseId = "decodeUnconstrainedWholeNumber" + {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + | PosInf min -> + let baseId = "decodeConstrainedPosWholeNumber" + {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min]} | Concrete (min, max) -> - if intCls.IsPositive then {prefix = [codecId]; id = "decodeConstrainedPosWholeNumber_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} - else {prefix = [codecId]; id = "decodeConstrainedWholeNumber_prefixLemma"; extraConstArgs = [longlit min; longlit max]} + if intCls.IsPositive then + let baseId = "decodeConstrainedPosWholeNumber" + {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} + else + let baseId = "decodeConstrainedWholeNumber" + {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit min; longlit max]} | _ -> failwith $"TODO: {range}" - | _ -> failwith $"TODO: {encCls}" + | _ -> forACNIntClass encCls + + let octetString (ot: OctetString) = + PrimitiveDecodeInfo {prefix = [codecId]; decodePureId = "decodeOctetString_no_length_vec_pure"; prefixLemmaId = "decodeOctetString_no_length_vec_prefixLemma"; extraConstArgs = [int32lit (ot.maxSize.acn)]} + let bitString (bt: BitString) = + PrimitiveDecodeInfo {prefix = [bitStreamId]; decodePureId = "readBitsVecPure"; prefixLemmaId = "readBitsVecPrefixLemma"; extraConstArgs = [longlit bt.maxSize.acn]} + let boolean = PrimitiveDecodeInfo {prefix = [bitStreamId]; decodePureId = "readBitPure"; prefixLemmaId = "readBitPrefixLemma"; extraConstArgs = []} if isOptional then - ComposedPrefixLemma {id = $"{ToC id.dropModule.AsString}_Optional_prefixLemma"} + let baseId = $"{ToC id.dropModule.AsString}_Optional" + ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} else match t with | Asn1 t -> match t.Kind with - | Integer int -> PrimitivePrefixLemma (forIntClass int.intClass int.acnEncodingClass int.uperRange) - | Boolean _ -> PrimitivePrefixLemma {prefix = [bitStreamId]; id = "readBitPrefixLemma"; extraConstArgs = []} + | Integer int -> PrimitiveDecodeInfo (forIntClass int.intClass int.acnEncodingClass int.uperRange) + | BitString bt -> bitString bt + | OctetString ot -> octetString ot + | Boolean _ -> boolean | ReferenceType rt -> match rt.resolvedType.ActualType.Kind with - | BitString _ -> - // TODO: Why don't we have a wrapper function for bitstrings? - PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO + | BitString bt -> bitString bt | IA5String str -> match str.acnEncodingClass with - | Acn_Enc_String_uPER _ -> ComposedPrefixLemma {id = $"{t.ActualType.FT_TypeDefinition.[Scala].typeName}_prefixLemma"} - | _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO - | OctetString _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO + | Acn_Enc_String_uPER _ -> + let baseId = t.ActualType.FT_TypeDefinition.[Scala].typeName + ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + | _ -> + // TODO: The second argument is the determinant but no idea where to fetch this from, therefore putting a dummy value + let baseId = "dec_IA5String_CharIndex_External_Field_DeterminantVec" + PrimitiveDecodeInfo {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit str.maxSize.acn; longlit 0I]} + | OctetString ot -> octetString ot | _ -> - let id = - if rt.hasExtraConstrainsOrChildrenOrAcnArgs then $"{ToC id.dropModule.AsString}_prefixLemma" - else $"{t.ActualType.FT_TypeDefinition.[Scala].typeName}_prefixLemma" - ComposedPrefixLemma {id = id} - | _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO - | Acn (AcnInteger int) -> PrimitivePrefixLemma (forIntClass int.intClass int.acnEncodingClass int.uperRange) - | Acn (AcnBoolean _) -> PrimitivePrefixLemma {prefix = [bitStreamId]; id = "readBitPrefixLemma"; extraConstArgs = []} - | _ -> PrimitivePrefixLemma {prefix = [acnId]; id = "readPrefixLemma_TODO"; extraConstArgs = []} // TODO - -let selectCodecReadPrefixLemma (prefixLemmaInfo: PrefixLemmaInfo) (cdcSnap: Expr) (cdc: Expr): Expr * Expr = - match prefixLemmaInfo with - | PrimitivePrefixLemma info -> - if info.prefix = [bitStreamId] then selBitStream cdcSnap, selBitStream cdc - else if info.prefix = [codecId] then selBase cdcSnap, selBase cdc - else cdcSnap, cdc - | ComposedPrefixLemma _ -> cdcSnap, cdc + let baseId = + if rt.hasExtraConstrainsOrChildrenOrAcnArgs then $"{ToC id.dropModule.AsString}" + else t.ActualType.FT_TypeDefinition.[Scala].typeName + ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + | Sequence _ | SequenceOf _ | Choice _ -> + let baseId = $"{ToC id.dropModule.AsString}" + ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + | _ -> + let baseId = "TODO_ASN1_OTHER" + PrimitiveDecodeInfo {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO + | Acn (AcnInteger int) -> + PrimitiveDecodeInfo (forIntClass int.intClass int.acnEncodingClass int.uperRange) + | Acn (AcnBoolean _) -> boolean + | Acn (AcnReferenceToEnumerated enm) -> + match enm.enumerated.acnEncodingClass with + | Integer_uPER -> + // Mimicking the logic in createEnumCommon + let min = enm.enumerated.items |> List.map(fun x -> x.acnEncodeValue) |> Seq.min + let max = enm.enumerated.items |> List.map(fun x -> x.acnEncodeValue) |> Seq.max + let baseId = "decodeConstrainedPosWholeNumber" + PrimitiveDecodeInfo {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} + | _ -> PrimitiveDecodeInfo (forACNIntClass enm.enumerated.acnEncodingClass) + | Acn (AcnReferenceToIA5String _) -> + let baseId = $"{ToC id.dropModule.AsString}" + ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + | _ -> + let baseId = "TODO_ACN_OTHER" + PrimitiveDecodeInfo {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO + +let selectCodecDecodeInfo (decodeInfo: DecodeInfo) (cdc: Expr): Expr = + match decodeInfo with + | PrimitiveDecodeInfo info -> + if info.prefix = [bitStreamId] then selBitStreamACN cdc + else if info.prefix = [codecId] then selBaseACN cdc + else cdc + | ComposedDecodeInfo _ -> cdc type PrefixLemmaData = { baseId: string @@ -1110,12 +1212,12 @@ let generatePrefixLemmaCommon (enc: Asn1Encoding) let sz = {Var.name = "sz"; tpe = IntegerType Long} let maxSizeExpr = longlit maxSize let preconds = [ - Precond (Equals (selBufLength (Var c1), selBufLength (Var c2))) + Precond (Equals (selBufLengthACN (Var c1), selBufLengthACN (Var c2))) Precond (validateOffsetBitsACN (Var c1) maxSizeExpr) Precond (And [Leq (longlit 0I, Var sz); Leq (Var sz, maxSizeExpr)]) Precond (arrayBitRangesEq - (selBuf (Var c1)) - (selBuf (Var c2)) + (selBufACN (Var c1)) + (selBufACN (Var c2)) (longlit 0I) (plus [bitIndexACN (Var c1); Var sz]) ) @@ -1126,11 +1228,11 @@ let generatePrefixLemmaCommon (enc: Asn1Encoding) let c1Res = {Var.name = "c1Res"; tpe = ClassType codecTpe} let decodingRes1 = {Var.name = "decodingRes1"; tpe = tpe} let dec1 = {Var.name = "dec1"; tpe = TupleType [c1Res.tpe; decodingRes1.tpe]} - let call1 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = Var c1 :: (paramsAcn |> List.map Var)} + let call1 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = Var c1 :: (paramsAcn |> List.map Var); parameterless = true} let c2Res = {Var.name = "c2Res"; tpe = ClassType codecTpe} let decodingRes2 = {Var.name = "decodingRes2"; tpe = tpe} let dec2 = {Var.name = "dec2"; tpe = TupleType [c2Res.tpe; decodingRes2.tpe]} - let call2 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = Var c2Reset :: (paramsAcn |> List.map Var)} + let call2 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = Var c2Reset :: (paramsAcn |> List.map Var); parameterless = true} let preSpecs = preconds @ [ @@ -1311,7 +1413,7 @@ let generatePrefixLemmaSequenceOfLike (enc: Asn1Encoding) let acns = collectNestedAcnChildren t.Kind let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) baseId, paramsAcn, acnTps - | Asn1TypeOrAcnRefIA5.AcnRefIA5 t -> ToC t.tasName.Value, [], [] // TODO: RM + | Asn1TypeOrAcnRefIA5.AcnRefIA5 (tId, _) -> ToC tId.dropModule.AsString, [], [] generatePrefixLemmaCommon enc tpe (sqf.maxSizeInBits enc) baseId paramsAcn acnTps mkSizeExpr nestingScope mkSqOfLikeProof let generatePrefixLemmaSequence (enc: Asn1Encoding) @@ -1320,12 +1422,17 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) (sq: Sequence): FunDef = let tpe = fromAsn1TypeKind t.Kind - + // TODO: Presence bits!!!! + // TODO: Presence bits!!!! + // TODO: Presence bits!!!! + // TODO: Presence bits!!!! let childrenSizes = [0..sq.children.Length] |> List.map (fun i -> {Var.name = $"size_1_{i}"; tpe = IntegerType Long}) + let bodyWithC1Id = "bodyWithC1" + let bodyWithC2Id = "bodyWithC2" let mkUnfoldedDecodeWrapper (data: PrefixLemmaData) (id: Identifier) (c: Var): FunDef = let cpy = {Var.name = $"{c.name}Cpy"; tpe = c.tpe} - let call = FunctionCall {prefix = []; id = data.decodeId; tps = []; args = [Var cpy]} + let call = FunctionCall {prefix = []; id = data.decodeId; tps = []; args = [Var cpy]; parameterless = true} let body = letsIn [cpy, Snapshot (Var c)] (Unfold call) { FunDef.id = id; @@ -1350,8 +1457,8 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let specs = if ix = 0 then [] else [ - Precond (Equals (selBuf (Var c1), selBuf (Var origC1))) - Precond (Equals (selBuf (Var c2), selBuf (Var origC2Reset))) + Precond (Equals (selBufACN (Var c1), selBufACN (Var origC1))) + Precond (Equals (selBufACN (Var c2), selBufACN (Var origC2Reset))) Precond (Equals (bitIndexACN (Var c1), plus [bitIndexACN (Var origC1); overallOffset])) Precond (Equals (bitIndexACN (Var c1), bitIndexACN (Var c2))) ] @@ -1362,8 +1469,8 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | AcnChild child -> child.Name.Value let slicedLemmaApp = (arrayBitRangesEqSlicedLemma - (selBuf (Var c1)) - (selBuf (Var c2)) + (selBufACN (Var c1)) + (selBufACN (Var c2)) (longlit 0I) (Minus (plus [bitIndexACN (Var c1); Var data.v1SizeVar], overallOffset)) (longlit 0I) @@ -1373,10 +1480,10 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let c2MovedValue = withMovedBitIndexACN (Var c2) (Var childSize) let c2MovedAssertions = [ Assert (Equals (bitIndexACN (Var c2Moved), plus [bitIndexACN (Var c1); Var childSize])) - Assert (arrayBitRangesEq (selBuf (Var c1)) (selBuf (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) + Assert (arrayBitRangesEq (selBufACN (Var c1)) (selBufACN (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) ] - let asn1Tpe, id, isOpt, existArg, paramsAcn = + let fieldName, asn1AcnTpe, id, isOpt, existArg, paramsAcn, acnTps = match child with | Asn1Child child -> let existArg = @@ -1384,44 +1491,238 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | Some (Optional _) -> [isDefinedMutExpr (FieldSelect (Var data.v1, child._scala_name))] | _ -> [] - let paramsAcn = + let acns, paramsAcn = + let acns = fun () -> collectNestedAcnChildren child.Type.Kind + let paramAcns = fun () -> acnExternDependenciesVariableDecode child.Type (t :: (nestingScope.parents |> List.map snd)) match child.Type.Kind with - | ReferenceType rt when rt.hasExtraConstrainsOrChildrenOrAcnArgs -> - acnExternDependenciesVariableDecode child.Type (t :: (nestingScope.parents |> List.map snd)) - | _ -> [] - Asn1 child.Type, child.Type.id, child.Optionality.IsSome, existArg, paramsAcn - | AcnChild child -> Acn child.Type, child.id, false, [], [] - let prefixLemmaInfo = readPrefixLemmaIdentifier asn1Tpe id isOpt - let cdcSnapRecv, cdcRecv = selectCodecReadPrefixLemma prefixLemmaInfo (Var c1) (Var c2Moved) - let prefixLemmaApp = - match prefixLemmaInfo with - | PrimitivePrefixLemma info -> - FunctionCall {prefix = info.prefix; id = info.id; tps = []; args = [cdcSnapRecv; cdcRecv] @ existArg @ info.extraConstArgs} - | ComposedPrefixLemma info -> - FunctionCall {prefix = []; id = info.id; tps = []; args = [cdcSnapRecv; cdcRecv] @ [Var childSize] @ existArg @ (paramsAcn |> List.map Var)} + | ReferenceType rt -> + if rt.hasExtraConstrainsOrChildrenOrAcnArgs then acns (), paramAcns () + else + match rt.resolvedType.ActualType.Kind with + | OctetString _ | BitString _ -> [], paramAcns () + | _ -> [], [] + | Sequence _ | SequenceOf _ | Choice _ -> acns (), paramAcns () + | OctetString _ | BitString _ -> [], paramAcns () + | _ -> [], [] + let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) + ToC child.Name.Value, Asn1 child.Type, child.Type.id, child.Optionality.IsSome, existArg, paramsAcn, acnTps + | AcnChild child -> ToC child.Name.Value, Acn child.Type, child.id, false, [], [], [] + let elemTpe = fromAsn1AcnType asn1AcnTpe + let decInfo = decodeInfo asn1AcnTpe id isOpt + + let c1Next = {Var.name = $"c1_{ix + 2}"; tpe = origC1.tpe} + let c2Next = {Var.name = $"c2_{ix + 2}"; tpe = origC1.tpe} + let res1 = {Var.name = $"{fieldName}_1"; tpe = elemTpe} + let res2 = {Var.name = $"{fieldName}_2"; tpe = elemTpe} + let decodedAcn1 = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn_1_{ix + 1}"; tpe = tpe}) + let decodedAcn2 = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn_2_{ix + 1}"; tpe = tpe}) + + let prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, v1Value, v2Value = + match decInfo with + | PrimitiveDecodeInfo info -> + assert acnTps.IsEmpty + // Note: For variable-size BitString/OctetString, `paramsAcn` is of size 1 and contains the ACN determinant for the size + // We however do not need it for the prefix lemma application (only to build the class wrapper) + let prefixLemmaApp = FunctionCall { + prefix = info.prefix; id = info.prefixLemmaId; tps = [] + args = [ + selectCodecDecodeInfo decInfo (Var c1) + selectCodecDecodeInfo decInfo (Var c2Moved) + ] @ existArg @ info.extraConstArgs + parameterless = true + } + let dec1 = {Var.name = "dec1"; tpe = elemTpe} + let dec2 = {Var.name = "dec2"; tpe = elemTpe} + let dec1Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c1); id = info.decodePureId; args = existArg @ info.extraConstArgs; parameterless = false} + let dec2Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c2); id = info.decodePureId; args = existArg @ info.extraConstArgs; parameterless = false} + let v1Value, v2Value = + match child with + | Asn1Child child -> + match child.Type.ActualType.Kind with + | BitString _ | OctetString _ -> + assert (paramsAcn.Length <= 1) + let id = child.Type.FT_TypeDefinition.[Scala].typeName + let ncount = paramsAcn |> List.map (fun v -> + // The variable may have type ULong, we need to unwrap it as the constructor expects a Long + match v.tpe with + | IntegerType ULong -> IntCast (Var v, ULong, Long) + | _ -> Var v + ) + let v1Value = ClassCtor {ct = {id = id; tps = []}; args = ncount @ [Var dec1]} + let v2Value = ClassCtor {ct = {id = id; tps = []}; args = ncount @ [Var dec2]} + v1Value, v2Value + | _ -> + assert paramsAcn.IsEmpty + Var dec1, Var dec2 + | AcnChild _ -> + assert paramsAcn.IsEmpty + Var dec1, Var dec2 + prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, v1Value, v2Value + + | ComposedDecodeInfo info -> + let prefixLemmaApp = FunctionCall { + prefix = []; id = info.prefixLemmaId; tps = [] + args = [ + selectCodecDecodeInfo decInfo (Var c1) + selectCodecDecodeInfo decInfo (Var c2Moved) + ] @ [Var childSize] @ existArg @ (paramsAcn |> List.map Var) + parameterless = true + } + let decResTpe = ClassType (eitherMutTpe (IntegerType Int) (tupleType (elemTpe :: acnTps))) + let dec1 = {Var.name = "dec1"; tpe = decResTpe} + let dec2 = {Var.name = "dec2"; tpe = decResTpe} + let dec1Call = FunctionCall { + prefix = []; id = info.decodePureId; tps = [] + args = [selectCodecDecodeInfo decInfo (Var c1)] @ existArg @ (paramsAcn |> List.map Var) + parameterless = true + } + let dec2Call = FunctionCall { + prefix = []; id = info.decodePureId; tps = [] + args = [selectCodecDecodeInfo decInfo (Var c2)] @ existArg @ (paramsAcn |> List.map Var) + parameterless = true + } + + let subPat1, subPat2 = + if acnTps.IsEmpty then + Wildcard (Some res1), Wildcard (Some res2) + else + let subPat1 = TuplePattern { + binder = None + subPatterns = Wildcard (Some res1) :: (decodedAcn1 |> List.map (fun v -> Wildcard (Some v))) + } + let subPat2 = TuplePattern { + binder = None + subPatterns = Wildcard (Some res2) :: (decodedAcn2 |> List.map (fun v -> Wildcard (Some v))) + } + subPat1, subPat2 + + let leftMutPat: Pattern = ADTPattern {binder = None; id = leftMutId; subPatterns = [Wildcard None]} + let rightMutPat (subPat: Pattern): Pattern = ADTPattern {binder = None; id = rightMutId; subPatterns = [subPat]} + + let v1Value = + let proofContradiction = + { + FunDef.id = "proof" + prms = [] + annots = [Pure; Opaque; InlineOnce] + specs = [] + postcond = Some ({Var.name = "_"; tpe = UnitType}, BoolLit false) + returnTpe = UnitType + body = ApplyLetRec {id = bodyWithC1Id; args = []} + } + let leftCase = + LetRec {fds = [proofContradiction]; body = mkBlock [ApplyLetRec {id = proofContradiction.id; args = []}; TripleQMark]} + MatchExpr { + scrut = Var dec1 + cases = [ + { + pattern = rightMutPat subPat1 + rhs = mkTuple ((Var res1) :: (decodedAcn1 |> List.map Var)) + } + { + pattern = leftMutPat + rhs = leftCase + } + ] + } + let v2Value = + MatchExpr { + scrut = Var dec2 + cases = [ + { + pattern = rightMutPat subPat2 + rhs = mkTuple ((Var res1) :: (decodedAcn2 |> List.map Var)) + } + { + pattern = leftMutPat + rhs = mkBlock [Check (BoolLit false); TripleQMark] + } + ] + } + + prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, v1Value, v2Value + + let validateOffsLemma = validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN (Var c1)) (selBufACN (Var c2)) (longlit child.acnMaxSizeInBits) let proof = mkBlock [ slicedLemmaApp letsIn [c2Moved, c2MovedValue] (mkBlock ( - c2MovedAssertions @ [prefixLemmaApp] + c2MovedAssertions @ [prefixLemmaApp; validateOffsLemma] )) ] + let accOffsets = if ix = 0 then longlit 0I else childrenSizes |> List.take ix |> List.map Var |> plus + let v1Size = + match child with + | Asn1Child asn1 -> + optionalSizeExpr asn1 (Var res1) (plus [bitIndexACN (Var c1); accOffsets]) 0I 0I + | AcnChild child -> {bdgs = []; resSize = acnTypeSizeExpr child.Type} + + // Note: The pure decoding methods on BitStream and Codec base classes return a BitStream and Codec respectively, + // we therefore need to select the base in such cases. + let selBuf (cdc: Expr): Expr = + match decInfo with + | PrimitiveDecodeInfo info -> + if info.prefix = [bitStreamId] then selBufBitStream cdc + else if info.prefix = [codecId] then selBufCodec cdc + else selBufACN cdc + | ComposedDecodeInfo _ -> selBufACN cdc + + let bitIndex (cdc: Expr): Expr = + match decInfo with + | PrimitiveDecodeInfo info -> + if info.prefix = [bitStreamId] then bitIndexBitStream cdc + else if info.prefix = [codecId] then bitIndexCodec cdc + else bitIndexACN cdc + | ComposedDecodeInfo _ -> bitIndexACN cdc + + let postcondExpr = + let conds = SplitAnd ([ + Equals (v1Size.resSize, Var childSize) + Equals (Var res1, Var res2) + ] @ (List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2))) @ [ + // Note: c1Next and c2Next may be Codec/BitStream instead of ACN, we therefore need to adjust as said in the comment above + // origC1 and origC2Reset are however ACN + Equals (selBuf (Var c1Next), selBufACN (Var origC1)) + Equals (selBuf (Var c2Next), selBufACN (Var origC2Reset)) + Equals (bitIndex (Var c1Next), plus [bitIndexACN (Var origC1); accOffsets; Var childSize]) + Equals (bitIndex (Var c1Next), bitIndex (Var c2Next)) + ]) + letTuple [c1Next; dec1] dec1Call (mkBlock [ + letTuple [c2Next; dec2] dec2Call (mkBlock [ + letTuple (res1 ::decodedAcn1) v1Value (mkBlock [ + letTuple (res2 ::decodedAcn2) v2Value ( + letsIn v1Size.bdgs conds + ) + ]) + ]) + ]) + { FunDef.id = $"proof_{ToC name}" prms = if ix = 0 then paramsAcn else [c1; c2] @ paramsAcn annots = [Opaque; InlineOnce] specs = specs - postcond = None // TODO + postcond = Some ({Var.name = "_"; tpe = UnitType}, postcondExpr) returnTpe = UnitType body = proof } let mkSeqProof (data: PrefixLemmaData): Expr = - let bodyWithC1 = mkUnfoldedDecodeWrapper data "bodyWithC1" data.c1 - let bodyWithC2 = mkUnfoldedDecodeWrapper data "bodyWithC2" data.c2Reset - - let subproofsFns = sq.children |> List.indexed |> List.map (fun (i, c) -> mkFieldSubproofFn data i c) + let bodyWithC1 = mkUnfoldedDecodeWrapper data bodyWithC1Id data.c1 + let bodyWithC2 = mkUnfoldedDecodeWrapper data bodyWithC2Id data.c2Reset + + let subproofsFns = (sq.children |> + List.indexed |> + List.filter (fun (_, c) -> + match c with + | Asn1Child c -> + match c.Type.Kind with + | NullType nt -> false // TODO: Not quite, if the NT has an encoding pattern, there is some logic to do + | _ -> true + | AcnChild _ -> true + ) |> + List.map (fun (i, c) -> mkFieldSubproofFn data i c)) let proof = LetRec {fds = subproofsFns; body = UnitLit} let rightMutCase = @@ -1495,7 +1796,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) let retTpe = tupleType (IntegerType Int :: acnTps) let outerPVal = SelectionExpr (joinedSelection outerSel.arg) let cstrCheck = - let scrut = FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var recPVal]} + let scrut = FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var recPVal]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} let leftBody = Return (leftExpr errTpe retTpe (Var leftBdg)) eitherMatchExpr scrut (Some leftBdg) leftBody None (mkBlock []) @@ -1531,7 +1832,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map Var) @ [outerPVal]} + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map Var) @ [outerPVal]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} @@ -1569,7 +1870,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) let outerPVal = {Var.name = outerSel.arg.asIdentifier; tpe = tpe} let retInnerFd = let retVal = mkTuple (Var recPVal :: (acnsVars |> List.map Var)) - let scrut = FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var recPVal]} + let scrut = FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var recPVal]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} let leftBody = leftMutExpr errTpe retTpe (Var leftBdg) let rightBody = rightMutExpr errTpe retTpe retVal @@ -1586,7 +1887,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) // If we do, we must "inline" the size definition which will contain the size of these extra ACN fields and if not, we can just call size // We always inline here since it is ok even if we don't have extra ACN fields asn1SizeExpr t.acnAlignment t.Kind (Var szRecv) (bitIndexACN (Old (Var cdc))) 0I 0I - let cstrIsValid = isRightExpr (FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var szRecv]}) + let cstrIsValid = isRightExpr (FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var szRecv]; parameterless = true}) let postcondExpr = if acns.IsEmpty then generateDecodePostcondExprCommon r resPostcond szRecv sz [] [cstrIsValid] @@ -1594,7 +1895,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) assert (match t.Kind with Sequence _ -> true | _ -> false) let oldCdc = Old (Var cdc) let rightBody = letsIn sz.bdgs (And [ - Equals (selBuf oldCdc, selBuf (Var cdc)) + Equals (selBufACN oldCdc, selBufACN (Var cdc)) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) cstrIsValid ]) @@ -1630,7 +1931,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (paramsAcn |> List.map Var)} + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (paramsAcn |> List.map Var); parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} @@ -1652,7 +1953,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) let varRes = {Var.name = "res"; tpe = fnRetTpe} let pureBody = (letsIn [varCpy, Snapshot (Var cdc); - varRes, FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var varCpy] @ (paramsAcn |> List.map Var)}] + varRes, FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var varCpy] @ (paramsAcn |> List.map Var); parameterless = true}] (mkTuple [Var varCpy; Var varRes])) { FunDef.id = $"{baseId}_ACN_Decode_pure" @@ -1672,7 +1973,8 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va assert (snapshots.Length = nbTotalChildren) assert (stmts.Length = nbTotalChildren) assert (pg.children.Length = pg.sq.children.Length) - + // Apparently, not needed? + (* let rec assertionsConditions (info: Asn1AcnAst.SeqChildInfo): Expr option = let intRangeAssertion (int: BigIntegerUperRange): Expr option = match int with @@ -1697,7 +1999,7 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va let addAssert (tpe: Asn1AcnAst.SeqChildInfo): Expr = assertionsConditions tpe |> Option.map (fun cond -> Assert cond) |> Option.defaultValue (mkBlock []) - + *) let outerMaxSize = pg.outerMaxSize enc let thisMaxSize = (bigint nbPresenceBits) + (pg.sq.children |> List.sumBy (fun c -> c.maxSizeInBits enc)) let fstSnap = snapshots.Head @@ -1736,8 +2038,8 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va else [] let bufCheck = match codec with - | Encode -> [Check ((Equals (selBufLength (Var cdc), selBufLength (Var oldCdc))))] - | Decode -> [Check ((Equals (selBuf (Var cdc), selBuf (Var oldCdc))))] + | Encode -> [Check ((Equals (selBufLengthACN (Var cdc), selBufLengthACN (Var oldCdc))))] + | Decode -> [Check ((Equals (selBufACN (Var cdc), selBufACN (Var oldCdc))))] let offsetWidening = match pg.siblingMaxSize enc with | Some siblingMaxSize when ix = nbTotalChildren - 1 && siblingMaxSize <> thisMaxSize -> @@ -1750,7 +2052,7 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va let checks = offsetCheckOverall :: offsetCheckNested @ bufCheck @ offsetWidening let validateOffsetLemma = if stmt.IsSome && ix < nbTotalChildren - 1 then - [validateOffsetBitsIneqLemma (selBitStream (Var snap)) (selBitStream (Var cdc)) (longlit (outerMaxSize - offsetAcc + sz)) (longlit sz)] + [validateOffsetBitsIneqLemma (selBitStreamACN (Var snap)) (selBitStreamACN (Var cdc)) (longlit (outerMaxSize - offsetAcc + sz)) (longlit sz)] else [] let preciseSize = annotatePostPreciseSize ix snap child mkBlock [Ghost (mkBlock (validateOffsetLemma @ checks)); preciseSize] @@ -1758,13 +2060,13 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va let annotate (ix: int, (snap: Var, child: SequenceChildProps option, stmt: string option)) (offsetAcc: bigint, rest: Expr): bigint * Expr = let sz = child |> Option.map (fun c -> c.info.maxSizeInBits enc) |> Option.defaultValue 1I //assert (thisMaxSize <= (pg.siblingMaxSize enc |> Option.defaultValue thisMaxSize)) // TODO: Somehow does not always hold with UPER? - let preAnnots = - match stmt, child with - | Some _, Some c -> [addAssert c.info] - | _ -> [] + // let preAnnots = + // match stmt, child with + // | Some _, Some c -> [addAssert c.info] + // | _ -> [] let postAnnots = annotatePost ix snap child stmt offsetAcc let encDec = stmt |> Option.map EncDec |> Option.toList - let body = mkBlock (preAnnots @ encDec @ [postAnnots; rest]) + let body = mkBlock (encDec @ [postAnnots; rest]) offsetAcc - sz, LetGhost {bdg = snap; e = Snapshot (Var cdc); body = body} let stmts = List.zip3 snapshots childrenWithPresenceBits stmts |> List.indexed @@ -1865,7 +2167,7 @@ let generateSequenceProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1Ac // let optionals = sq.children |> List.indexed |> List.choose optionalReflexiveLemmaApp let presenceBitsPrefixLemmaApps = [0 .. nbPresenceBits - 1] |> List.map (fun ix -> let cdcSnapReset = resetAtACN (Var snapshots.[ix + 1]) (Var snapshots.[ix]) - FunctionCall {prefix = [bitStreamId]; id = "readBitPrefixLemma"; args = [selBitStream cdcSnapReset; selBitStream (Var cdc)]} + FunctionCall {prefix = [bitStreamId]; id = "readBitPrefixLemma"; args = [selBitStreamACN cdcSnapReset; selBitStreamACN (Var cdc)]} ) let childrenPrefixLemmaApps = sq.children |> List.indexed |> List.initial |> List.map readPrefixLemmaApp @@ -1930,6 +2232,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding let outerSqf = if enc = ACN || codec = Decode then Var sqfVar else SelectionExpr (joinedSelection pg.cs.arg) + let collTpe = ClassType (vecTpe elemTpe) let td = match sqf with | SqOf sqf -> sqf.typeDef.[Scala].typeName @@ -1941,13 +2244,17 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding id = "sizeRange" tps = [] args = [ls; offset; from; tto] + parameterless = true } let fnid = - let prefix = pg.nestingScope.parents |> List.tryHead |> Option.map (fun (cs, _) -> $"{cs.arg.asIdentifier}_") |> Option.defaultValue "" + let baseId = + match pg.t with + | Asn1TypeOrAcnRefIA5.Asn1 t -> $"{ToC t.id.dropModule.AsString}" + | Asn1TypeOrAcnRefIA5.AcnRefIA5 (tId, _) -> $"{ToC tId.dropModule.AsString}" match codec with - | Encode -> $"{ToC pg.cs.modName}_{td}_{prefix}{pg.cs.arg.lastIdOrArr}_Encode_loop" - | Decode -> $"{ToC pg.cs.modName}_{td}_{prefix}{pg.cs.arg.lastIdOrArr}_Decode_loop" + | Encode -> $"{baseId}_Encode_loop" + | Decode -> $"{baseId}_Decode_loop" let nbItemsMin, nbItemsMax = sqf.nbElems enc let nbItems = if sqf.isFixedSize then int32lit nbItemsMin @@ -1966,30 +2273,32 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding let encDec = pg.encDec |> Option.map EncDec |> Option.toList - let preSerde = Ghost (validateOffsetBitsWeakeningLemma (selBitStream (Var cdc)) (Mult (longlit maxElemSz, Minus (nbItems, Var from))) (longlit maxElemSz)) + let preSerde = Ghost (validateOffsetBitsWeakeningLemma (selBitStreamACN (Var cdc)) (Mult (longlit maxElemSz, Minus (nbItems, Var from))) (longlit maxElemSz)) let postSerde = Ghost (mkBlock [ Check (Equals ( Mult (longlit maxElemSz, plus [Var from; int32lit 1I]), plus [Mult (longlit maxElemSz, Var from); longlit maxElemSz] )) - validateOffsetBitsIneqLemma (selBitStream (Var cdcSnap1)) (selBitStream (Var cdc)) (Mult (longlit maxElemSz, Minus (nbItems, Var from))) (longlit maxElemSz) + validateOffsetBitsIneqLemma (selBitStreamACN (Var cdcSnap1)) (selBitStreamACN (Var cdc)) (Mult (longlit maxElemSz, Minus (nbItems, Var from))) (longlit maxElemSz) Check (validateOffsetBitsACN (Var cdc) (Mult (longlit maxElemSz, Minus (nbItems, plus [Var from; int32lit 1I])))) ]) // TODO: ALIGNMENT let sizeLemmaCall = match sqf with - | SqOf _ -> Some (MethodCall {recv = outerSqf; id = sizeLemmaId None; args = [bitIndexACN (Var cdcBeforeLoop); bitIndexACN (Var oldCdc)]}) + | SqOf _ -> Some (MethodCall {recv = outerSqf; id = sizeLemmaId None; args = [bitIndexACN (Var cdcBeforeLoop); bitIndexACN (Var oldCdc)]; parameterless = true}) | StrType _ -> None - match codec with - | Encode -> + //////////////////////////// + + // Creates the recursive function and returns the corresponding call + let mkEncodeRecursiveFn (): FunDef * Expr = let countParam = match sqf with | StrType _ when not sqf.isFixedSize -> [count] | _ -> [] let fnRetTpe = ClassType (eitherTpe (IntegerType Int) (IntegerType Int)) - let reccall = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ (countParam |> List.map Var) @ [Var sqfVar; plus [Var from; int32lit 1I]]} + let reccall = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ (countParam |> List.map Var) @ [Var sqfVar; plus [Var from; int32lit 1I]]; parameterless = true} let checkRange = match sqf with | StrType _ -> @@ -2049,7 +2358,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding | SqOf _ -> callSizeRangeObj (FieldSelect (Var sqfVar, "arr")) (bitIndexACN oldCdc) (Var from) nbItems | StrType _ -> Mult (longlit maxElemSz, Minus (nbItems, Var from)) let rightBody = And [ - Equals (selBufLength oldCdc, selBufLength (Var cdc)) + Equals (selBufLengthACN oldCdc, selBufLengthACN (Var cdc)) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz]) ] eitherMatchExpr (Var postcondRes) None (BoolLit true) (Some postcondRes) rightBody @@ -2079,16 +2388,18 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding match sqf with | StrType _ when not sqf.isFixedSize -> [Var {Var.name = pg.cs.arg.asIdentifier + "_nCount"; tpe = IntegerType Int}] | _ -> [] - let scrut = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ count @ [outerSqf; int32lit 0I]} + let scrut = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ count @ [outerSqf; int32lit 0I]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = IntegerType Int} let leftBody = Return (leftExpr (IntegerType Int) (IntegerType Int) (Var leftBdg)) - let rightBody = sizeLemmaCall |> Option.map Ghost |> Option.defaultValue UnitLit + let rightBody = mkBlock ((sizeLemmaCall |> Option.map Ghost |> Option.toList) @ [UnitLit]) eitherMatchExpr scrut (Some leftBdg) leftBody None rightBody let call = letsGhostIn [cdcBeforeLoop, Snapshot (Var cdc)] call - [fd], call - | Decode -> + fd, call + + //////////////////////////// + + let mkDecodeRecursiveFn (): FunDef * Expr = let countParam = if sqf.isFixedSize then [] else [count] - let collTpe = ClassType (vecTpe elemTpe) let fnRetTpe = ClassType (eitherMutTpe (IntegerType Int) collTpe) let sqfVecVar = {Var.name = pg.cs.arg.asIdentifier; tpe = collTpe} let thnCase = @@ -2115,7 +2426,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding listApplyEqVecApply appended (Var from) Check (Equals (Var decodedElemVar, vecApply (Var newVec) (Var from))) ]) - let reccall = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ (countParam |> List.map Var) @ [appended; plus [Var from; int32lit 1I]]} + let reccall = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ (countParam |> List.map Var) @ [appended; plus [Var from; int32lit 1I]]; parameterless = true} let postrecProof = Ghost (eitherMutMatchExpr (Var reccallRes) None UnitLit (Some newVec) postrecProofSuccess) mkBlock ((preSerde :: encDec) @ [ letsGhostIn [cdcSnap2, Snapshot (Var cdc)] ( @@ -2138,7 +2449,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding | SqOf _ -> callSizeRangeObj (Var newVec) (bitIndexACN oldCdc) (Var from) nbItems, nbItems | StrType _ -> Mult (longlit maxElemSz, Minus (nbItems, Var from)), plus [nbItems; int32lit 1I] // +1 for the null terminator let rightBody = And ([ - Equals (selBuf oldCdc, selBuf (Var cdc)) + Equals (selBufACN oldCdc, selBufACN (Var cdc)) Equals (vecSize (Var newVec), nbEffectiveElems) vecRangesEq (Var sqfVecVar) (Var newVec) (int32lit 0I) (Var from) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz]) @@ -2161,7 +2472,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding let count = if sqf.isFixedSize then [] else [Var {Var.name = pg.cs.arg.asIdentifier + "_nCount"; tpe = IntegerType Int}] - let scrut = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ count @ [vecEmpty elemTpe; int32lit 0I]} + let scrut = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ count @ [vecEmpty elemTpe; int32lit 0I]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = IntegerType Int} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} @@ -2175,13 +2486,136 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding | StrType _ -> mkBlock ((sizeLemmaCall |> Option.map Ghost |> Option.toList) @ [Var rightBdg]) letsIn [sqfVar, eitherMutMatchExpr scrut (Some leftBdg) leftBody (Some rightBdg) rightBody] (mkBlock []) let call = letsGhostIn [cdcBeforeLoop, Snapshot (Var cdc)] call + fd, call + + //////////////////////////// + + match codec with + | Encode -> + // ASN1 SequenceOf alike have a wrapper function generated by wrapAcnFuncBody that calls the recursive function + // However this is not the case for ACN strings, so we need to create here this "wrapper" that calls the recursive function + // and return the call to that wrapper function + match pg.t with + | Asn1TypeOrAcnRefIA5.Asn1 _ -> + let fd, reccall = mkEncodeRecursiveFn () + [fd], reccall + | Asn1TypeOrAcnRefIA5.AcnRefIA5 (tId, _) -> + let fd, _ = mkEncodeRecursiveFn () + let fdWrapperId = $"{ToC tId.dropModule.AsString}_ACN_Encode" + let strType = + match sqf with + | StrType str -> str + | _ -> failwith "ACN reference to string but not a StrType?" + let countParam, countAcnVar = + if not strType.isFixedSize then [count], [Var {Var.name = pg.cs.arg.asIdentifier + "_nCount"; tpe = IntegerType Int}] + else [], [] + let fromBounds = + if sqf.isFixedSize then [] + else [Precond (Leq (int32lit 0I, nbItems))] + let sizePrecond = Precond (Equals (vecSize (Var sqfVar), plus [nbItems; int32lit 1I])) + let validateOffset = Precond (validateOffsetBitsACN (Var cdc) (Mult (longlit maxElemSz, nbItems))) + // TODO: Should be doing invertibility condition here as well + let postcondRes = {Var.name = "res"; tpe = fd.returnTpe} + let postcond = + let oldCdc = Old (Var cdc) + let sz = Mult (longlit maxElemSz, nbItems) + let rightBody = And [ + Equals (selBufLengthACN oldCdc, selBufLengthACN (Var cdc)) + Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz]) + ] + eitherMatchExpr (Var postcondRes) None (BoolLit true) (Some postcondRes) rightBody + let fdWrapper = { + FunDef.id = fdWrapperId + prms = [cdc] @ countParam @ [sqfVar] + annots = [Opaque; InlineOnce] + specs = if enc = ACN then fromBounds @ [sizePrecond; validateOffset] else [] + postcond = if enc = ACN then Some (postcondRes, postcond) else None + returnTpe = fd.returnTpe + body = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ (countParam |> List.map Var) @ [outerSqf; int32lit 0I]; parameterless = true} + } + let fdWrapperCall = + let scrut = FunctionCall {prefix = []; id = fdWrapper.id; tps = []; args = [Var cdc] @ countAcnVar @ [outerSqf]; parameterless = true} + let leftBdg = {Var.name = "l"; tpe = IntegerType Int} + let leftBody = Return (leftExpr (IntegerType Int) (IntegerType Int) (Var leftBdg)) + let rightBody = mkBlock ((sizeLemmaCall |> Option.map Ghost |> Option.toList) @ [UnitLit]) + eitherMatchExpr scrut (Some leftBdg) leftBody None rightBody + + [fd; fdWrapper], fdWrapperCall + | Decode -> + // Ditto here + let fd, reccall = mkDecodeRecursiveFn () + let returnedFds, auxCall = + match pg.t with + | Asn1TypeOrAcnRefIA5.Asn1 _ -> + [fd], reccall + | Asn1TypeOrAcnRefIA5.AcnRefIA5 (tId, _) -> + let fdWrapperId = $"{ToC tId.dropModule.AsString}_ACN_Decode" + let strType = + match sqf with + | StrType str -> str + | _ -> failwith "ACN reference to string but not a StrType?" + let countParam = if sqf.isFixedSize then [] else [count] + let fnRetTpe = ClassType (eitherMutTpe (IntegerType Int) collTpe) + let fromBounds = + if sqf.isFixedSize then [] + else [Precond (Leq (int32lit 0I, nbItems))] + let validateOffset = Precond (validateOffsetBitsACN (Var cdc) (Mult (longlit maxElemSz, nbItems))) + let postcondRes = {Var.name = "res"; tpe = fnRetTpe} + let postcond = + let resVec = {Var.name = "resVec"; tpe = collTpe} + let oldCdc = Old (Var cdc) + let sz = Mult (longlit maxElemSz, nbItems) + let nbEffectiveElems = plus [nbItems; int32lit 1I] // +1 for the null terminator + let rightBody = And ([ + Equals (selBufACN oldCdc, selBufACN (Var cdc)) + Equals (vecSize (Var resVec), nbEffectiveElems) + Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz]) + ]) + eitherMutMatchExpr (Var postcondRes) None (BoolLit true) (Some resVec) rightBody + let fdWrapper = { + FunDef.id = fdWrapperId + prms = [cdc] @ countParam + annots = [Opaque; InlineOnce] + specs = if enc = ACN then fromBounds @ [validateOffset] else [] + postcond = if enc = ACN then Some (postcondRes, postcond) else None + returnTpe = fnRetTpe + body = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ (countParam |> List.map Var) @ [vecEmpty elemTpe; int32lit 0I]; parameterless = true} + } + let countAcnVar = + if not strType.isFixedSize then [Var {Var.name = pg.cs.arg.asIdentifier + "_nCount"; tpe = IntegerType Int}] + else [] + let fdWrapperCall = + let scrut = FunctionCall {prefix = []; id = fdWrapper.id; tps = []; args = [Var cdc] @ countAcnVar; parameterless = true} + let leftBdg = {Var.name = "l"; tpe = IntegerType Int} + // TODO: FIXME: the right type must be the outside type!!! + let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} + let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! + let rightBdg = {Var.name = "bdg"; tpe = collTpe} + let rightBody = mkBlock ((sizeLemmaCall |> Option.map Ghost |> Option.toList) @ [Var rightBdg]) + letsIn [sqfVar, eitherMutMatchExpr scrut (Some leftBdg) leftBody (Some rightBdg) rightBody] (mkBlock []) + // We also need to generate a "pure" version of the wrapper decode + let fdWrapperPure = + let varCpy = {Var.name = "cpy"; tpe = ClassType codecTpe} + let varRes = {Var.name = "res"; tpe = fnRetTpe} + let pureBody = (letsIn + [varCpy, Snapshot (Var cdc); + varRes, FunctionCall {prefix = []; id = fdWrapper.id; tps = []; args = [Var varCpy] @ countAcnVar; parameterless = true}] + (mkTuple [Var varCpy; Var varRes])) + { + FunDef.id = $"{fdWrapperId}_pure" + prms = fdWrapper.prms + annots = [GhostAnnot; Pure] + specs = fdWrapper.specs + postcond = None + returnTpe = tupleType [ClassType codecTpe; fnRetTpe] + body = pureBody + } + [fd; fdWrapper; fdWrapperPure], fdWrapperCall let prefixLemma = if r.args.stainlessInvertibility then - match pg.t with - | Asn1TypeOrAcnRefIA5.Asn1 _ -> [generatePrefixLemmaSequenceOfLike enc pg.t pg.nestingScope sqf] - | Asn1TypeOrAcnRefIA5.AcnRefIA5 _ -> [] + [generatePrefixLemmaSequenceOfLike enc pg.t pg.nestingScope sqf] else [] - fd :: prefixLemma, call + returnedFds @ prefixLemma, auxCall let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc: SequenceOptionalChild): FunDef = let mkProof (data: PrefixLemmaData): Expr = @@ -2216,8 +2650,8 @@ let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc Precond (validateOffsetBitsACN (Var c1) maxSizeExpr) Precond (And [Leq (longlit 0I, Var sz); Leq (Var sz, maxSizeExpr)]) Precond (arrayBitRangesEq - (selBuf (Var c1)) - (selBuf (Var c2)) + (selBufACN (Var c1)) + (selBufACN (Var c2)) (longlit 0I) (plus [bitIndexACN (Var c1); Var sz]) ) @@ -2254,9 +2688,9 @@ let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc let c1Recv, c2Recv = selectCodecReadPrefixLemma underlyingPrefixLemma (Var c1) (Var c2) let underlyingPrefixLemmaCall = match underlyingPrefixLemma with - | PrimitivePrefixLemma info -> + | PrimitiveDecodeInfo info -> FunctionCall {prefix = info.prefix; id = info.id; tps = []; args = [c1Recv; c2Recv] @ info.extraConstArgs} - | ComposedPrefixLemma info -> + | ComposedDecodeInfo info -> FunctionCall {prefix = []; id = info.id; tps = []; args = [c1Recv; c2Recv] @ [Var sz]} let body = (letsIn [ @@ -2317,7 +2751,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc isValidFuncName |> Option.map (fun validFnName -> let bdg = {Var.name = "v"; tpe = childTpe} let validCall = - let scrut = FunctionCall {prefix = []; id = validFnName; tps = []; args = [Var bdg]} + let scrut = FunctionCall {prefix = []; id = validFnName; tps = []; args = [Var bdg]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = IntegerType Int} let leftBody = Return (leftExpr errTpe rightTpe (Var leftBdg)) eitherMatchExpr scrut (Some leftBdg) leftBody None (mkBlock []) @@ -2347,7 +2781,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc body = body } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map Var) @ [outerPVal]} + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map Var) @ [outerPVal]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} @@ -2369,7 +2803,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc | Some validFnName -> let someBdg = {Var.name = "v"; tpe = childTpe} let eitherPatmat = - let scrut = FunctionCall {prefix = []; id = validFnName; tps = []; args = [Var someBdg]} + let scrut = FunctionCall {prefix = []; id = validFnName; tps = []; args = [Var someBdg]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} let leftBody = leftMutExpr errTpe rightTpe (Var leftBdg) eitherMatchExpr scrut (Some leftBdg) leftBody None rightRet @@ -2386,7 +2820,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc let sz = sizeExprOf (Var resvalVar) let cstrIsValid = isValidFuncName |> Option.map (fun isValid -> let someBdg = {Var.name = "v"; tpe = childTpe} - let isRight = isRightExpr (FunctionCall {prefix = []; id = isValid; tps = []; args = [Var someBdg]}) + let isRight = isRightExpr (FunctionCall {prefix = []; id = isValid; tps = []; args = [Var someBdg]; parameterless = true}) optionMutMatchExpr (Var resvalVar) (Some someBdg) isRight (BoolLit true)) |> Option.toList let postcondExpr = generateDecodePostcondExprCommon r resPostcond resvalVar sz alwaysAbsentOrPresent cstrIsValid let body = letsGhostIn [(oldCdc, Snapshot (Var cdc))] (mkBlock [encDec; retInnerFd]) @@ -2402,7 +2836,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc } let call = - let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (existVar |> Option.map Var |> Option.toList) @ (paramsAcn |> List.map Var)} + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (existVar |> Option.map Var |> Option.toList) @ (paramsAcn |> List.map Var); parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} @@ -2419,7 +2853,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc let varRes = {Var.name = "res"; tpe = fnRetTpe} let pureBody = (letsIn [varCpy, Snapshot (Var cdc); - varRes, FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var varCpy] @ (existVar |> Option.map Var |> Option.toList) @ (paramsAcn |> List.map Var)}] + varRes, FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var varCpy] @ (existVar |> Option.map Var |> Option.toList) @ (paramsAcn |> List.map Var); parameterless = true}] (mkTuple [Var varCpy; Var varRes])) { FunDef.id = fnIdPure diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 2d209af29..7f7473c6b 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -672,6 +672,31 @@ object BitStream { } } + // TODO: Not proved + @extern + @ghost @pure @opaque @inlineOnce + def readBitsVecPrefixLemma(bs1: BitStream, bs2: BitStream, nBits: Long): Unit = { + require(bs1.buf.length == bs2.buf.length) + require(0 <= nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) + require(bs1.validate_offset_bits(nBits)) + require(arrayBitRangesEq( + bs1.buf, + bs2.buf, + 0, + bs1.bitIndex + nBits + )) + + val bs2Reset = BitStream(snapshot(bs2.buf), bs1.currentByte, bs1.currentBit) + val (bs1Res, v1) = bs1.readBitsVecPure(nBits) + val (bs2Res, v2) = bs2Reset.readBitsVecPure(nBits) + + { + () + }.ensuring { _ => + bs1Res.bitIndex == bs2Res.bitIndex && v1 == v2 + } + } + @ghost @pure @opaque @inlineOnce def lemmaIsPrefixRefl(bs: BitStream): Unit = { if (bs.buf.length != 0) { @@ -2117,7 +2142,15 @@ case class BitStream private [asn1scala]( res.length == ((nBits + NO_OF_BITS_IN_BYTE - 1) / NO_OF_BITS_IN_BYTE).toInt ) - // @opaque @inlineOnce + @pure @ghost + def readBitsVecPure(nBits: Long): (BitStream, Vector[UByte]) = { + require(0 <= nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) + val cpy = snapshot(this) + val res = cpy.readBitsVec(nBits) + (cpy, res) + } + def checkBitsLoop(nBits: Long, expected: Boolean, from: Long): Boolean = { require(0 <= nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) require(0 <= from && from <= nBits) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index ca2b9c403..44893dd89 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -139,6 +139,29 @@ object Codec { l1 == l2 && BitStream.bitIndex(c1Res.bitStream.buf.length, c1Res.bitStream.currentByte, c1Res.bitStream.currentBit) == BitStream.bitIndex(c2Res.bitStream.buf.length, c2Res.bitStream.currentByte, c2Res.bitStream.currentBit) } } + + @ghost @pure @opaque @inlineOnce + def decodeOctetString_no_length_vec_prefixLemma(c1: Codec, c2: Codec, nCount: Int): Unit = { + require(c1.bufLength() == c2.bufLength()) + require(nCount >= 0 && nCount <= Integer.MAX_VALUE / NO_OF_BITS_IN_BYTE) + require(c1.validate_offset_bits(8L * nCount)) + require(arrayBitRangesEq( + c1.bitStream.buf, + c2.bitStream.buf, + 0, + c1.bitStream.bitIndex + 8L * nCount + )) + + val c2Reset = c2.resetAt(c1) + val (c1Res, v1) = c1.decodeOctetString_no_length_vec_pure(nCount) + val (c2Res, v2) = c2Reset.decodeOctetString_no_length_vec_pure(nCount) + + { + () + }.ensuring { _ => + c1Res.bitStream.bitIndex == c2Res.bitStream.bitIndex && v1 == v2 + } + } } /** @@ -1153,28 +1176,37 @@ case class Codec(bitStream: BitStream) { def encodeOctetString_no_length(arr: Array[UByte], nCount: Int): Unit = { require(nCount >= 0 && nCount <= arr.length) - require(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nCount)) + require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, 8L * nCount)) appendByteArray(arr, nCount) } def decodeOctetString_no_length(nCount: Int): Array[UByte] = { require(nCount >= 0 && nCount <= Integer.MAX_VALUE / NO_OF_BITS_IN_BYTE) - require(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nCount)) + require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, 8L * nCount)) readByteArray(nCount) } def encodeOctetString_no_length_vec(arr: Vector[UByte], nCount: Int): Unit = { require(nCount >= 0 && nCount <= arr.length) - require(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nCount)) + require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, 8L * nCount)) appendByteVec(arr, nCount) } def decodeOctetString_no_length_vec(nCount: Int): Vector[UByte] = { require(nCount >= 0 && nCount <= Integer.MAX_VALUE / NO_OF_BITS_IN_BYTE) - require(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nCount)) + require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, 8L * nCount)) readByteVec(nCount) } + @ghost @pure + def decodeOctetString_no_length_vec_pure(nCount: Int): (Codec, Vector[UByte]) = { + require(nCount >= 0 && nCount <= Integer.MAX_VALUE / NO_OF_BITS_IN_BYTE) + require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, 8L * nCount)) + val cpy = snapshot(this) + val res = cpy.readByteVec(nCount) + (cpy, res) + } + def encodeOctetString_fragmentation(arr: Array[UByte], nCount: Int) = { require(nCount >= 0 && nCount <= arr.length) require(nCount < Int.MaxValue / 8 - 2 - (nCount / 0x4000) ) // To avoid overflow of the available length checks diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 487300dec..1875220a6 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -277,6 +277,26 @@ object ACN { BitStream.bitIndex(acn1Res.base.bitStream.buf.length, acn1Res.base.bitStream.currentByte, acn1Res.base.bitStream.currentBit) == BitStream.bitIndex(acn2Res.base.bitStream.buf.length, acn2Res.base.bitStream.currentByte, acn2Res.base.bitStream.currentBit) && i1 == i2 } } + + // TODO: Incomplete specs + // @extern + @ghost @pure @opaque @inlineOnce + def dec_IA5String_CharIndex_External_Field_DeterminantVec_prefixLemma(acn1: ACN, acn2: ACN, max: Long, extSizeDeterminantFld: Long): Unit = { + require(max < Int.MaxValue) + require(extSizeDeterminantFld >= 0) + require(max >= 0) + require(acn1.base.bufLength() == acn2.base.bufLength()) + + val acn2Reset = acn2.resetAt(acn1) + val (acn1Res, v1) = acn1.dec_IA5String_CharIndex_External_Field_DeterminantVec_pure(max, extSizeDeterminantFld) + val (acn2Res, v2) = acn2Reset.dec_IA5String_CharIndex_External_Field_DeterminantVec_pure(max, extSizeDeterminantFld) + + { + () + }.ensuring { _ => + acn1Res.base.bitStream.bitIndex == acn2Res.base.bitStream.bitIndex && v1 == v2 + } + } } case class ACN(base: Codec) { import BitStream.* @@ -1960,6 +1980,16 @@ case class ACN(base: Codec) { Vector.fromScala(arr.toVector) }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) + @pure @ghost + def dec_IA5String_CharIndex_External_Field_DeterminantVec_pure(max: Long, extSizeDeterminantFld: Long): (ACN, Vector[ASCIIChar]) = { + require(max < Int.MaxValue) + require(extSizeDeterminantFld >= 0) + require(max >= 0) + val cpy = snapshot(this) + val res = cpy.dec_IA5String_CharIndex_External_Field_DeterminantVec(max, extSizeDeterminantFld) + (cpy, res) + } + def dec_IA5String_CharIndex_Internal_Field_Determinant(max: Long, min: Long): Array[ASCIIChar] = { require(min <= max) require(max < Int.MaxValue) From b8e93d5085da5988cb9dad237f7eed9b11e9a3cd Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Tue, 13 Aug 2024 14:45:39 +0200 Subject: [PATCH 24/35] Proofs for Sequence prefix lemma --- StgScala/LangGeneric_scala.fs | 4 +- StgScala/ProofAst.fs | 122 +++++++++---- StgScala/ProofGen.fs | 326 ++++++++++++++++++++++++++-------- 3 files changed, 333 insertions(+), 119 deletions(-) diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index 97d016a05..a7e508c55 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -402,11 +402,11 @@ type LangGeneric_scala() = let postcondExpr = match codec with | Encode -> - let resPostcond = {Var.name = "res"; tpe = ClassType (eitherTpe errTpe (IntegerType Int))} + let resPostcond = {Var.name = "res"; tpe = eitherTpe errTpe (IntegerType Int)} let decodePureId = $"{t.FT_TypeDefinition.[Scala].typeName}_ACN_Decode_pure" generateEncodePostcondExpr r t p.arg resPostcond decodePureId | Decode -> - let resPostcond = {Var.name = "res"; tpe = ClassType (eitherMutTpe errTpe (fromAsn1TypeKind t.Kind))} + let resPostcond = {Var.name = "res"; tpe = eitherMutTpe errTpe (fromAsn1TypeKind t.Kind)} generateDecodePostcondExpr r t resPostcond Some (show (ExprTree postcondExpr)) | _ -> Some (show (ExprTree (BoolLit true))) diff --git a/StgScala/ProofAst.fs b/StgScala/ProofAst.fs index 1ada4785d..fdbdc3f27 100644 --- a/StgScala/ProofAst.fs +++ b/StgScala/ProofAst.fs @@ -33,8 +33,10 @@ type Type = | ClassType of ClassType | TupleType of Type list and ClassType = { + prefix: string list id: Identifier tps: Type list + parameterless: bool // For constructor arguments } and ArrayType = { tpe: Type @@ -195,6 +197,10 @@ let mkBlock (exprs: Expr list): Expr = exprs |> List.collect (fun e -> match e with Block exprs -> exprs | _ -> [e]) |> Block +let intCast (e: Expr) (from: IntegerType) (tto: IntegerType): Expr = + if from = tto then e + else IntCast (e, from, tto) + let mkTuple (exprs: Expr list): Expr = assert (not exprs.IsEmpty) if exprs.Length = 1 then exprs.Head @@ -306,14 +312,14 @@ let eitherMutId: Identifier = "EitherMut" let leftMutId: Identifier = "LeftMut" let rightMutId: Identifier = "RightMut" -let bitstreamClsTpe = {ClassType.id = bitStreamId; tps = []} -let codecClsTpe = {ClassType.id = codecId; tps = []} -let uperClsTpe = {ClassType.id = uperId; tps = []} -let acnClsTpe = {ClassType.id = acnId; tps = []} +let bitstreamClsTpe = {ClassType.prefix = []; id = bitStreamId; tps = []; parameterless = false} +let codecClsTpe = {ClassType.prefix = []; id = codecId; tps = []; parameterless = false} +let uperClsTpe = {ClassType.prefix = []; id = uperId; tps = []; parameterless = false} +let acnClsTpe = {ClassType.prefix = []; id = acnId; tps = []; parameterless = false} -let listTpe (tpe: Type): ClassType = {ClassType.id = listId; tps = [tpe]} -let consTpe (tpe: Type): ClassType = {ClassType.id = consId; tps = [tpe]} -let nilTpe (tpe: Type): ClassType = {ClassType.id = nilId; tps = [tpe]} +let listTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = listId; tps = [tpe]; parameterless = false} +let consTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = consId; tps = [tpe]; parameterless = false} +let nilTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = nilId; tps = [tpe]; parameterless = false} let cons (tpe: Type) (head: Expr) (tail: Expr): ClassCtor = {ct = consTpe tpe; args = [head; tail]} let consExpr (tpe: Type) (head: Expr) (tail: Expr): Expr = ClassCtor (cons tpe head tail) let nil (tpe: Type): ClassCtor = {ct = nilTpe tpe; args = []} @@ -324,27 +330,43 @@ let iupdated (list: Expr) (ix: Expr) (v: Expr): Expr = MethodCall {recv = list; let iapply (list: Expr) (ix: Expr): Expr = MethodCall {recv = list; id = "iapply"; args = [ix]; parameterless = true} -let vecTpe (tpe: Type): ClassType = {ClassType.id = vecId; tps = [tpe]} +let vecClsTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = vecId; tps = [tpe]; parameterless = false} +let vecTpe (tpe: Type): Type = ClassType (vecClsTpe tpe) + let vecApply (vec: Expr) (ix: Expr): Expr = MethodCall {recv = vec; id = "apply"; args = [ix]; parameterless = true} let vecSize (vec: Expr): Expr = MethodCall {recv = vec; id = "size"; args = []; parameterless = true} let vecList (vec: Expr): Expr = MethodCall {recv = vec; id = "list"; args = []; parameterless = true} let vecAppend (vec: Expr) (v: Expr): Expr = MethodCall {recv = vec; id = "append"; args = [v]; parameterless = true} let vecEmpty (tpe: Type): Expr = FunctionCall {prefix = [vecId]; id = "empty"; tps = [tpe]; args = []; parameterless = true} -let optionTpe (tpe: Type): ClassType = {ClassType.id = optionId; tps = [tpe]} -let someTpe (tpe: Type): ClassType = {ClassType.id = someId; tps = [tpe]} -let noneTpe (tpe: Type): ClassType = {ClassType.id = noneId; tps = [tpe]} -let some (tpe: Type) (e: Expr): ClassCtor = {ct = someTpe tpe; args = [e]} +let optionClsTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = optionId; tps = [tpe]; parameterless = false} +let optionTpe (tpe: Type): Type = ClassType (optionClsTpe tpe) + +let someClsTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = someId; tps = [tpe]; parameterless = false} +let someTpe (tpe: Type): Type = ClassType (someClsTpe tpe) + +let noneClsTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = noneId; tps = [tpe]; parameterless = false} +let noneTpe (tpe: Type): Type = ClassType (noneClsTpe tpe) + +let some (tpe: Type) (e: Expr): ClassCtor = {ct = someClsTpe tpe; args = [e]} let someExpr (tpe: Type) (e: Expr): Expr = ClassCtor (some tpe e) -let none (tpe: Type): ClassCtor = {ct = noneTpe tpe; args = []} + +let none (tpe: Type): ClassCtor = {ct = noneClsTpe tpe; args = []} let noneExpr (tpe: Type): Expr = ClassCtor (none tpe) -let optionMutTpe (tpe: Type): ClassType = {ClassType.id = optionMutId; tps = [tpe]} -let someMutTpe (tpe: Type): ClassType = {ClassType.id = someMutId; tps = [tpe]} -let noneMutTpe (tpe: Type): ClassType = {ClassType.id = noneMutId; tps = [tpe]} -let someMut (tpe: Type) (e: Expr): ClassCtor = {ct = someMutTpe tpe; args = [e]} +let optionMutClsTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = optionMutId; tps = [tpe]; parameterless = false} +let optionMutTpe (tpe: Type): Type = ClassType (optionMutClsTpe tpe) + +let someMutClsTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = someMutId; tps = [tpe]; parameterless = false} +let someMutTpe (tpe: Type): Type = ClassType (someMutClsTpe tpe) + +let noneMutClsTpe (tpe: Type): ClassType = {ClassType.prefix = []; id = noneMutId; tps = [tpe]; parameterless = false} +let noneMutTpe (tpe: Type): Type = ClassType (noneMutClsTpe tpe) + +let someMut (tpe: Type) (e: Expr): ClassCtor = {ct = someMutClsTpe tpe; args = [e]} let someMutExpr (tpe: Type) (e: Expr): Expr = ClassCtor (someMut tpe e) -let noneMut (tpe: Type): ClassCtor = {ct = noneMutTpe tpe; args = []} + +let noneMut (tpe: Type): ClassCtor = {ct = noneMutClsTpe tpe; args = []} let noneMutExpr (tpe: Type): Expr = ClassCtor (noneMut tpe) let isDefinedExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "isDefined"; args = []; parameterless = true} @@ -354,22 +376,37 @@ let getMutExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "get"; args = let getExpr (recv: Expr): Expr = getMutExpr recv // TODO: We can't distinguish symbols right now -let eitherTpe (l: Type) (r: Type): ClassType = {ClassType.id = eitherId; tps = [l; r]} -let leftTpe (l: Type) (r: Type): ClassType = {ClassType.id = leftId; tps = [l; r]} -let rightTpe (l: Type) (r: Type): ClassType = {ClassType.id = rightId; tps = [l; r]} -let left (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = leftTpe l r; args = [e]} +let eitherClsTpe (l: Type) (r: Type): ClassType = {ClassType.prefix = []; id = eitherId; tps = [l; r]; parameterless = false} +let eitherTpe (l: Type) (r: Type): Type = ClassType (eitherClsTpe l r) + +let leftClsTpe (l: Type) (r: Type): ClassType = {ClassType.prefix = []; id = leftId; tps = [l; r]; parameterless = false} +let leftTpe (l: Type) (r: Type): Type = ClassType (leftClsTpe l r) + +let rightClsTpe (l: Type) (r: Type): ClassType = {ClassType.prefix = []; id = rightId; tps = [l; r]; parameterless = false} +let rightTpe (l: Type) (r: Type): Type = ClassType (rightClsTpe l r) + +let left (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = leftClsTpe l r; args = [e]} let leftExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (left l r e) -let right (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = rightTpe l r; args = [e]} + +let right (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = rightClsTpe l r; args = [e]} let rightExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (right l r e) + let isRightExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "isRight"; args = []; parameterless = true} let isRightMutExpr (recv: Expr): Expr = isRightExpr recv // TODO: We can't distinguish symbols right now -let eitherMutTpe (l: Type) (r: Type): ClassType = {ClassType.id = eitherMutId; tps = [l; r]} -let leftMutTpe (l: Type) (r: Type): ClassType = {ClassType.id = leftMutId; tps = [l; r]} -let rightMutTpe (l: Type) (r: Type): ClassType = {ClassType.id = rightMutId; tps = [l; r]} -let leftMut (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = leftMutTpe l r; args = [e]} +let eitherMutClsTpe (l: Type) (r: Type): ClassType = {ClassType.prefix = []; id = eitherMutId; tps = [l; r]; parameterless = false} +let eitherMutTpe (l: Type) (r: Type): Type = ClassType (eitherMutClsTpe l r) + +let leftMutClsTpe (l: Type) (r: Type): ClassType = {ClassType.prefix = []; id = leftMutId; tps = [l; r]; parameterless = false} +let leftMutTpe (l: Type) (r: Type): Type = ClassType (leftMutClsTpe l r) + +let rightMutClsTpe (l: Type) (r: Type): ClassType = {ClassType.prefix = []; id = rightMutId; tps = [l; r]; parameterless = false} +let rightMutTpe (l: Type) (r: Type): Type = ClassType (rightMutClsTpe l r) + +let leftMut (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = leftMutClsTpe l r; args = [e]} let leftMutExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (leftMut l r e) -let rightMut (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = rightMutTpe l r; args = [e]} + +let rightMut (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = rightMutClsTpe l r; args = [e]} let rightMutExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (rightMut l r e) let listMatch (scrut: Expr) @@ -534,6 +571,9 @@ let letsIn (bdgs: (Var * Expr) list) (body: Expr): Expr = let letsGhostIn (bdgs: (Var * Expr) list) (body: Expr): Expr = List.foldBack (fun (v, e) body -> LetGhost {bdg = v; e = e; body = body}) bdgs body +let ifElseBranches (branches: (Expr * Expr) list) (els: Expr): Expr = + List.foldBack (fun (cond, thn) els -> IfExpr {cond = cond; thn = thn; els = els}) branches els + let selBaseACN (recv: Expr): Expr = FieldSelect (recv, "base") let selBitStreamCodec (recv: Expr): Expr = FieldSelect (recv, "bitStream") @@ -711,16 +751,16 @@ let fromIntClass (cls: Asn1AcnAst.IntegerClass): IntegerType = let rec fromAsn1TypeKind (t: Asn1AcnAst.Asn1TypeKind): Type = match t.ActualType with - | Asn1AcnAst.Sequence sq -> ClassType {id = sq.typeDef[Scala].typeName; tps = []} - | Asn1AcnAst.SequenceOf sqf -> ClassType {id = sqf.typeDef[Scala].typeName; tps = []} - | Asn1AcnAst.Choice ch -> ClassType {id = ch.typeDef[Scala].typeName; tps = []} - | Asn1AcnAst.Enumerated enm -> ClassType {id = enm.typeDef[Scala].typeName; tps = []} + | Asn1AcnAst.Sequence sq -> ClassType {ClassType.prefix = []; id = sq.typeDef[Scala].typeName; tps = []; parameterless = false} + | Asn1AcnAst.SequenceOf sqf -> ClassType {ClassType.prefix = []; id = sqf.typeDef[Scala].typeName; tps = []; parameterless = false} + | Asn1AcnAst.Choice ch -> ClassType {ClassType.prefix = []; id = ch.typeDef[Scala].typeName; tps = []; parameterless = false} + | Asn1AcnAst.Enumerated enm -> ClassType {ClassType.prefix = []; id = enm.typeDef[Scala].typeName; tps = []; parameterless = false} | Asn1AcnAst.Integer int -> IntegerType (fromIntClass int.intClass) | Asn1AcnAst.Boolean _ -> BooleanType | Asn1AcnAst.NullType _ -> IntegerType Byte - | Asn1AcnAst.BitString bt -> ClassType {id = bt.typeDef[Scala].typeName; tps = []} - | Asn1AcnAst.OctetString ot -> ClassType {id = ot.typeDef[Scala].typeName; tps = []} - | Asn1AcnAst.IA5String _ -> ClassType (vecTpe (IntegerType UByte)) + | Asn1AcnAst.BitString bt -> ClassType {ClassType.prefix = []; id = bt.typeDef[Scala].typeName; tps = []; parameterless = false} + | Asn1AcnAst.OctetString ot -> ClassType {ClassType.prefix = []; id = ot.typeDef[Scala].typeName; tps = []; parameterless = false} + | Asn1AcnAst.IA5String _ -> vecTpe (IntegerType UByte) | Asn1AcnAst.Real _ -> DoubleType | t -> failwith $"TODO {t}" @@ -729,8 +769,8 @@ let fromAcnInsertedType (t: Asn1AcnAst.AcnInsertedType): Type = | Asn1AcnAst.AcnInsertedType.AcnInteger int -> IntegerType (fromIntClass int.intClass) | Asn1AcnAst.AcnInsertedType.AcnBoolean _ -> BooleanType | Asn1AcnAst.AcnInsertedType.AcnNullType _ -> IntegerType Byte - | Asn1AcnAst.AcnInsertedType.AcnReferenceToEnumerated enm -> ClassType {id = enm.enumerated.typeDef[Scala].typeName; tps = []} - | Asn1AcnAst.AcnInsertedType.AcnReferenceToIA5String _ -> ClassType (vecTpe (IntegerType UByte)) + | Asn1AcnAst.AcnInsertedType.AcnReferenceToEnumerated enm -> ClassType {ClassType.prefix = []; id = enm.enumerated.typeDef[Scala].typeName; tps = []; parameterless = false} + | Asn1AcnAst.AcnInsertedType.AcnReferenceToIA5String _ -> vecTpe (IntegerType UByte) let fromAsn1AcnType (t: Asn1AcnAst.Asn1AcnType): Type = match t with @@ -879,7 +919,10 @@ and ppClassType (ct: ClassType): string = let tps = if ct.tps.IsEmpty then "" else "[" + ((ct.tps |> List.map ppType).StrJoin ", ") + "]" - ct.id + tps + let id = + if ct.prefix.IsEmpty then ct.id + else (ct.prefix.StrJoin ".") + "." + ct.id + id + tps let ppAnnot (annot: Annot): string = match annot with @@ -1109,7 +1152,7 @@ and ppExprBody (ctx: PrintCtx) (e: Expr): Line list = | ClassCtor cc -> let ct = ppClassType cc.ct let args = cc.args |> List.map (fun a -> ppExpr (ctx.nestExpr a) a) - joinCallLike ctx [line ct] args false + joinCallLike ctx [line ct] args cc.ct.parameterless | Old e2 -> let e2 = ppExpr (ctx.nestExpr e2) e2 @@ -1199,6 +1242,7 @@ and ppExprBody (ctx: PrintCtx) (e: Expr): Line list = match from, tto with | ULong, Long | UInt, Int | UShort, Short | UByte, Byte -> extMeth "toRaw" | Long, ULong | Int, UInt | Short, UShort | Byte, UByte -> objFn "fromRaw" + | _ when from = tto -> e2 | _ -> failwith $"Unsupported conversion {from} -> {tto}" | SelectionExpr sel -> [line sel] diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 5a6d3d959..9449b3a41 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -561,7 +561,7 @@ let choiceSizeFunDefs (t: Asn1AcnAst.Asn1Type) (choice: Asn1AcnAst.Choice): FunD let seqOfSizeFunDefs (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.SequenceOf): FunDef list * FunDef list = let td = sq.typeDef.[Scala].typeName let elemTpe = fromAsn1TypeKind sq.child.Kind - let lsTpe = ClassType (vecTpe elemTpe) + let lsTpe = vecTpe elemTpe let res = {name = "res"; tpe = IntegerType Long} let callSizeRangeObj (ls: Expr) (offset: Expr) (from: Expr) (tto: Expr): Expr = @@ -757,7 +757,7 @@ let generateSequenceOfSizeDefinitions (t: Asn1AcnAst.Asn1Type) (sqf: Asn1AcnAst. let generateSequenceSubtypeDefinitions (dealiased: string) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (children: DAst.Asn1Child list): string list = let retTpe = fromAsn1TypeKind t.Kind let prms = children |> List.map (fun c -> {Var.name = c.Name.Value; tpe = fromAsn1TypeKind c.Type.Kind.baseKind}) - let body = ClassCtor {ct = {id = dealiased; tps = []}; args = prms |> List.map Var} + let body = ClassCtor {ct = {prefix = []; id = dealiased; tps = []; parameterless = false}; args = prms |> List.map Var} let reqs = sequenceInvariantsCommon t sq (List.zip children (prms |> List.map Var)) let fd = { FunDef.id = "apply" @@ -798,7 +798,7 @@ let generateEncodePostcondExprCommon (r: Asn1AcnAst.AstRoot) let lemmaCall = validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN oldCdc) (selBufACN (Var cdc)) (longlit maxSize) let decodePureCall = FunctionCall {prefix = []; id = decodePureId; tps = []; args = (Var r1) :: decodeExtraArgs; parameterless = true} let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} - let decodingRes = {Var.name = "decodingRes"; tpe = ClassType (eitherMutTpe (IntegerType Int) tpe)} + let decodingRes = {Var.name = "decodingRes"; tpe = eitherMutTpe (IntegerType Int) tpe} let resGot = {Var.name = "resGot"; tpe = tpe} let acnVarsGotBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acnGot{ix + 1}"; tpe = tpe}) let acnEq = List.zip acnVarsGotBdg acnVarsPatBdg |> List.map (fun (acnGot, acn) -> Equals (Var acnGot, Var acn)) @@ -1002,6 +1002,7 @@ let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: type PrimitiveDecodeInfo = { prefix: string list + tpe: Type decodePureId: string prefixLemmaId: string extraConstArgs: Expr list @@ -1019,67 +1020,67 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo match encCls with | PositiveInteger_ConstSize_8 -> let baseId = "dec_Int_PositiveInteger_ConstSize_8" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_big_endian_16 -> let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_16" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_big_endian_32 -> let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_32" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_big_endian_64 -> let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_64" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_little_endian_16 -> let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_16" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_little_endian_32 -> let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_32" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_little_endian_64 -> let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_64" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize bits -> let baseId = "dec_Int_PositiveInteger_ConstSize" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [int32lit bits]} + {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [int32lit bits]} | TwosComplement_ConstSize_8 -> let baseId = "dec_Int_TwosComplement_ConstSize_8" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_big_endian_16 -> let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_16" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_big_endian_32 -> let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_32" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_big_endian_64 -> let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_64" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_little_endian_16 -> let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_16" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_little_endian_32 -> let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_32" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_little_endian_64 -> let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_64" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize _ -> let baseId = "dec_Int_TwosComplement_ConstSize" - {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | Integer_uPER -> failwith "UPER encoding selected for ACN integers?" @@ -1091,25 +1092,25 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo match range with | Full -> let baseId = "decodeUnconstrainedWholeNumber" - {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [codecId]; tpe = IntegerType Long; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PosInf min -> let baseId = "decodeConstrainedPosWholeNumber" - {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min]} + {prefix = [codecId]; tpe = IntegerType ULong; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min]} | Concrete (min, max) -> if intCls.IsPositive then let baseId = "decodeConstrainedPosWholeNumber" - {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} + {prefix = [codecId]; tpe = IntegerType ULong; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} else let baseId = "decodeConstrainedWholeNumber" - {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit min; longlit max]} + {prefix = [codecId]; tpe = IntegerType Long; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit min; longlit max]} | _ -> failwith $"TODO: {range}" | _ -> forACNIntClass encCls let octetString (ot: OctetString) = - PrimitiveDecodeInfo {prefix = [codecId]; decodePureId = "decodeOctetString_no_length_vec_pure"; prefixLemmaId = "decodeOctetString_no_length_vec_prefixLemma"; extraConstArgs = [int32lit (ot.maxSize.acn)]} + PrimitiveDecodeInfo {prefix = [codecId]; tpe = vecTpe (IntegerType UByte); decodePureId = "decodeOctetString_no_length_vec_pure"; prefixLemmaId = "decodeOctetString_no_length_vec_prefixLemma"; extraConstArgs = [int32lit (ot.maxSize.acn)]} let bitString (bt: BitString) = - PrimitiveDecodeInfo {prefix = [bitStreamId]; decodePureId = "readBitsVecPure"; prefixLemmaId = "readBitsVecPrefixLemma"; extraConstArgs = [longlit bt.maxSize.acn]} - let boolean = PrimitiveDecodeInfo {prefix = [bitStreamId]; decodePureId = "readBitPure"; prefixLemmaId = "readBitPrefixLemma"; extraConstArgs = []} + PrimitiveDecodeInfo {prefix = [bitStreamId]; tpe = vecTpe (IntegerType UByte); decodePureId = "readBitsVecPure"; prefixLemmaId = "readBitsVecPrefixLemma"; extraConstArgs = [longlit bt.maxSize.acn]} + let boolean = PrimitiveDecodeInfo {prefix = [bitStreamId]; tpe = BooleanType; decodePureId = "readBitPure"; prefixLemmaId = "readBitPrefixLemma"; extraConstArgs = []} if isOptional then let baseId = $"{ToC id.dropModule.AsString}_Optional" @@ -1133,7 +1134,7 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo | _ -> // TODO: The second argument is the determinant but no idea where to fetch this from, therefore putting a dummy value let baseId = "dec_IA5String_CharIndex_External_Field_DeterminantVec" - PrimitiveDecodeInfo {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit str.maxSize.acn; longlit 0I]} + PrimitiveDecodeInfo {prefix = [acnId]; tpe = vecTpe (IntegerType UByte); decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit str.maxSize.acn; longlit 0I]} | OctetString ot -> octetString ot | _ -> let baseId = @@ -1145,7 +1146,7 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} | _ -> let baseId = "TODO_ASN1_OTHER" - PrimitiveDecodeInfo {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO + PrimitiveDecodeInfo {prefix = [acnId]; tpe = IntegerType Int; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO | Acn (AcnInteger int) -> PrimitiveDecodeInfo (forIntClass int.intClass int.acnEncodingClass int.uperRange) | Acn (AcnBoolean _) -> boolean @@ -1156,14 +1157,14 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo let min = enm.enumerated.items |> List.map(fun x -> x.acnEncodeValue) |> Seq.min let max = enm.enumerated.items |> List.map(fun x -> x.acnEncodeValue) |> Seq.max let baseId = "decodeConstrainedPosWholeNumber" - PrimitiveDecodeInfo {prefix = [codecId]; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} + PrimitiveDecodeInfo {prefix = [codecId]; tpe = IntegerType ULong; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} | _ -> PrimitiveDecodeInfo (forACNIntClass enm.enumerated.acnEncodingClass) | Acn (AcnReferenceToIA5String _) -> let baseId = $"{ToC id.dropModule.AsString}" ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} | _ -> let baseId = "TODO_ACN_OTHER" - PrimitiveDecodeInfo {prefix = [acnId]; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO + PrimitiveDecodeInfo {prefix = [acnId]; tpe = IntegerType Int; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO let selectCodecDecodeInfo (decodeInfo: DecodeInfo) (cdc: Expr): Expr = match decodeInfo with @@ -1416,6 +1417,15 @@ let generatePrefixLemmaSequenceOfLike (enc: Asn1Encoding) | Asn1TypeOrAcnRefIA5.AcnRefIA5 (tId, _) -> ToC tId.dropModule.AsString, [], [] generatePrefixLemmaCommon enc tpe (sqf.maxSizeInBits enc) baseId paramsAcn acnTps mkSizeExpr nestingScope mkSqOfLikeProof +type private SeqPrefixLemmaSubproofData = { + fd: FunDef + decInfo: DecodeInfo + elemTpe: Type + existArg: Expr option + acns: AcnChild list + paramsAcn: Var list +} + let generatePrefixLemmaSequence (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nestingScope: NestingScope) @@ -1444,7 +1454,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) body = body } - let mkFieldSubproofFn (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo): FunDef = + let mkFieldSubproofFn (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo): SeqPrefixLemmaSubproofData = let origC1 = data.c1 let origC2Reset = data.c2Reset let c1, c2 = @@ -1483,14 +1493,14 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) Assert (arrayBitRangesEq (selBufACN (Var c1)) (selBufACN (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) ] - let fieldName, asn1AcnTpe, id, isOpt, existArg, paramsAcn, acnTps = + let fieldName, asn1AcnTpe, id, isOpt, existArg, paramsAcn, acns = match child with | Asn1Child child -> let existArg = match child.Optionality with | Some (Optional _) -> - [isDefinedMutExpr (FieldSelect (Var data.v1, child._scala_name))] - | _ -> [] + Some (isDefinedMutExpr (FieldSelect (Var data.v1, child._scala_name))) + | _ -> None let acns, paramsAcn = let acns = fun () -> collectNestedAcnChildren child.Type.Kind let paramAcns = fun () -> acnExternDependenciesVariableDecode child.Type (t :: (nestingScope.parents |> List.map snd)) @@ -1504,12 +1514,12 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | Sequence _ | SequenceOf _ | Choice _ -> acns (), paramAcns () | OctetString _ | BitString _ -> [], paramAcns () | _ -> [], [] - let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) - ToC child.Name.Value, Asn1 child.Type, child.Type.id, child.Optionality.IsSome, existArg, paramsAcn, acnTps - | AcnChild child -> ToC child.Name.Value, Acn child.Type, child.id, false, [], [], [] + ToC child.Name.Value, Asn1 child.Type, child.Type.id, child.Optionality.IsSome, existArg, paramsAcn, acns + | AcnChild child -> ToC child.Name.Value, Acn child.Type, child.id, false, None, [], [] + let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) let elemTpe = fromAsn1AcnType asn1AcnTpe let decInfo = decodeInfo asn1AcnTpe id isOpt - + let existArgList = existArg |> Option.toList let c1Next = {Var.name = $"c1_{ix + 2}"; tpe = origC1.tpe} let c2Next = {Var.name = $"c2_{ix + 2}"; tpe = origC1.tpe} let res1 = {Var.name = $"{fieldName}_1"; tpe = elemTpe} @@ -1528,13 +1538,13 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) args = [ selectCodecDecodeInfo decInfo (Var c1) selectCodecDecodeInfo decInfo (Var c2Moved) - ] @ existArg @ info.extraConstArgs + ] @ existArgList @ info.extraConstArgs parameterless = true } let dec1 = {Var.name = "dec1"; tpe = elemTpe} let dec2 = {Var.name = "dec2"; tpe = elemTpe} - let dec1Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c1); id = info.decodePureId; args = existArg @ info.extraConstArgs; parameterless = false} - let dec2Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c2); id = info.decodePureId; args = existArg @ info.extraConstArgs; parameterless = false} + let dec1Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c1); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} + let dec2Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c2); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} let v1Value, v2Value = match child with | Asn1Child child -> @@ -1545,11 +1555,11 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let ncount = paramsAcn |> List.map (fun v -> // The variable may have type ULong, we need to unwrap it as the constructor expects a Long match v.tpe with - | IntegerType ULong -> IntCast (Var v, ULong, Long) + | IntegerType ULong -> intCast (Var v) ULong Long | _ -> Var v ) - let v1Value = ClassCtor {ct = {id = id; tps = []}; args = ncount @ [Var dec1]} - let v2Value = ClassCtor {ct = {id = id; tps = []}; args = ncount @ [Var dec2]} + let v1Value = ClassCtor {ct = {prefix = []; id = id; tps = []; parameterless = false}; args = ncount @ [Var dec1]} + let v2Value = ClassCtor {ct = {prefix = []; id = id; tps = []; parameterless = false}; args = ncount @ [Var dec2]} v1Value, v2Value | _ -> assert paramsAcn.IsEmpty @@ -1565,20 +1575,20 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) args = [ selectCodecDecodeInfo decInfo (Var c1) selectCodecDecodeInfo decInfo (Var c2Moved) - ] @ [Var childSize] @ existArg @ (paramsAcn |> List.map Var) + ] @ [Var childSize] @ existArgList @ (paramsAcn |> List.map Var) parameterless = true } - let decResTpe = ClassType (eitherMutTpe (IntegerType Int) (tupleType (elemTpe :: acnTps))) + let decResTpe = eitherMutTpe (IntegerType Int) (tupleType (elemTpe :: acnTps)) let dec1 = {Var.name = "dec1"; tpe = decResTpe} let dec2 = {Var.name = "dec2"; tpe = decResTpe} let dec1Call = FunctionCall { prefix = []; id = info.decodePureId; tps = [] - args = [selectCodecDecodeInfo decInfo (Var c1)] @ existArg @ (paramsAcn |> List.map Var) + args = [selectCodecDecodeInfo decInfo (Var c1)] @ existArgList @ (paramsAcn |> List.map Var) parameterless = true } let dec2Call = FunctionCall { prefix = []; id = info.decodePureId; tps = [] - args = [selectCodecDecodeInfo decInfo (Var c2)] @ existArg @ (paramsAcn |> List.map Var) + args = [selectCodecDecodeInfo decInfo (Var c2)] @ existArgList @ (paramsAcn |> List.map Var) parameterless = true } @@ -1698,7 +1708,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) ]) ]) - { + let fd = { FunDef.id = $"proof_{ToC name}" prms = if ix = 0 then paramsAcn else [c1; c2] @ paramsAcn annots = [Opaque; InlineOnce] @@ -1707,23 +1717,184 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) returnTpe = UnitType body = proof } + {fd = fd; existArg = existArg; elemTpe = elemTpe; decInfo = decInfo; acns = acns; paramsAcn = paramsAcn} + + let mkSubfieldProofCall (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo) (proofData: SeqPrefixLemmaSubproofData option): Expr = + let origC1 = data.c1 + let origC2Reset = data.c2Reset + let c1Prev, c2Prev = + if ix = 0 then origC1, origC2Reset + else {Var.name = $"c1_{ix}"; tpe = origC1.tpe}, {Var.name = $"c2_{ix}"; tpe = origC1.tpe} + let c1, c2 = {Var.name = $"c1_{ix + 1}"; tpe = origC1.tpe}, {Var.name = $"c2_{ix + 1}"; tpe = origC1.tpe} + + match proofData with + | None -> + // NullType case: we assign the codecs to the previous ones + // TODO: handle case where there is a bitpattern + letsIn [(c1, Var c1Prev); (c2, Var c2Prev)] (mkBlock []) + | Some proofData -> + let codecArgs = if ix = 0 then [] else [Var c1Prev; Var c2Prev] + let existArgList = proofData.existArg |> Option.toList + + let mkAcnBinding (dec1: Var) (c: AcnChild): Expr = + // This ACN variable will be picked up by the later decode functions. It is important it to be bound with that specific name + // Note that the calls with c1 and c2 yield the same values, we arbitrarily pick the value from the call with c1. + let v = {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type} + match c.Type with + | AcnReferenceToEnumerated enm -> + // For Enumerated, we need to transform the integer to a Scala enum + let primDecInfo = + match proofData.decInfo with + | PrimitiveDecodeInfo info -> info + | _ -> failwith "Enumerated ACN child decoded with a generated function?" + let intTpe = + match primDecInfo.tpe with + | IntegerType tp -> tp + | _ -> failwith $"${v.name} has not an IntegerType type" + let branches = enm.enumerated.items |> List.map (fun i -> + let cond = Equals (Var dec1, IntLit (intTpe, i.acnEncodeValue)) + let branch = ClassCtor {ct = {prefix = [enm.enumerated.typeDef.[Scala].typeName]; id = i.scala_name; tps = []; parameterless = true}; args = []} + cond, branch + ) + let transform = ifElseBranches branches (mkBlock [Check (BoolLit false); TripleQMark]) + letsIn [v, transform] (mkBlock []) + | _ -> + match proofData.decInfo with + | PrimitiveDecodeInfo _ -> letsIn [v, Var dec1] (mkBlock []) + | ComposedDecodeInfo _ -> + let bdg = {Var.name = "bdg"; tpe = v.tpe} + let extracted = eitherMutMatchExpr (Var dec1) None (mkBlock [Check (BoolLit false); TripleQMark]) (Some bdg) (Var bdg) + letsIn [v, extracted] (mkBlock []) + + let callsBdgs = + match proofData.decInfo with + | PrimitiveDecodeInfo info -> + let dec1 = {Var.name = $"dec1_{ix + 1}"; tpe = proofData.elemTpe} + let dec2 = {Var.name = $"dec2_{ix + 1}"; tpe = proofData.elemTpe} + let dec1Call = MethodCall {recv = selectCodecDecodeInfo proofData.decInfo (Var c1Prev); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} + let dec2Call = MethodCall {recv = selectCodecDecodeInfo proofData.decInfo (Var c2Prev); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} + + // Note: methods from BitStream/Codec return BitStream/Codec, so we need to wrap them back into an ACN codec. + let callsBdgs = + let wrapAcn (cdcId: Identifier) (recv: Expr): Expr = + assert (cdcId = bitStreamId || cdcId = codecId) + if cdcId = codecId then ClassCtor {ct = acnClsTpe; args = [recv]} + else ClassCtor {ct = acnClsTpe; args = [ClassCtor {ct = codecClsTpe; args = [recv]}]} + let mkNonAcnBdg (cdcId: Identifier): Expr = + assert (cdcId = bitStreamId || cdcId = codecId) + let cdcTpe = ClassType {prefix = []; id = cdcId; tps = []; parameterless = false} + let c1Tmp, c2Tmp = {Var.name = $"c1_{ix + 1}_tmp"; tpe = cdcTpe}, {Var.name = $"c2_{ix + 1}_tmp"; tpe = cdcTpe} + letTuple [c1Tmp; dec1] dec1Call (mkBlock [ + letTuple [c2Tmp; dec2] dec2Call (mkBlock [ + letsIn [(c1, wrapAcn cdcId (Var c1Tmp)); (c2, wrapAcn cdcId (Var c2Tmp))] (mkBlock []) + ]) + ]) + if info.prefix = [bitStreamId] then mkNonAcnBdg bitStreamId + else if info.prefix = [codecId] then mkNonAcnBdg codecId + else + letTuple [c1; dec1] dec1Call (mkBlock [ + letTuple [c2; dec2] dec2Call (mkBlock [])]) + + let acnBinding = + match child with + | AcnChild c -> mkAcnBinding dec1 c + | Asn1Child _ -> mkBlock [] + + mkBlock [ + callsBdgs + acnBinding + ] + | ComposedDecodeInfo info -> + // The ACN values returned by this function. Since the calls with c1 and c2 yield the same values, we arbitrarily bind + // these variables to the first call. The variable name is important here as it will be picked up by later fields + // that depends on these ACNs. + let acnVars = proofData.acns |> List.map (fun c -> {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type}) + let acnTps = acnVars |> List.map (fun v -> v.tpe) + let decResTpe = eitherMutTpe (IntegerType Int) (tupleType (proofData.elemTpe :: acnTps)) + let dec1 = {Var.name = $"dec1_{ix + 1}"; tpe = decResTpe} + let dec2 = {Var.name = $"dec2_{ix + 1}"; tpe = decResTpe} + let dec1Call = FunctionCall { + prefix = []; id = info.decodePureId; tps = [] + args = [selectCodecDecodeInfo proofData.decInfo (Var c1Prev)] @ existArgList @ (proofData.paramsAcn |> List.map Var) + parameterless = true + } + let dec2Call = FunctionCall { + prefix = []; id = info.decodePureId; tps = [] + args = [selectCodecDecodeInfo proofData.decInfo (Var c2Prev)] @ existArgList @ (proofData.paramsAcn |> List.map Var) + parameterless = true + } + let acnBinding = + if acnVars.IsEmpty then + match child with + | AcnChild c -> mkAcnBinding dec1 c + | Asn1Child _ -> mkBlock [] + else + // Only Asn1 children (in particular, sequences) may return ACN values + assert ( + match child with + | AcnChild _ -> false + | Asn1Child _ -> true + ) + let decTmp = {Var.name = $"decTmp_{ix + 1}"; tpe = tupleType (proofData.elemTpe :: acnTps)} + let decTmpValue = eitherMutMatchExpr (Var dec1) None (mkBlock [Check (BoolLit false); TripleQMark]) (Some decTmp) (Var decTmp) + let acnBdgs = acnVars |> List.indexed |> List.map (fun (ix, v) -> v, TupleSelect (Var decTmp, ix + 2)) + letsIn ((decTmp, decTmpValue) :: acnBdgs) (mkBlock []) + + letTuple [c1; dec1] dec1Call (mkBlock [ + letTuple [c2; dec2] dec2Call acnBinding]) + + mkBlock [ + ApplyLetRec {id = proofData.fd.id; args = codecArgs @ (proofData.paramsAcn |> List.map Var)} + callsBdgs + ] + + //////////////////////////// let mkSeqProof (data: PrefixLemmaData): Expr = let bodyWithC1 = mkUnfoldedDecodeWrapper data bodyWithC1Id data.c1 let bodyWithC2 = mkUnfoldedDecodeWrapper data bodyWithC2Id data.c2Reset - let subproofsFns = (sq.children |> + let subproofs = (sq.children |> List.indexed |> - List.filter (fun (_, c) -> + List.map (fun (i, c) -> match c with - | Asn1Child c -> - match c.Type.Kind with - | NullType nt -> false // TODO: Not quite, if the NT has an encoding pattern, there is some logic to do - | _ -> true - | AcnChild _ -> true - ) |> - List.map (fun (i, c) -> mkFieldSubproofFn data i c)) - let proof = LetRec {fds = subproofsFns; body = UnitLit} + | Asn1Child asn1 -> + match asn1.Type.Kind with + | NullType _ -> i, c, None // TODO: Not quite, if the NT has an encoding pattern, there is some logic to do + | _ -> i, c, Some (mkFieldSubproofFn data i c) + | AcnChild _ -> i, c, Some (mkFieldSubproofFn data i c) + )) + let subproofFns = subproofs |> List.choose (fun (_, _, sp) -> sp |> Option.map (fun sp -> sp.fd)) + let subproofCalls = subproofs |> List.map (fun (i, c, sp) -> mkSubfieldProofCall data i c sp) + let finalCheck = + let decodedChecks = Check (Equals (Var data.v1, Var data.v2)) + let acnChecks = List.zip data.decodedAcn1 data.decodedAcn2 |> List.map (fun (acn1, acn2) -> Check (Equals (Var acn1, Var acn2))) + MatchExpr { + scrut = Var data.decodingRes2 + cases = [ + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [data.subPat2] + } + rhs = mkBlock (decodedChecks :: acnChecks) + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = Check (BoolLit false) + } + ] + } + let body = mkBlock ([ + ApplyLetRec {id = bodyWithC1.id; args = []} + ApplyLetRec {id = bodyWithC2.id; args = []} + ] @ subproofCalls @ [finalCheck]) + let proof = LetRec {fds = subproofFns; body = body} let rightMutCase = letsIn (data.v1SizeExpr.bdgs @ [data.v1SizeVar, data.v1SizeExpr.resSize]) ( @@ -1809,7 +1980,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) let outermostPVal = {Var.name = "pVal"; tpe = fromAsn1TypeKind (nestingScope.parents |> List.last |> snd).Kind} let acnExtVars = acnExternDependenciesVariableEncode t nestingScope |> Option.toList - let resPostcond = {Var.name = "res"; tpe = ClassType (eitherTpe errTpe retTpe)} + let resPostcond = {Var.name = "res"; tpe = eitherTpe errTpe retTpe} let decodePureId = $"{baseId}_ACN_Decode_pure" let szRecv = {Var.name = recSel.arg.asLastOrSelf.receiverId; tpe = tpe} let sz = @@ -1827,7 +1998,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) specs = precond annots = [Opaque; InlineOnce] postcond = Some (resPostcond, postcondExpr) - returnTpe = ClassType (eitherTpe errTpe retTpe) + returnTpe = eitherTpe errTpe retTpe body = body } @@ -1835,7 +2006,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map Var) @ [outerPVal]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! - let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} + let leftHACK = ClassCtor {ct = {prefix = []; id = leftId; tps = []; parameterless = false}; args = [Var leftBdg]} let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! if acnsVars.IsEmpty then eitherMatchExpr scrut (Some leftBdg) leftBody None UnitLit @@ -1866,7 +2037,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) [fd], call | Decode -> let retTpe = tupleType (tpe :: acnTps) - let fnRetTpe = ClassType (eitherMutTpe errTpe retTpe) + let fnRetTpe = eitherMutTpe errTpe retTpe let outerPVal = {Var.name = outerSel.arg.asIdentifier; tpe = tpe} let retInnerFd = let retVal = mkTuple (Var recPVal :: (acnsVars |> List.map Var)) @@ -1934,7 +2105,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (paramsAcn |> List.map Var); parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! - let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} + let leftHACK = ClassCtor {ct = {prefix = []; id = leftMutId; tps = []; parameterless = false}; args = [Var leftBdg]} let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! let rightBdg = {Var.name = "v"; tpe = tpe} let rightBody = Var rightBdg @@ -2213,7 +2384,6 @@ let generateEnumAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1 if r.args.stainlessInvertibility && enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaEnum enc t nestingScope enm] else [] - let generateSequenceOfLikeProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = None @@ -2232,7 +2402,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding let outerSqf = if enc = ACN || codec = Decode then Var sqfVar else SelectionExpr (joinedSelection pg.cs.arg) - let collTpe = ClassType (vecTpe elemTpe) + let collTpe = vecTpe elemTpe let td = match sqf with | SqOf sqf -> sqf.typeDef.[Scala].typeName @@ -2297,7 +2467,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding match sqf with | StrType _ when not sqf.isFixedSize -> [count] | _ -> [] - let fnRetTpe = ClassType (eitherTpe (IntegerType Int) (IntegerType Int)) + let fnRetTpe = eitherTpe (IntegerType Int) (IntegerType Int) let reccall = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ (countParam |> List.map Var) @ [Var sqfVar; plus [Var from; int32lit 1I]]; parameterless = true} let checkRange = match sqf with @@ -2400,7 +2570,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding let mkDecodeRecursiveFn (): FunDef * Expr = let countParam = if sqf.isFixedSize then [] else [count] - let fnRetTpe = ClassType (eitherMutTpe (IntegerType Int) collTpe) + let fnRetTpe = eitherMutTpe (IntegerType Int) collTpe let sqfVecVar = {Var.name = pg.cs.arg.asIdentifier; tpe = collTpe} let thnCase = let ret = @@ -2475,13 +2645,13 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding let scrut = FunctionCall {prefix = []; id = fnid; tps = []; args = [Var cdc] @ count @ [vecEmpty elemTpe; int32lit 0I]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = IntegerType Int} // TODO: FIXME: the right type must be the outside type!!! - let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} + let leftHACK = ClassCtor {ct = {prefix = []; id = leftMutId; tps = []; parameterless = false}; args = [Var leftBdg]} let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! let rightBdg = {Var.name = "bdg"; tpe = collTpe} let rightBody = match sqf with | SqOf _ -> - let ctor = ClassCtor {ct = {id = td; tps = []}; args = count @ [Var rightBdg]} + let ctor = ClassCtor {ct = {prefix = []; id = td; tps = []; parameterless = false}; args = count @ [Var rightBdg]} letsIn [sqfVar, ctor] (mkBlock ((sizeLemmaCall |> Option.map Ghost |> Option.toList) @ [Var sqfVar])) | StrType _ -> mkBlock ((sizeLemmaCall |> Option.map Ghost |> Option.toList) @ [Var rightBdg]) letsIn [sqfVar, eitherMutMatchExpr scrut (Some leftBdg) leftBody (Some rightBdg) rightBody] (mkBlock []) @@ -2555,7 +2725,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding | StrType str -> str | _ -> failwith "ACN reference to string but not a StrType?" let countParam = if sqf.isFixedSize then [] else [count] - let fnRetTpe = ClassType (eitherMutTpe (IntegerType Int) collTpe) + let fnRetTpe = eitherMutTpe (IntegerType Int) collTpe let fromBounds = if sqf.isFixedSize then [] else [Precond (Leq (int32lit 0I, nbItems))] @@ -2588,7 +2758,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding let scrut = FunctionCall {prefix = []; id = fdWrapper.id; tps = []; args = [Var cdc] @ countAcnVar; parameterless = true} let leftBdg = {Var.name = "l"; tpe = IntegerType Int} // TODO: FIXME: the right type must be the outside type!!! - let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} + let leftHACK = ClassCtor {ct = {prefix = []; id = leftMutId; tps = []; parameterless = false}; args = [Var leftBdg]} let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! let rightBdg = {Var.name = "bdg"; tpe = collTpe} let rightBody = mkBlock ((sizeLemmaCall |> Option.map Ghost |> Option.toList) @ [Var rightBdg]) @@ -2634,7 +2804,7 @@ let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc let existVar = soc.existVar |> Option.map (fun v -> {Var.name = v; tpe = BooleanType}) let mkSizeExpr = fun v1 c1 -> optionalSizeExpr soc.child.toAsn1AcnAst (Var v1) (bitIndexACN (Var c1)) 0I 0I let elemTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind - let tpe = ClassType (optionMutTpe elemTpe) + let tpe = optionMutTpe elemTpe generatePrefixLemmaCommon enc tpe soc.child.Type.toAsn1AcnAst.acnMaxSizeInBits baseId ((existVar |> Option.toList) @ paramsAcn) [] mkSizeExpr soc.nestingScope mkProof (* @@ -2723,7 +2893,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc let oldCdc = {Var.name = $"oldCdc"; tpe = ClassType codecTpe} let childAsn1Tpe = soc.child.Type.toAsn1AcnAst let childTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind - let optChildTpe = ClassType (optionMutTpe childTpe) + let optChildTpe = optionMutTpe childTpe let fnid, fnIdPure = let fnId = match codec with @@ -2745,7 +2915,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc match codec with | Encode -> let rightTpe = IntegerType Int - let fnRetTpe = ClassType (eitherTpe errTpe rightTpe) + let fnRetTpe = eitherTpe errTpe rightTpe let childVar = {Var.name = soc.p.arg.lastId; tpe = optChildTpe} let cstrCheck = isValidFuncName |> Option.map (fun validFnName -> @@ -2784,7 +2954,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal] @ ((acnExtVars @ paramsAcn) |> List.map Var) @ [outerPVal]; parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! - let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} + let leftHACK = ClassCtor {ct = {prefix = []; id = leftId; tps = []; parameterless = false}; args = [Var leftBdg]} let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! eitherMatchExpr scrut (Some leftBdg) leftBody None UnitLit @@ -2795,7 +2965,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc let rightTpe = optChildTpe let outerPVal = {Var.name = soc.p.arg.asIdentifier; tpe = rightTpe} let encDec = EncDec (soc.childBody {soc.p with arg = soc.p.arg.asLastOrSelf} soc.existVar) - let fnRetTpe = ClassType (eitherMutTpe errTpe rightTpe) + let fnRetTpe = eitherMutTpe errTpe rightTpe let retVal = {Var.name = soc.p.arg.lastId; tpe = childTpe} let retInnerFd = let rightRet = rightMutExpr errTpe rightTpe (Var retVal) @@ -2839,7 +3009,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (existVar |> Option.map Var |> Option.toList) @ (paramsAcn |> List.map Var); parameterless = true} let leftBdg = {Var.name = "l"; tpe = errTpe} // TODO: FIXME: the right type must be the outside type!!! - let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} + let leftHACK = ClassCtor {ct = {prefix = []; id = leftMutId; tps = []; parameterless = false}; args = [Var leftBdg]} let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! let rightBdg = {Var.name = "v"; tpe = childTpe} let rightBody = Var rightBdg From 96f7fea5d4da06490788d3f22300a79a91a3a242 Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Thu, 15 Aug 2024 09:51:30 +0200 Subject: [PATCH 25/35] Expand prefix lemma proofs and add support for presence bits --- StgScala/ProofGen.fs | 212 ++++++++++++++++++++++++++----------------- 1 file changed, 128 insertions(+), 84 deletions(-) diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 9449b3a41..6fa25030a 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -18,8 +18,10 @@ let getAccess (acc: Accessor) = | ValueAccess (sel, _, _) -> $".{sel}" | PointerAccess (sel, _, _) -> $".{sel}" | ArrayAccess (ix, _) -> $"({ix})" + let joinedSelection (sel: Selection): string = List.fold (fun str accessor -> $"{str}{getAccess accessor}") sel.receiverId sel.path + let getAcnDeterminantName (id : ReferenceToType) = match id with | ReferenceToType path -> @@ -258,7 +260,6 @@ let countNbPresenceBits (sq: Sequence): int = | _ -> 0 ) -// TODO: UPER/ACN type SizeExprRes = { bdgs: (Var * Expr) list @@ -273,16 +274,17 @@ with member this.allBindings: (Var * Expr) list = this.extraBdgs @ [this.childVar, this.childSize] member this.allVariables: Var list = this.allBindings |> List.map (fun (v, _) -> v) -let renameBindings (bdgs: (Var * Expr) list) (suffix: string): (Var * Expr) list = - let allVars = bdgs |> List.map fst +let renameBindingsSizeRes (res: SizeExprRes) (suffix: string): SizeExprRes = + let allVars = res.bdgs |> List.map fst let renamedVars = allVars |> List.map (fun v -> {v with name = $"{v.name}{suffix}"}) let mapping = List.zip allVars (renamedVars |> List.map Var) let renamedVarFor (old: Var): Var = renamedVars.[allVars |> List.findIndex (fun v -> v = old)] - bdgs |> List.map (fun (v, e) -> renamedVarFor v, substVars mapping e) + let newBdgs = res.bdgs |> List.map (fun (v, e) -> renamedVarFor v, substVars mapping e) + let newResSize = substVars mapping res.resSize + {bdgs = newBdgs; resSize = newResSize} - -let renameBindingsSizeRes (res: SeqSizeExprChildRes list) (suffix: string): SeqSizeExprChildRes list = +let renameBindingsSeqSizeRes (res: SeqSizeExprChildRes list) (suffix: string): SeqSizeExprChildRes list = let allVars = res |> List.collect (fun res -> res.allVariables) let renamedVars = allVars |> List.map (fun v -> {v with name = $"{v.name}{suffix}"}) let mapping = List.zip allVars (renamedVars |> List.map Var) @@ -468,9 +470,9 @@ let seqSizeFunDefs (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence): FunDef li let otherOffset = template.prms.[1] let allResWithOffset = seqSizeExprHelper sq This (Var offset) 0I 0I - let allResWithOffset = renameBindingsSizeRes allResWithOffset "_offset" + let allResWithOffset = renameBindingsSeqSizeRes allResWithOffset "_offset" let allResWithOtherOffset = seqSizeExprHelper sq This (Var otherOffset) 0I 0I - let allResWithOtherOffset = renameBindingsSizeRes allResWithOtherOffset "_otherOffset" + let allResWithOtherOffset = renameBindingsSeqSizeRes allResWithOtherOffset "_otherOffset" let proofSubcase (ix: int, (resWithOffset: SeqSizeExprChildRes, resWithOtherOffset: SeqSizeExprChildRes, child: SeqChildInfo option)) (rest: Expr): Expr = let withBindingsPlugged (expr: Expr option): Expr = @@ -1015,6 +1017,8 @@ type DecodeInfo = | PrimitiveDecodeInfo of PrimitiveDecodeInfo | ComposedDecodeInfo of ComposedDecodeInfo +let booleanDecodeInfo = {PrimitiveDecodeInfo.prefix = [bitStreamId]; tpe = BooleanType; decodePureId = "readBitPure"; prefixLemmaId = "readBitPrefixLemma"; extraConstArgs = []} + let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bool): DecodeInfo = let forACNIntClass (encCls: IntEncodingClass): PrimitiveDecodeInfo = match encCls with @@ -1110,7 +1114,6 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo PrimitiveDecodeInfo {prefix = [codecId]; tpe = vecTpe (IntegerType UByte); decodePureId = "decodeOctetString_no_length_vec_pure"; prefixLemmaId = "decodeOctetString_no_length_vec_prefixLemma"; extraConstArgs = [int32lit (ot.maxSize.acn)]} let bitString (bt: BitString) = PrimitiveDecodeInfo {prefix = [bitStreamId]; tpe = vecTpe (IntegerType UByte); decodePureId = "readBitsVecPure"; prefixLemmaId = "readBitsVecPrefixLemma"; extraConstArgs = [longlit bt.maxSize.acn]} - let boolean = PrimitiveDecodeInfo {prefix = [bitStreamId]; tpe = BooleanType; decodePureId = "readBitPure"; prefixLemmaId = "readBitPrefixLemma"; extraConstArgs = []} if isOptional then let baseId = $"{ToC id.dropModule.AsString}_Optional" @@ -1122,7 +1125,7 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo | Integer int -> PrimitiveDecodeInfo (forIntClass int.intClass int.acnEncodingClass int.uperRange) | BitString bt -> bitString bt | OctetString ot -> octetString ot - | Boolean _ -> boolean + | Boolean _ -> PrimitiveDecodeInfo booleanDecodeInfo | ReferenceType rt -> match rt.resolvedType.ActualType.Kind with | BitString bt -> bitString bt @@ -1149,7 +1152,7 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo PrimitiveDecodeInfo {prefix = [acnId]; tpe = IntegerType Int; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO | Acn (AcnInteger int) -> PrimitiveDecodeInfo (forIntClass int.intClass int.acnEncodingClass int.uperRange) - | Acn (AcnBoolean _) -> boolean + | Acn (AcnBoolean _) -> PrimitiveDecodeInfo booleanDecodeInfo | Acn (AcnReferenceToEnumerated enm) -> match enm.enumerated.acnEncodingClass with | Integer_uPER -> @@ -1430,13 +1433,8 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nestingScope: NestingScope) (sq: Sequence): FunDef = - - let tpe = fromAsn1TypeKind t.Kind - // TODO: Presence bits!!!! - // TODO: Presence bits!!!! - // TODO: Presence bits!!!! - // TODO: Presence bits!!!! - let childrenSizes = [0..sq.children.Length] |> List.map (fun i -> {Var.name = $"size_1_{i}"; tpe = IntegerType Long}) + let nbPresenceBits = countNbPresenceBits sq + let childrenSizes = [0..nbPresenceBits + sq.children.Length] |> List.map (fun i -> {Var.name = $"size_1_{i}"; tpe = IntegerType Long}) let bodyWithC1Id = "bodyWithC1" let bodyWithC2Id = "bodyWithC2" @@ -1454,7 +1452,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) body = body } - let mkFieldSubproofFn (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo): SeqPrefixLemmaSubproofData = + let mkFieldSubproofFn (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo option): SeqPrefixLemmaSubproofData = let origC1 = data.c1 let origC2Reset = data.c2Reset let c1, c2 = @@ -1473,11 +1471,6 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) Precond (Equals (bitIndexACN (Var c1), bitIndexACN (Var c2))) ] - let name = - match child with - | Asn1Child child -> child.Name.Value - | AcnChild child -> child.Name.Value - let slicedLemmaApp = (arrayBitRangesEqSlicedLemma (selBufACN (Var c1)) (selBufACN (Var c2)) @@ -1493,9 +1486,13 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) Assert (arrayBitRangesEq (selBufACN (Var c1)) (selBufACN (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) ] - let fieldName, asn1AcnTpe, id, isOpt, existArg, paramsAcn, acns = + let fieldName, elemTpe, decInfo, existArg, paramsAcn, acns = match child with - | Asn1Child child -> + | None -> + $"presence_bit_{ix + 1}", BooleanType, PrimitiveDecodeInfo booleanDecodeInfo, None, [], [] + | Some (Asn1Child child) -> + let elemTpe = fromAsn1TypeKind child.Type.Kind + let decInfo = decodeInfo (Asn1 child.Type) child.Type.id child.Optionality.IsSome let existArg = match child.Optionality with | Some (Optional _) -> @@ -1514,11 +1511,12 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | Sequence _ | SequenceOf _ | Choice _ -> acns (), paramAcns () | OctetString _ | BitString _ -> [], paramAcns () | _ -> [], [] - ToC child.Name.Value, Asn1 child.Type, child.Type.id, child.Optionality.IsSome, existArg, paramsAcn, acns - | AcnChild child -> ToC child.Name.Value, Acn child.Type, child.id, false, None, [], [] + ToC child.Name.Value, elemTpe, decInfo, existArg, paramsAcn, acns + | Some (AcnChild child) -> + let elemTpe = fromAcnInsertedType child.Type + let decInfo = decodeInfo (Acn child.Type) child.id false + ToC child.Name.Value, elemTpe, decInfo, None, [], [] let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) - let elemTpe = fromAsn1AcnType asn1AcnTpe - let decInfo = decodeInfo asn1AcnTpe id isOpt let existArgList = existArg |> Option.toList let c1Next = {Var.name = $"c1_{ix + 2}"; tpe = origC1.tpe} let c2Next = {Var.name = $"c2_{ix + 2}"; tpe = origC1.tpe} @@ -1527,7 +1525,9 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let decodedAcn1 = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn_1_{ix + 1}"; tpe = tpe}) let decodedAcn2 = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn_2_{ix + 1}"; tpe = tpe}) - let prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, v1Value, v2Value = + // For decoding functions that return Either, res1ValuePostcond and res2ValuePostcond are pattern matching that extract the Right value + // without matching on Left (since the proof shows that the function does not fail) + let prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, res1ValueProof, res2ValueProof, res1ValuePostcond, res2ValuePostcond = match decInfo with | PrimitiveDecodeInfo info -> assert acnTps.IsEmpty @@ -1545,9 +1545,9 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let dec2 = {Var.name = "dec2"; tpe = elemTpe} let dec1Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c1); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} let dec2Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c2); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} - let v1Value, v2Value = + let res1ValueProof, res2ValueProof = match child with - | Asn1Child child -> + | Some (Asn1Child child) -> match child.Type.ActualType.Kind with | BitString _ | OctetString _ -> assert (paramsAcn.Length <= 1) @@ -1564,10 +1564,10 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | _ -> assert paramsAcn.IsEmpty Var dec1, Var dec2 - | AcnChild _ -> + | Some (AcnChild _) | None -> assert paramsAcn.IsEmpty Var dec1, Var dec2 - prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, v1Value, v2Value + prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, res1ValueProof, res2ValueProof, res1ValueProof, res2ValueProof | ComposedDecodeInfo info -> let prefixLemmaApp = FunctionCall { @@ -1609,10 +1609,10 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let leftMutPat: Pattern = ADTPattern {binder = None; id = leftMutId; subPatterns = [Wildcard None]} let rightMutPat (subPat: Pattern): Pattern = ADTPattern {binder = None; id = rightMutId; subPatterns = [subPat]} - let v1Value = + let res1ValueProof = let proofContradiction = { - FunDef.id = "proof" + FunDef.id = $"proof_unreachability_{fieldName}" prms = [] annots = [Pure; Opaque; InlineOnce] specs = [] @@ -1635,13 +1635,13 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) } ] } - let v2Value = + let res2ValueProof = MatchExpr { scrut = Var dec2 cases = [ { pattern = rightMutPat subPat2 - rhs = mkTuple ((Var res1) :: (decodedAcn2 |> List.map Var)) + rhs = mkTuple ((Var res2) :: (decodedAcn2 |> List.map Var)) } { pattern = leftMutPat @@ -1649,24 +1649,37 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) } ] } - - prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, v1Value, v2Value - - let validateOffsLemma = validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN (Var c1)) (selBufACN (Var c2)) (longlit child.acnMaxSizeInBits) - - let proof = mkBlock [ - slicedLemmaApp - letsIn [c2Moved, c2MovedValue] (mkBlock ( - c2MovedAssertions @ [prefixLemmaApp; validateOffsLemma] - )) - ] - - let accOffsets = if ix = 0 then longlit 0I else childrenSizes |> List.take ix |> List.map Var |> plus - let v1Size = - match child with - | Asn1Child asn1 -> - optionalSizeExpr asn1 (Var res1) (plus [bitIndexACN (Var c1); accOffsets]) 0I 0I - | AcnChild child -> {bdgs = []; resSize = acnTypeSizeExpr child.Type} + let res1ValuePostcond = + MatchExpr { + scrut = Var dec1 + cases = [ + { + pattern = rightMutPat subPat1 + rhs = mkTuple ((Var res1) :: (decodedAcn1 |> List.map Var)) + } + { + pattern = leftMutPat + rhs = TripleQMark + } + ] + } + let res2ValuePostcond = + MatchExpr { + scrut = Var dec2 + cases = [ + { + pattern = rightMutPat subPat2 + rhs = mkTuple ((Var res2) :: (decodedAcn2 |> List.map Var)) + } + { + pattern = leftMutPat + rhs = TripleQMark + } + ] + } + prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, res1ValueProof, res2ValueProof, res1ValuePostcond, res2ValuePostcond + let maxSizeInBits = child |> Option.map (fun c -> c.acnMaxSizeInBits) |> Option.defaultValue 1I + let validateOffsLemma = validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN (Var c1)) (selBufACN (Var c2)) (longlit maxSizeInBits) // Note: The pure decoding methods on BitStream and Codec base classes return a BitStream and Codec respectively, // we therefore need to select the base in such cases. @@ -1686,30 +1699,59 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) else bitIndexACN cdc | ComposedDecodeInfo _ -> bitIndexACN cdc + let accOffsets = if ix = 0 then longlit 0I else childrenSizes |> List.take ix |> List.map Var |> plus + let v1Size = + match child with + | Some (Asn1Child asn1) -> + // Note: the bindings resulting from this size for this child may conflict with the bindings in `childrenSizes` + // We therefore suffix these + let res = optionalSizeExpr asn1 (Var res1) (bitIndexACN (Var c1)) 0I 0I + renameBindingsSizeRes res $"_{fieldName}" + | Some (AcnChild child) -> {bdgs = []; resSize = acnTypeSizeExpr child.Type} + | None -> + // Presence bits + {bdgs = []; resSize = longlit 1I} + + let conds = ([ + Equals (v1Size.resSize, Var childSize) + Equals (Var res1, Var res2) + ] @ (List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2))) @ [ + // Note: c1Next and c2Next may be Codec/BitStream instead of ACN, we therefore need to adjust as said in the comment above + // origC1 and origC2Reset are however ACN + Equals (selBuf (Var c1Next), selBufACN (Var origC1)) + Equals (selBuf (Var c2Next), selBufACN (Var origC2Reset)) + Equals (bitIndex (Var c1Next), plus [bitIndexACN (Var origC1); accOffsets; Var childSize]) + Equals (bitIndex (Var c1Next), bitIndex (Var c2Next)) + ]) + let proof = mkBlock [ + slicedLemmaApp + letsIn [c2Moved, c2MovedValue] (mkBlock ( + c2MovedAssertions @ [prefixLemmaApp; validateOffsLemma] @ + [letTuple [c1Next; dec1] dec1Call (mkBlock [ + letTuple [c2Next; dec2] dec2Call (mkBlock [ + letTuple (res1 ::decodedAcn1) res1ValueProof (mkBlock [ + letTuple (res2 ::decodedAcn2) res2ValueProof ( + letsIn v1Size.bdgs (mkBlock (conds |> List.map Check)) + ) + ]) + ]) + ])] + )) + ] + let postcondExpr = - let conds = SplitAnd ([ - Equals (v1Size.resSize, Var childSize) - Equals (Var res1, Var res2) - ] @ (List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2))) @ [ - // Note: c1Next and c2Next may be Codec/BitStream instead of ACN, we therefore need to adjust as said in the comment above - // origC1 and origC2Reset are however ACN - Equals (selBuf (Var c1Next), selBufACN (Var origC1)) - Equals (selBuf (Var c2Next), selBufACN (Var origC2Reset)) - Equals (bitIndex (Var c1Next), plus [bitIndexACN (Var origC1); accOffsets; Var childSize]) - Equals (bitIndex (Var c1Next), bitIndex (Var c2Next)) - ]) letTuple [c1Next; dec1] dec1Call (mkBlock [ letTuple [c2Next; dec2] dec2Call (mkBlock [ - letTuple (res1 ::decodedAcn1) v1Value (mkBlock [ - letTuple (res2 ::decodedAcn2) v2Value ( - letsIn v1Size.bdgs conds + letTuple (res1 ::decodedAcn1) res1ValuePostcond (mkBlock [ + letTuple (res2 ::decodedAcn2) res2ValuePostcond ( + letsIn v1Size.bdgs (And conds) ) ]) ]) ]) let fd = { - FunDef.id = $"proof_{ToC name}" + FunDef.id = $"proof_{ToC fieldName}" prms = if ix = 0 then paramsAcn else [c1; c2] @ paramsAcn annots = [Opaque; InlineOnce] specs = specs @@ -1719,7 +1761,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) } {fd = fd; existArg = existArg; elemTpe = elemTpe; decInfo = decInfo; acns = acns; paramsAcn = paramsAcn} - let mkSubfieldProofCall (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo) (proofData: SeqPrefixLemmaSubproofData option): Expr = + let mkSubfieldProofCall (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo option) (proofData: SeqPrefixLemmaSubproofData option): Expr = let origC1 = data.c1 let origC2Reset = data.c2Reset let c1Prev, c2Prev = @@ -1731,7 +1773,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | None -> // NullType case: we assign the codecs to the previous ones // TODO: handle case where there is a bitpattern - letsIn [(c1, Var c1Prev); (c2, Var c2Prev)] (mkBlock []) + letsIn [(c1, Snapshot (Var c1Prev)); (c2, Snapshot (Var c2Prev))] (mkBlock []) | Some proofData -> let codecArgs = if ix = 0 then [] else [Var c1Prev; Var c2Prev] let existArgList = proofData.existArg |> Option.toList @@ -1797,8 +1839,8 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let acnBinding = match child with - | AcnChild c -> mkAcnBinding dec1 c - | Asn1Child _ -> mkBlock [] + | Some (AcnChild c) -> mkAcnBinding dec1 c + | Some (Asn1Child _) | None -> mkBlock [] mkBlock [ callsBdgs @@ -1826,14 +1868,14 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let acnBinding = if acnVars.IsEmpty then match child with - | AcnChild c -> mkAcnBinding dec1 c - | Asn1Child _ -> mkBlock [] + | Some (AcnChild c) -> mkAcnBinding dec1 c + | Some (Asn1Child _) | None -> mkBlock [] else // Only Asn1 children (in particular, sequences) may return ACN values assert ( match child with - | AcnChild _ -> false - | Asn1Child _ -> true + | Some (AcnChild _) | None -> false + | Some (Asn1Child _) -> true ) let decTmp = {Var.name = $"decTmp_{ix + 1}"; tpe = tupleType (proofData.elemTpe :: acnTps)} let decTmpValue = eitherMutMatchExpr (Var dec1) None (mkBlock [Check (BoolLit false); TripleQMark]) (Some decTmp) (Var decTmp) @@ -1854,19 +1896,21 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let bodyWithC1 = mkUnfoldedDecodeWrapper data bodyWithC1Id data.c1 let bodyWithC2 = mkUnfoldedDecodeWrapper data bodyWithC2Id data.c2Reset - let subproofs = (sq.children |> + let subproofs = ( + (List.replicate nbPresenceBits (None: SeqChildInfo option) @ (sq.children |> List.map Some)) |> List.indexed |> List.map (fun (i, c) -> match c with - | Asn1Child asn1 -> + | Some (Asn1Child asn1) -> match asn1.Type.Kind with | NullType _ -> i, c, None // TODO: Not quite, if the NT has an encoding pattern, there is some logic to do | _ -> i, c, Some (mkFieldSubproofFn data i c) - | AcnChild _ -> i, c, Some (mkFieldSubproofFn data i c) + | Some (AcnChild _) | None -> i, c, Some (mkFieldSubproofFn data i c) )) let subproofFns = subproofs |> List.choose (fun (_, _, sp) -> sp |> Option.map (fun sp -> sp.fd)) let subproofCalls = subproofs |> List.map (fun (i, c, sp) -> mkSubfieldProofCall data i c sp) let finalCheck = + let ixChecks = Check (Equals (bitIndexACN (Var data.c1Res), bitIndexACN (Var data.c2Res))) let decodedChecks = Check (Equals (Var data.v1, Var data.v2)) let acnChecks = List.zip data.decodedAcn1 data.decodedAcn2 |> List.map (fun (acn1, acn2) -> Check (Equals (Var acn1, Var acn2))) MatchExpr { @@ -1878,7 +1922,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) id = rightMutId subPatterns = [data.subPat2] } - rhs = mkBlock (decodedChecks :: acnChecks) + rhs = mkBlock (ixChecks :: decodedChecks :: acnChecks) } { pattern = ADTPattern { From bd2d73816594937add2bde606dbd67f0c2b7a805 Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Sun, 18 Aug 2024 11:44:57 +0200 Subject: [PATCH 26/35] Sketching Sequence invertibility proof gen --- StgScala/ProofAst.fs | 14 +- StgScala/ProofGen.fs | 690 ++++++++++-------- .../scala/asn1scala/asn1jvm_Bitstream.scala | 7 + 3 files changed, 408 insertions(+), 303 deletions(-) diff --git a/StgScala/ProofAst.fs b/StgScala/ProofAst.fs index fdbdc3f27..156c37c92 100644 --- a/StgScala/ProofAst.fs +++ b/StgScala/ProofAst.fs @@ -627,6 +627,9 @@ let alignedToWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedT let alignedToDWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToDWord"; tps = []; args = [bits]; parameterless = true} +let codecWrapper (bitstream: Expr): Expr = ClassCtor {ct = codecClsTpe; args = [bitstream]} +let acnWrapperBitstream (bitstream: Expr): Expr = ClassCtor {ct = acnClsTpe; args = [codecWrapper bitstream]} +let acnWrapperCodec (codec: Expr): Expr = ClassCtor {ct = acnClsTpe; args = [codec]} let alignedTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr): Expr = @@ -649,11 +652,14 @@ let alignedSizeTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr) | Some AcnGenericTypes.NextWord -> alignedSizeToWord bits offset | Some AcnGenericTypes.NextDWord -> alignedSizeToDWord bits offset -let validReflexiveLemma (b: Expr): Expr = - FunctionCall { prefix = [bitStreamId]; id = "validReflexiveLemma"; tps = []; args = [selBitStreamACN b]; parameterless = true } +let resetAtEqLemma (b1: Expr) (b2: Expr) (b3: Expr): Expr = + FunctionCall { prefix = [bitStreamId]; id = "resetAtEqLemma"; tps = []; args = [selBitStreamACN b1; selBitStreamACN b2; selBitStreamACN b3]; parameterless = true } -let validTransitiveLemma (b1: Expr) (b2: Expr) (b3: Expr): Expr = - FunctionCall { prefix = [bitStreamId]; id = "validTransitiveLemma"; tps = []; args = [selBitStreamACN b1; selBitStreamACN b2; selBitStreamACN b3]; parameterless = true } +let lemmaIsPrefixRefl (b: Expr): Expr = + FunctionCall { prefix = [bitStreamId]; id = "lemmaIsPrefixRefl"; tps = []; args = [selBitStreamACN b]; parameterless = true } + +let lemmaIsPrefixTransitive (b1: Expr) (b2: Expr) (b3: Expr): Expr = + FunctionCall { prefix = [bitStreamId]; id = "lemmaIsPrefixTransitive"; tps = []; args = [selBitStreamACN b1; selBitStreamACN b2; selBitStreamACN b3]; parameterless = true } let validateOffsetBitsIneqLemma (b1: Expr) (b2: Expr) (b1ValidateOffsetBits: Expr) (advancedAtMostBits: Expr): Expr = FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsIneqLemma"; tps = []; args = [b1; b2; b1ValidateOffsetBits; advancedAtMostBits]; parameterless = true } diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 6fa25030a..f60eb981b 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -795,8 +795,6 @@ let generateEncodePostcondExprCommon (r: Asn1AcnAst.AstRoot) else let prefix = isPrefixOfACN oldCdc (Var cdc) let r1 = {Var.name = "r1"; tpe = ClassType codecTpe} - let r2 = {Var.name = "r2"; tpe = ClassType codecTpe} - let readerCall = acnReader oldCdc (Var cdc) let lemmaCall = validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN oldCdc) (selBufACN (Var cdc)) (longlit maxSize) let decodePureCall = FunctionCall {prefix = []; id = decodePureId; tps = []; args = (Var r1) :: decodeExtraArgs; parameterless = true} let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} @@ -805,8 +803,8 @@ let generateEncodePostcondExprCommon (r: Asn1AcnAst.AstRoot) let acnVarsGotBdg = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acnGot{ix + 1}"; tpe = tpe}) let acnEq = List.zip acnVarsGotBdg acnVarsPatBdg |> List.map (fun (acnGot, acn) -> Equals (Var acnGot, Var acn)) let eq = And ([ - Equals (Var resGot, Var szRecv) Equals (Var r2Got, Var cdc) + Equals (Var resGot, Var szRecv) ] @ acnEq) let decodeResPatmat = let rightPat = @@ -832,7 +830,7 @@ let generateEncodePostcondExprCommon (r: Asn1AcnAst.AstRoot) ] } let boundCall = - letTuple [r1; r2] readerCall ( + letsIn [r1, resetAtACN (Var cdc) oldCdc] ( mkBlock [ lemmaCall letTuple [r2Got; decodingRes] decodePureCall decodeResPatmat @@ -1005,11 +1003,13 @@ let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: type PrimitiveDecodeInfo = { prefix: string list tpe: Type + decodeId: string decodePureId: string prefixLemmaId: string extraConstArgs: Expr list } type ComposedDecodeInfo = { + decodeId: string decodePureId: string prefixLemmaId: string } @@ -1017,74 +1017,74 @@ type DecodeInfo = | PrimitiveDecodeInfo of PrimitiveDecodeInfo | ComposedDecodeInfo of ComposedDecodeInfo -let booleanDecodeInfo = {PrimitiveDecodeInfo.prefix = [bitStreamId]; tpe = BooleanType; decodePureId = "readBitPure"; prefixLemmaId = "readBitPrefixLemma"; extraConstArgs = []} +let booleanDecodeInfo = {PrimitiveDecodeInfo.prefix = [bitStreamId]; tpe = BooleanType; decodeId = "readBit"; decodePureId = "readBitPure"; prefixLemmaId = "readBitPrefixLemma"; extraConstArgs = []} let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bool): DecodeInfo = let forACNIntClass (encCls: IntEncodingClass): PrimitiveDecodeInfo = match encCls with | PositiveInteger_ConstSize_8 -> let baseId = "dec_Int_PositiveInteger_ConstSize_8" - {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_big_endian_16 -> let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_16" - {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_big_endian_32 -> let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_32" - {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_big_endian_64 -> let baseId = "dec_Int_PositiveInteger_ConstSize_big_endian_64" - {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_little_endian_16 -> let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_16" - {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_little_endian_32 -> let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_32" - {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize_little_endian_64 -> let baseId = "dec_Int_PositiveInteger_ConstSize_little_endian_64" - {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PositiveInteger_ConstSize bits -> let baseId = "dec_Int_PositiveInteger_ConstSize" - {prefix = [acnId]; tpe = IntegerType ULong; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [int32lit bits]} + {prefix = [acnId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [int32lit bits]} | TwosComplement_ConstSize_8 -> let baseId = "dec_Int_TwosComplement_ConstSize_8" - {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_big_endian_16 -> let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_16" - {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_big_endian_32 -> let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_32" - {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_big_endian_64 -> let baseId = "dec_Int_TwosComplement_ConstSize_big_endian_64" - {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_little_endian_16 -> let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_16" - {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_little_endian_32 -> let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_32" - {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize_little_endian_64 -> let baseId = "dec_Int_TwosComplement_ConstSize_little_endian_64" - {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | TwosComplement_ConstSize _ -> let baseId = "dec_Int_TwosComplement_ConstSize" - {prefix = [acnId]; tpe = IntegerType Long; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | Integer_uPER -> failwith "UPER encoding selected for ACN integers?" @@ -1096,28 +1096,28 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo match range with | Full -> let baseId = "decodeUnconstrainedWholeNumber" - {prefix = [codecId]; tpe = IntegerType Long; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + {prefix = [codecId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} | PosInf min -> let baseId = "decodeConstrainedPosWholeNumber" - {prefix = [codecId]; tpe = IntegerType ULong; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min]} + {prefix = [codecId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min]} | Concrete (min, max) -> if intCls.IsPositive then let baseId = "decodeConstrainedPosWholeNumber" - {prefix = [codecId]; tpe = IntegerType ULong; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} + {prefix = [codecId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} else let baseId = "decodeConstrainedWholeNumber" - {prefix = [codecId]; tpe = IntegerType Long; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit min; longlit max]} + {prefix = [codecId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit min; longlit max]} | _ -> failwith $"TODO: {range}" | _ -> forACNIntClass encCls let octetString (ot: OctetString) = - PrimitiveDecodeInfo {prefix = [codecId]; tpe = vecTpe (IntegerType UByte); decodePureId = "decodeOctetString_no_length_vec_pure"; prefixLemmaId = "decodeOctetString_no_length_vec_prefixLemma"; extraConstArgs = [int32lit (ot.maxSize.acn)]} + PrimitiveDecodeInfo {prefix = [codecId]; tpe = vecTpe (IntegerType UByte); decodeId = "decodeOctetString_no_length_vec"; decodePureId = "decodeOctetString_no_length_vec_pure"; prefixLemmaId = "decodeOctetString_no_length_vec_prefixLemma"; extraConstArgs = [int32lit (ot.maxSize.acn)]} let bitString (bt: BitString) = - PrimitiveDecodeInfo {prefix = [bitStreamId]; tpe = vecTpe (IntegerType UByte); decodePureId = "readBitsVecPure"; prefixLemmaId = "readBitsVecPrefixLemma"; extraConstArgs = [longlit bt.maxSize.acn]} + PrimitiveDecodeInfo {prefix = [bitStreamId]; tpe = vecTpe (IntegerType UByte); decodeId = "readBitsVec"; decodePureId = "readBitsVecPure"; prefixLemmaId = "readBitsVecPrefixLemma"; extraConstArgs = [longlit bt.maxSize.acn]} if isOptional then let baseId = $"{ToC id.dropModule.AsString}_Optional" - ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + ComposedDecodeInfo {decodeId = $"{baseId}_ACN_Decode"; decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} else match t with | Asn1 t -> @@ -1133,23 +1133,25 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo match str.acnEncodingClass with | Acn_Enc_String_uPER _ -> let baseId = t.ActualType.FT_TypeDefinition.[Scala].typeName - ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + ComposedDecodeInfo {decodeId = $"{baseId}_ACN_Decode"; decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} | _ -> // TODO: The second argument is the determinant but no idea where to fetch this from, therefore putting a dummy value let baseId = "dec_IA5String_CharIndex_External_Field_DeterminantVec" - PrimitiveDecodeInfo {prefix = [acnId]; tpe = vecTpe (IntegerType UByte); decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit str.maxSize.acn; longlit 0I]} + PrimitiveDecodeInfo {prefix = [acnId]; tpe = vecTpe (IntegerType UByte); decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [longlit str.maxSize.acn; longlit 0I]} | OctetString ot -> octetString ot | _ -> let baseId = - if rt.hasExtraConstrainsOrChildrenOrAcnArgs then $"{ToC id.dropModule.AsString}" + if rt.hasExtraConstrainsOrChildrenOrAcnArgs then ToC id.dropModule.AsString else t.ActualType.FT_TypeDefinition.[Scala].typeName - ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + ComposedDecodeInfo {decodeId = $"{baseId}_ACN_Decode"; decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} | Sequence _ | SequenceOf _ | Choice _ -> - let baseId = $"{ToC id.dropModule.AsString}" - ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + let baseId = + if id.tasInfo.IsNone then ToC id.dropModule.AsString + else t.ActualType.FT_TypeDefinition.[Scala].typeName + ComposedDecodeInfo {decodeId = $"{baseId}_ACN_Decode"; decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} | _ -> let baseId = "TODO_ASN1_OTHER" - PrimitiveDecodeInfo {prefix = [acnId]; tpe = IntegerType Int; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO + PrimitiveDecodeInfo {prefix = [acnId]; tpe = IntegerType Int; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO | Acn (AcnInteger int) -> PrimitiveDecodeInfo (forIntClass int.intClass int.acnEncodingClass int.uperRange) | Acn (AcnBoolean _) -> PrimitiveDecodeInfo booleanDecodeInfo @@ -1160,14 +1162,14 @@ let decodeInfo (t: Asn1AcnAst.Asn1AcnType) (id: ReferenceToType) (isOptional: bo let min = enm.enumerated.items |> List.map(fun x -> x.acnEncodeValue) |> Seq.min let max = enm.enumerated.items |> List.map(fun x -> x.acnEncodeValue) |> Seq.max let baseId = "decodeConstrainedPosWholeNumber" - PrimitiveDecodeInfo {prefix = [codecId]; tpe = IntegerType ULong; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} + PrimitiveDecodeInfo {prefix = [codecId]; tpe = IntegerType ULong; decodeId = baseId; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} | _ -> PrimitiveDecodeInfo (forACNIntClass enm.enumerated.acnEncodingClass) | Acn (AcnReferenceToIA5String _) -> - let baseId = $"{ToC id.dropModule.AsString}" - ComposedDecodeInfo {decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + let baseId = ToC id.dropModule.AsString + ComposedDecodeInfo {decodeId = $"{baseId}_ACN_Decode"; decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} | _ -> let baseId = "TODO_ACN_OTHER" - PrimitiveDecodeInfo {prefix = [acnId]; tpe = IntegerType Int; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO + PrimitiveDecodeInfo {prefix = [acnId]; tpe = IntegerType Int; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} // TODO let selectCodecDecodeInfo (decodeInfo: DecodeInfo) (cdc: Expr): Expr = match decodeInfo with @@ -1420,7 +1422,7 @@ let generatePrefixLemmaSequenceOfLike (enc: Asn1Encoding) | Asn1TypeOrAcnRefIA5.AcnRefIA5 (tId, _) -> ToC tId.dropModule.AsString, [], [] generatePrefixLemmaCommon enc tpe (sqf.maxSizeInBits enc) baseId paramsAcn acnTps mkSizeExpr nestingScope mkSqOfLikeProof -type private SeqPrefixLemmaSubproofData = { +type SeqPrefixLemmaSubproofData = { fd: FunDef decInfo: DecodeInfo elemTpe: Type @@ -1428,6 +1430,145 @@ type private SeqPrefixLemmaSubproofData = { acns: AcnChild list paramsAcn: Var list } +type SeqDecodeMiscData = { + elemTpe: Type + paramsAcn: Var list + acns: AcnChild list +} +type SeqChildDecodeMiscData = { + name: string + decInfo: DecodeInfo + existArg: Expr option + common: SeqDecodeMiscData +} + +let seqDecodeMiscData (allParents: Asn1AcnAst.Asn1Type list) + (t: Asn1AcnAst.Asn1Type): SeqDecodeMiscData = + let elemTpe = fromAsn1TypeKind t.Kind + let acns, paramsAcn = + let acns = fun () -> collectNestedAcnChildren t.Kind + let paramAcns = fun () -> acnExternDependenciesVariableDecode t allParents + // Top-level definitions do not return ACNs (and can't have parameter ACNs as well) + if allParents.IsEmpty then [], [] + else + match t.Kind with + | ReferenceType rt -> + if rt.hasExtraConstrainsOrChildrenOrAcnArgs then acns (), paramAcns () + else + match rt.resolvedType.ActualType.Kind with + | OctetString _ | BitString _ -> [], paramAcns () + | _ -> [], [] + | Sequence _ | SequenceOf _ | Choice _ -> acns (), paramAcns () + | OctetString _ | BitString _ -> [], paramAcns () + | _ -> [], [] + {elemTpe = elemTpe; paramsAcn = paramsAcn; acns = acns} + +let seqChildDecodeMiscData (allParents: Asn1AcnAst.Asn1Type list) + (ix: int) + (child: Asn1AcnAst.SeqChildInfo option) + (seqRecv: Expr): SeqChildDecodeMiscData = + match child with + | None -> + {name = $"presence_bit_{ix + 1}"; decInfo = PrimitiveDecodeInfo booleanDecodeInfo; existArg = None; common = {elemTpe = BooleanType; paramsAcn = []; acns = []}} + | Some (Asn1Child child) -> + let common = seqDecodeMiscData allParents child.Type + let decInfo = decodeInfo (Asn1 child.Type) child.Type.id child.Optionality.IsSome + let existArg = + match child.Optionality with + | Some (Optional _) -> + Some (isDefinedMutExpr (FieldSelect (seqRecv, child._scala_name))) + | _ -> None + {name = ToC child.Name.Value; decInfo = decInfo; existArg = existArg; common = common} + | Some (AcnChild child) -> + let elemTpe = fromAcnInsertedType child.Type + let decInfo = decodeInfo (Acn child.Type) child.id false + {name = ToC child.Name.Value; decInfo = decInfo; existArg = None; common = {elemTpe = elemTpe; paramsAcn = []; acns = []}} + +type DecodePureCallHelper = { + dec: Var + decCall: Expr + extracted: Expr +} + +let decodePureCallPrimitiveHelper (childData: SeqChildDecodeMiscData) + (child: Asn1AcnAst.SeqChildInfo option) + (info: PrimitiveDecodeInfo) + (decodedName: string) + (codec: Expr): DecodePureCallHelper = + assert childData.common.acns.IsEmpty + let dec = {Var.name = decodedName; tpe = childData.common.elemTpe} + let decCall = MethodCall { + recv = selectCodecDecodeInfo childData.decInfo codec + id = info.decodePureId + args = info.extraConstArgs + parameterless = false + } + let extracted = + match child with + | Some (Asn1Child child) -> + match child.Type.ActualType.Kind with + | BitString _ | OctetString _ -> + assert (childData.common.paramsAcn.Length <= 1) + let id = child.Type.FT_TypeDefinition.[Scala].typeName + let ncount = childData.common.paramsAcn |> List.map (fun v -> + // The variable may have type ULong, we need to unwrap it as the constructor expects a Long + match v.tpe with + | IntegerType ULong -> intCast (Var v) ULong Long + | _ -> Var v + ) + ClassCtor {ct = {prefix = []; id = id; tps = []; parameterless = false}; args = ncount @ [Var dec]} + | _ -> + assert childData.common.paramsAcn.IsEmpty + Var dec + | Some (AcnChild _) | None -> + assert childData.common.paramsAcn.IsEmpty + Var dec + {dec = dec; decCall = decCall; extracted = extracted} + +let decodePureCallComposedHelper (data: SeqDecodeMiscData) + (info: ComposedDecodeInfo) + (existArg: Expr option) + (decodedName: string) + (codec: Expr) + (mkLeftCase: Var -> Var list -> Expr) + (mkRightCase: Var -> Var list -> Expr): DecodePureCallHelper = + let acnTps = data.acns |> List.map (fun v -> fromAcnInsertedType v.Type) + let decResTpe = eitherMutTpe (IntegerType Int) (tupleType (data.elemTpe :: acnTps)) + let dec = {Var.name = decodedName; tpe = decResTpe} + let decCall = FunctionCall { + prefix = []; id = info.decodePureId; tps = [] + args = [selectCodecDecodeInfo (ComposedDecodeInfo info) codec] @ (existArg |> Option.toList) @ (data.paramsAcn |> List.map Var) + parameterless = true + } + let resBdg = {Var.name = "res"; tpe = data.elemTpe} + let decodedAcnsBdgs = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn_{ix + 1}"; tpe = tpe}) + let subPat = + if acnTps.IsEmpty then + Wildcard (Some resBdg) + else + TuplePattern { + binder = None + subPatterns = Wildcard (Some resBdg) :: (decodedAcnsBdgs |> List.map (fun v -> Wildcard (Some v))) + } + let leftCase = mkLeftCase resBdg decodedAcnsBdgs + let rightCase = mkRightCase resBdg decodedAcnsBdgs + let extracted = + MatchExpr { + scrut = Var dec + cases = [ + { + pattern = ADTPattern {binder = None; id = rightMutId; subPatterns = [subPat]} + rhs = rightCase + } + { + pattern = ADTPattern {binder = None; id = leftMutId; subPatterns = [Wildcard None]} + rhs = leftCase + } + ] + } + {dec = dec; decCall = decCall; extracted = extracted} + + let generatePrefixLemmaSequence (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) @@ -1486,49 +1627,18 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) Assert (arrayBitRangesEq (selBufACN (Var c1)) (selBufACN (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) ] - let fieldName, elemTpe, decInfo, existArg, paramsAcn, acns = - match child with - | None -> - $"presence_bit_{ix + 1}", BooleanType, PrimitiveDecodeInfo booleanDecodeInfo, None, [], [] - | Some (Asn1Child child) -> - let elemTpe = fromAsn1TypeKind child.Type.Kind - let decInfo = decodeInfo (Asn1 child.Type) child.Type.id child.Optionality.IsSome - let existArg = - match child.Optionality with - | Some (Optional _) -> - Some (isDefinedMutExpr (FieldSelect (Var data.v1, child._scala_name))) - | _ -> None - let acns, paramsAcn = - let acns = fun () -> collectNestedAcnChildren child.Type.Kind - let paramAcns = fun () -> acnExternDependenciesVariableDecode child.Type (t :: (nestingScope.parents |> List.map snd)) - match child.Type.Kind with - | ReferenceType rt -> - if rt.hasExtraConstrainsOrChildrenOrAcnArgs then acns (), paramAcns () - else - match rt.resolvedType.ActualType.Kind with - | OctetString _ | BitString _ -> [], paramAcns () - | _ -> [], [] - | Sequence _ | SequenceOf _ | Choice _ -> acns (), paramAcns () - | OctetString _ | BitString _ -> [], paramAcns () - | _ -> [], [] - ToC child.Name.Value, elemTpe, decInfo, existArg, paramsAcn, acns - | Some (AcnChild child) -> - let elemTpe = fromAcnInsertedType child.Type - let decInfo = decodeInfo (Acn child.Type) child.id false - ToC child.Name.Value, elemTpe, decInfo, None, [], [] - let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) - let existArgList = existArg |> Option.toList + let childData = seqChildDecodeMiscData (t :: (nestingScope.parents |> List.map snd)) ix child (Var data.v1) + let acnTps = childData.common.acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) + let existArgList = childData.existArg |> Option.toList let c1Next = {Var.name = $"c1_{ix + 2}"; tpe = origC1.tpe} let c2Next = {Var.name = $"c2_{ix + 2}"; tpe = origC1.tpe} - let res1 = {Var.name = $"{fieldName}_1"; tpe = elemTpe} - let res2 = {Var.name = $"{fieldName}_2"; tpe = elemTpe} + let res1 = {Var.name = $"{childData.name}_1"; tpe = childData.common.elemTpe} + let res2 = {Var.name = $"{childData.name}_2"; tpe = childData.common.elemTpe} let decodedAcn1 = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn_1_{ix + 1}"; tpe = tpe}) let decodedAcn2 = acnTps |> List.indexed |> List.map (fun (ix, tpe) -> {Var.name = $"acn_2_{ix + 1}"; tpe = tpe}) - // For decoding functions that return Either, res1ValuePostcond and res2ValuePostcond are pattern matching that extract the Right value - // without matching on Left (since the proof shows that the function does not fail) - let prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, res1ValueProof, res2ValueProof, res1ValuePostcond, res2ValuePostcond = - match decInfo with + let prefixLemmaApp, decDataProof1, decDataProof2, decDataPostcond1, decDataPostcond2 = + match childData.decInfo with | PrimitiveDecodeInfo info -> assert acnTps.IsEmpty // Note: For variable-size BitString/OctetString, `paramsAcn` is of size 1 and contains the ACN determinant for the size @@ -1536,83 +1646,28 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let prefixLemmaApp = FunctionCall { prefix = info.prefix; id = info.prefixLemmaId; tps = [] args = [ - selectCodecDecodeInfo decInfo (Var c1) - selectCodecDecodeInfo decInfo (Var c2Moved) + selectCodecDecodeInfo childData.decInfo (Var c1) + selectCodecDecodeInfo childData.decInfo (Var c2Moved) ] @ existArgList @ info.extraConstArgs parameterless = true } - let dec1 = {Var.name = "dec1"; tpe = elemTpe} - let dec2 = {Var.name = "dec2"; tpe = elemTpe} - let dec1Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c1); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} - let dec2Call = MethodCall {recv = selectCodecDecodeInfo decInfo (Var c2); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} - let res1ValueProof, res2ValueProof = - match child with - | Some (Asn1Child child) -> - match child.Type.ActualType.Kind with - | BitString _ | OctetString _ -> - assert (paramsAcn.Length <= 1) - let id = child.Type.FT_TypeDefinition.[Scala].typeName - let ncount = paramsAcn |> List.map (fun v -> - // The variable may have type ULong, we need to unwrap it as the constructor expects a Long - match v.tpe with - | IntegerType ULong -> intCast (Var v) ULong Long - | _ -> Var v - ) - let v1Value = ClassCtor {ct = {prefix = []; id = id; tps = []; parameterless = false}; args = ncount @ [Var dec1]} - let v2Value = ClassCtor {ct = {prefix = []; id = id; tps = []; parameterless = false}; args = ncount @ [Var dec2]} - v1Value, v2Value - | _ -> - assert paramsAcn.IsEmpty - Var dec1, Var dec2 - | Some (AcnChild _) | None -> - assert paramsAcn.IsEmpty - Var dec1, Var dec2 - prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, res1ValueProof, res2ValueProof, res1ValueProof, res2ValueProof - + let decData1 = decodePureCallPrimitiveHelper childData child info "dec1" (Var c1) + let decData2 = decodePureCallPrimitiveHelper childData child info "dec2" (Var c2) + prefixLemmaApp, decData1, decData2, decData1, decData2 | ComposedDecodeInfo info -> let prefixLemmaApp = FunctionCall { prefix = []; id = info.prefixLemmaId; tps = [] args = [ - selectCodecDecodeInfo decInfo (Var c1) - selectCodecDecodeInfo decInfo (Var c2Moved) - ] @ [Var childSize] @ existArgList @ (paramsAcn |> List.map Var) - parameterless = true - } - let decResTpe = eitherMutTpe (IntegerType Int) (tupleType (elemTpe :: acnTps)) - let dec1 = {Var.name = "dec1"; tpe = decResTpe} - let dec2 = {Var.name = "dec2"; tpe = decResTpe} - let dec1Call = FunctionCall { - prefix = []; id = info.decodePureId; tps = [] - args = [selectCodecDecodeInfo decInfo (Var c1)] @ existArgList @ (paramsAcn |> List.map Var) + selectCodecDecodeInfo childData.decInfo (Var c1) + selectCodecDecodeInfo childData.decInfo (Var c2Moved) + ] @ [Var childSize] @ existArgList @ (childData.common.paramsAcn |> List.map Var) parameterless = true } - let dec2Call = FunctionCall { - prefix = []; id = info.decodePureId; tps = [] - args = [selectCodecDecodeInfo decInfo (Var c2)] @ existArgList @ (paramsAcn |> List.map Var) - parameterless = true - } - - let subPat1, subPat2 = - if acnTps.IsEmpty then - Wildcard (Some res1), Wildcard (Some res2) - else - let subPat1 = TuplePattern { - binder = None - subPatterns = Wildcard (Some res1) :: (decodedAcn1 |> List.map (fun v -> Wildcard (Some v))) - } - let subPat2 = TuplePattern { - binder = None - subPatterns = Wildcard (Some res2) :: (decodedAcn2 |> List.map (fun v -> Wildcard (Some v))) - } - subPat1, subPat2 - let leftMutPat: Pattern = ADTPattern {binder = None; id = leftMutId; subPatterns = [Wildcard None]} - let rightMutPat (subPat: Pattern): Pattern = ADTPattern {binder = None; id = rightMutId; subPatterns = [subPat]} - - let res1ValueProof = + let proofLeftCase1 (_: Var) (_: Var list): Expr = let proofContradiction = { - FunDef.id = $"proof_unreachability_{fieldName}" + FunDef.id = $"proof_unreachability_{childData.name}" prms = [] annots = [Pure; Opaque; InlineOnce] specs = [] @@ -1620,71 +1675,23 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) returnTpe = UnitType body = ApplyLetRec {id = bodyWithC1Id; args = []} } - let leftCase = - LetRec {fds = [proofContradiction]; body = mkBlock [ApplyLetRec {id = proofContradiction.id; args = []}; TripleQMark]} - MatchExpr { - scrut = Var dec1 - cases = [ - { - pattern = rightMutPat subPat1 - rhs = mkTuple ((Var res1) :: (decodedAcn1 |> List.map Var)) - } - { - pattern = leftMutPat - rhs = leftCase - } - ] - } - let res2ValueProof = - MatchExpr { - scrut = Var dec2 - cases = [ - { - pattern = rightMutPat subPat2 - rhs = mkTuple ((Var res2) :: (decodedAcn2 |> List.map Var)) - } - { - pattern = leftMutPat - rhs = mkBlock [Check (BoolLit false); TripleQMark] - } - ] - } - let res1ValuePostcond = - MatchExpr { - scrut = Var dec1 - cases = [ - { - pattern = rightMutPat subPat1 - rhs = mkTuple ((Var res1) :: (decodedAcn1 |> List.map Var)) - } - { - pattern = leftMutPat - rhs = TripleQMark - } - ] - } - let res2ValuePostcond = - MatchExpr { - scrut = Var dec2 - cases = [ - { - pattern = rightMutPat subPat2 - rhs = mkTuple ((Var res2) :: (decodedAcn2 |> List.map Var)) - } - { - pattern = leftMutPat - rhs = TripleQMark - } - ] - } - prefixLemmaApp, dec1, dec2, dec1Call, dec2Call, res1ValueProof, res2ValueProof, res1ValuePostcond, res2ValuePostcond + LetRec {fds = [proofContradiction]; body = mkBlock [ApplyLetRec {id = proofContradiction.id; args = []}; TripleQMark]} + let mkRightCase (resBdg: Var) (decodedAcnsBdgs: Var list): Expr = + mkTuple ((Var resBdg) :: (decodedAcnsBdgs |> List.map Var)) + + let decDataProof1 = decodePureCallComposedHelper childData.common info childData.existArg "dec1" (Var c1) proofLeftCase1 mkRightCase + let decDataProof2 = decodePureCallComposedHelper childData.common info childData.existArg "dec2" (Var c2) (fun _ _ -> mkBlock [Check (BoolLit false); TripleQMark]) mkRightCase + let decDataPostcond1 = decodePureCallComposedHelper childData.common info childData.existArg "dec1" (Var c1) (fun _ _ -> TripleQMark) mkRightCase + let decDataPostcond2 = decodePureCallComposedHelper childData.common info childData.existArg "dec2" (Var c2) (fun _ _ -> TripleQMark) mkRightCase + prefixLemmaApp, decDataProof1, decDataProof2, decDataPostcond1, decDataPostcond2 + let maxSizeInBits = child |> Option.map (fun c -> c.acnMaxSizeInBits) |> Option.defaultValue 1I let validateOffsLemma = validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN (Var c1)) (selBufACN (Var c2)) (longlit maxSizeInBits) // Note: The pure decoding methods on BitStream and Codec base classes return a BitStream and Codec respectively, // we therefore need to select the base in such cases. let selBuf (cdc: Expr): Expr = - match decInfo with + match childData.decInfo with | PrimitiveDecodeInfo info -> if info.prefix = [bitStreamId] then selBufBitStream cdc else if info.prefix = [codecId] then selBufCodec cdc @@ -1692,7 +1699,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | ComposedDecodeInfo _ -> selBufACN cdc let bitIndex (cdc: Expr): Expr = - match decInfo with + match childData.decInfo with | PrimitiveDecodeInfo info -> if info.prefix = [bitStreamId] then bitIndexBitStream cdc else if info.prefix = [codecId] then bitIndexCodec cdc @@ -1706,7 +1713,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) // Note: the bindings resulting from this size for this child may conflict with the bindings in `childrenSizes` // We therefore suffix these let res = optionalSizeExpr asn1 (Var res1) (bitIndexACN (Var c1)) 0I 0I - renameBindingsSizeRes res $"_{fieldName}" + renameBindingsSizeRes res $"_{childData.name}" | Some (AcnChild child) -> {bdgs = []; resSize = acnTypeSizeExpr child.Type} | None -> // Presence bits @@ -1727,10 +1734,10 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) slicedLemmaApp letsIn [c2Moved, c2MovedValue] (mkBlock ( c2MovedAssertions @ [prefixLemmaApp; validateOffsLemma] @ - [letTuple [c1Next; dec1] dec1Call (mkBlock [ - letTuple [c2Next; dec2] dec2Call (mkBlock [ - letTuple (res1 ::decodedAcn1) res1ValueProof (mkBlock [ - letTuple (res2 ::decodedAcn2) res2ValueProof ( + [letTuple [c1Next; decDataProof1.dec] decDataProof1.decCall (mkBlock [ + letTuple [c2Next; decDataProof2.dec] decDataProof2.decCall (mkBlock [ + letTuple (res1 ::decodedAcn1) decDataProof1.extracted (mkBlock [ + letTuple (res2 ::decodedAcn2) decDataProof2.extracted ( letsIn v1Size.bdgs (mkBlock (conds |> List.map Check)) ) ]) @@ -1740,10 +1747,10 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) ] let postcondExpr = - letTuple [c1Next; dec1] dec1Call (mkBlock [ - letTuple [c2Next; dec2] dec2Call (mkBlock [ - letTuple (res1 ::decodedAcn1) res1ValuePostcond (mkBlock [ - letTuple (res2 ::decodedAcn2) res2ValuePostcond ( + letTuple [c1Next; decDataPostcond1.dec] decDataPostcond1.decCall (mkBlock [ + letTuple [c2Next; decDataPostcond2.dec] decDataPostcond2.decCall (mkBlock [ + letTuple (res1 ::decodedAcn1) decDataPostcond1.extracted (mkBlock [ + letTuple (res2 ::decodedAcn2) decDataPostcond2.extracted ( letsIn v1Size.bdgs (And conds) ) ]) @@ -1751,15 +1758,15 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) ]) let fd = { - FunDef.id = $"proof_{ToC fieldName}" - prms = if ix = 0 then paramsAcn else [c1; c2] @ paramsAcn + FunDef.id = $"proof_{ToC childData.name}" + prms = if ix = 0 then childData.common.paramsAcn else [c1; c2] @ childData.common.paramsAcn annots = [Opaque; InlineOnce] specs = specs postcond = Some ({Var.name = "_"; tpe = UnitType}, postcondExpr) returnTpe = UnitType body = proof } - {fd = fd; existArg = existArg; elemTpe = elemTpe; decInfo = decInfo; acns = acns; paramsAcn = paramsAcn} + {fd = fd; existArg = childData.existArg; elemTpe = childData.common.elemTpe; decInfo = childData.decInfo; acns = childData.common.acns; paramsAcn = childData.common.paramsAcn} let mkSubfieldProofCall (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo option) (proofData: SeqPrefixLemmaSubproofData option): Expr = let origC1 = data.c1 @@ -1992,10 +1999,7 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) let recPVal = {Var.name = recSel.arg.receiverId; tpe = tpe} let precond = [Precond (validateOffsetBitsACN (Var cdc) (longlit t.acnMaxSizeInBits))] let isValidFuncName = $"{t.FT_TypeDefinition.[Scala].typeName}_IsConstraintValid" - let baseId = - match t.ActualType.Kind with - // | SequenceOf _ -> t.FT_TypeDefinition.[Scala].typeName - | _ -> ToC t.id.dropModule.AsString + let baseId = ToC t.id.dropModule.AsString // Computing external ACN dependencies for decoding // We also pass them to the encoding function because its postcondition // refers to the decoding function, which needs them @@ -2318,93 +2322,181 @@ let generateSequenceProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1Ac | Encode -> SelectionExpr (joinedSelection sel) | Decode -> SelectionExpr sel.asIdentifier + let nbPresenceBits = countNbPresenceBits sq + let childrenSizes = [0 .. nbPresenceBits + sq.children.Length - 1] |> List.map (fun i -> {name = $"size_{i}"; tpe = IntegerType Long}) // For "nested sequences", we always inline the size definition instead of calling the corresponding `size` function // since we do not know whether we have extra ACN fields or not. See the TODO in `wrapAcnFuncBody` // Therefore, in such case, we should not assert that the size of the current Sequence is equal to the sum of the size of its children - if not nestingScope.parents.IsEmpty then None + let sizeCheck = + if not nestingScope.parents.IsEmpty then None + else + let recvSz = callSize recv (bitIndexACN (Var oldCdc)) + Some (Ghost (Check (Equals (recvSz, plus (childrenSizes |> List.map Var ))))) + + if codec = Decode || (not r.args.stainlessInvertibility) then sizeCheck else - let recvSz = callSize recv (bitIndexACN (Var oldCdc)) - let childrenSz = - let nbPresenceBits = countNbPresenceBits sq - let szs = [0 .. nbPresenceBits + sq.children.Length - 1] |> List.map (fun i -> Var {name = $"size_{i}"; tpe = IntegerType Long}) - plus szs - Some (Ghost (Check (Equals (recvSz, childrenSz)))) - (* - if codec = Decode || sq.children.IsEmpty then None - else - assert sel.path.IsEmpty - let codecTpe = runtimeCodecTypeFor enc - let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} - let oldCdc = {Var.name = "oldCdc"; tpe = ClassType codecTpe} - let seqTpe = fromAsn1TypeKind t.Kind - let selVar = {Var.name = sel.receiverId; tpe = seqTpe} - let nbPresenceBits = sq.children |> List.sumBy (fun child -> - match child with - | AcnChild _ -> 0 - | Asn1Child asn1 -> - match asn1.Optionality with - | Some (Optional opt) when opt.acnPresentWhen.IsNone -> 1 - | _ -> 0 - ) - let snapshots = [1 .. nbPresenceBits + sq.children.Length] |> List.map (fun i -> {Var.name = $"codec_0_{i}"; tpe = ClassType codecTpe}) - - let transitiveLemmas = - if snapshots.Length < 2 then [] - else List.rep2 snapshots |> List.map (fun (s1, s2) -> validTransitiveLemma (Var s1) (Var s2) (Var cdc)) |> List.rev - - // let optionalReflexiveLemmaApp (ix0: int, child: Asn1AcnAst.SeqChildInfo): Expr option = - // let ix = ix0 + nbPresenceBits - // match child with - // | AcnChild _ -> None - // | Asn1Child asn1 -> - // if asn1.Optionality.IsNone then None - // else - // let theCdc = if ix = snapshots.Length - 1 then cdc else snapshots.[ix + 1] - // Some (validReflexiveLemma (Var theCdc)) - - let readPrefixLemmaApp (ix0: int, child: Asn1AcnAst.SeqChildInfo): Expr = - let ix = ix0 + nbPresenceBits - let cdcSnapReset = resetAtACN (Var snapshots.[ix + 1]) (Var snapshots.[ix]) - let asn1Tpe, id, isOpt, existArg = + assert sel.path.IsEmpty + let codecTpe = runtimeCodecTypeFor enc + let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} + let oldCdc = {Var.name = "oldCdc"; tpe = ClassType codecTpe} + let seqTpe = fromAsn1TypeKind t.Kind + let selVar = {Var.name = sel.receiverId; tpe = seqTpe} + let snapshots = [1 .. nbPresenceBits + sq.children.Length] |> List.map (fun i -> {Var.name = $"codec_0_{i}"; tpe = ClassType codecTpe}) + let fstSnap = snapshots.Head + let transitiveLemmas = + if snapshots.Length < 2 then [] + else List.rep2 snapshots |> List.map (fun (s1, s2) -> lemmaIsPrefixTransitive (Var s1) (Var s2) (Var cdc)) |> List.rev + + let childrenWithPresenceBits = sq.children |> List.choose (fun child -> match child with - | Asn1Child child -> - let existArg = - match child.Optionality with - | Some (Optional _) -> - [isDefinedMutExpr (FieldSelect (Var selVar, child._scala_name))] - | _ -> [] - Asn1 child.Type.Kind, child.Type.id, child.Optionality.IsSome, existArg - | AcnChild child -> Acn child.Type, child.id, false, [] - let prefixLemmaInfo = readPrefixLemmaIdentifier asn1Tpe id isOpt - let cdcSnapRecv, cdcRecv = selectCodecReadPrefixLemma prefixLemmaInfo cdcSnapReset (Var cdc) - FunctionCall {prefix = prefixLemmaInfo.prefix; id = prefixLemmaInfo.id; args = [cdcSnapRecv; cdcRecv] @ existArg @ prefixLemmaInfo.extraArgs} - - // let optionals = sq.children |> List.indexed |> List.choose optionalReflexiveLemmaApp - let presenceBitsPrefixLemmaApps = [0 .. nbPresenceBits - 1] |> List.map (fun ix -> - let cdcSnapReset = resetAtACN (Var snapshots.[ix + 1]) (Var snapshots.[ix]) - FunctionCall {prefix = [bitStreamId]; id = "readBitPrefixLemma"; args = [selBitStreamACN cdcSnapReset; selBitStreamACN (Var cdc)]} - ) - let childrenPrefixLemmaApps = sq.children |> List.indexed |> List.initial |> List.map readPrefixLemmaApp + | AcnChild _ -> None + | Asn1Child asn1 -> + match asn1.Optionality with + | Some (Optional opt) when opt.acnPresentWhen.IsNone -> Some child + | _ -> None + ) + assert (childrenWithPresenceBits.Length = nbPresenceBits) + + let mkFieldSubproof (ix: int) (child: Asn1AcnAst.SeqChildInfo option): Expr = + let snap = snapshots.[ix] + let nextSnap = if ix = nbPresenceBits + sq.children.Length - 1 then cdc else snapshots.[ix + 1] + let childSize = childrenSizes.[ix] + // The codec returned by the pure decoding function for ix > 0. For ix = 0, this is bound to codec.resetAt(codec_0_1) + let c = {Var.name = $"c{ix + 1}"; tpe = ClassType codecTpe} + let cTmp = {Var.name = $"c{ix + 2}Tmp"; tpe = ClassType codecTpe} + let nextC = {Var.name = $"c{ix + 2}"; tpe = ClassType codecTpe} + + let childData = seqChildDecodeMiscData (t :: (nestingScope.parents |> List.map snd)) ix child (Var selVar) + let res = {Var.name = $"res_{childData.name}"; tpe = childData.common.elemTpe} + let childAcns = childData.common.acns |> List.map (fun acn -> {Var.name = getAcnDeterminantName acn.id; tpe = fromAcnInsertedType acn.Type}) + let decodedAcn = childAcns |> List.map (fun v -> {v with name = $"childDec_{v.name}"}) + + let maxSizeInBits = child |> Option.map (fun c -> c.acnMaxSizeInBits) |> Option.defaultValue 1I + + let prefixLemmaApp, decData, cNextWrapped = + match childData.decInfo with + | PrimitiveDecodeInfo info -> + let prefixLemmaApp = FunctionCall { + prefix = info.prefix; id = info.prefixLemmaId; tps = [] + args = [ + selectCodecDecodeInfo childData.decInfo (resetAtACN (Var nextSnap) (Var snap)) + selectCodecDecodeInfo childData.decInfo (Var cdc) + ] @ (childData.existArg |> Option.toList) @ info.extraConstArgs + parameterless = true + } + let decData = decodePureCallPrimitiveHelper childData child info $"dec_{ix + 1}" (Var c) + // The pure decoding methods on BitStream and Codec base classes return a BitStream and Codec + // so we need to wrap it in an ACN. + let cNextWrapped = + if info.prefix = [bitStreamId] then acnWrapperBitstream (Var cTmp) + else if info.prefix = [codecId] then acnWrapperCodec (Var cTmp) + else Var cTmp + prefixLemmaApp, decData, cNextWrapped + | ComposedDecodeInfo info -> + let prefixLemmaApp = FunctionCall { + prefix = []; id = info.prefixLemmaId; tps = [] + args = [ + selectCodecDecodeInfo childData.decInfo (resetAtACN (Var nextSnap) (Var snap)) + selectCodecDecodeInfo childData.decInfo (Var cdc) + ] @ [Var childSize] @ (childData.existArg |> Option.toList) @ (childData.common.paramsAcn |> List.map Var) + parameterless = true + } + let mkRightCase (resBdg: Var) (decodedAcnsBdgs: Var list): Expr = + mkTuple ((Var resBdg) :: (decodedAcnsBdgs |> List.map Var)) + let decData = decodePureCallComposedHelper childData.common info childData.existArg $"dec_{ix + 1}" (Var c) (fun _ _ -> mkBlock [Check (BoolLit false); TripleQMark]) mkRightCase + prefixLemmaApp, decData, Var cTmp - let proof = - let cpy = {Var.name = "cpy"; tpe = ClassType codecTpe} - let decodeId = $"{t.FT_TypeDefinition.[Scala].typeName}_ACN_Decode" - let decodeIdPure = $"{decodeId}_pure" - let r1 = {Var.name = "r1"; tpe = ClassType codecTpe} - let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} - let resGot = {Var.name = "resGot"; tpe = ClassType (eitherMutTpe (IntegerType Int) seqTpe)} - letsIn [cpy, Snapshot (resetAtACN (Var cdc) (Var oldCdc))] ( - mkBlock [ - Unfold (FunctionCall {prefix = []; id = decodeId; args = [Var cpy]}) - letsIn [r1, resetAtACN (Var cdc) (Var oldCdc)] (mkBlock [ - letTuple [r2Got; resGot] (FunctionCall {prefix = []; id = decodeIdPure; args = [Var r1]}) (mkBlock [ - Check (Equals (Var resGot, rightMutExpr (IntegerType Int) seqTpe (Var selVar))) - Check (Equals (Var r2Got, Var cdc)) - ]) - ]) + let encodedValue = + match child with + | Some (Asn1Child child) -> FieldSelect (Var selVar, ToC child.Name.Value) + | Some (AcnChild child) -> Var {name = getAcnDeterminantName child.id; tpe = fromAcnInsertedType child.Type} + | None -> + // Presence bit (presence bits start at ix = 0), so we need to fetch the ix^th optional child with implicit presence bit + let child = childrenWithPresenceBits.[ix] + isDefinedMutExpr (FieldSelect (Var selVar, ToC child.Name.Value)) + + let cdcAssertions = + if ix = nbPresenceBits + sq.children.Length - 1 then [Assert (Equals (Var nextC, Var cdc))] + else [ + resetAtEqLemma (Var c) (Var cdc) (Var snap) + Assert (Equals (Var nextC, resetAtACN (Var cdc) (Var nextSnap))) + ] + let assertions = mkBlock ( + cdcAssertions @ + (Assert (Equals (Var res, encodedValue)) :: + (List.zip decodedAcn childAcns |> List.map (fun (acn1, acn2) -> Assert (Equals (Var acn1, Var acn2))))) + ) + // The prefix lemma is not needed for the last child + let prefixLemmaApp = + if ix = nbPresenceBits + sq.children.Length - 1 then [] + else [prefixLemmaApp] + let result = mkBlock ([ + validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN (Var snap)) (selBufACN (Var nextSnap)) (longlit maxSizeInBits) + ] @ prefixLemmaApp @ [ + letTuple [cTmp; decData.dec] decData.decCall ( + letsIn [nextC, cNextWrapped] ( + letTuple (res :: decodedAcn) decData.extracted assertions + ) + ) ]) - Some (Ghost (mkBlock (transitiveLemmas @ presenceBitsPrefixLemmaApps @ childrenPrefixLemmaApps @ [proof]))) - *) + if ix = 0 then letsIn [c, resetAtACN (Var cdc) (Var fstSnap)] result + else result + + ////////// + + let subproofs = ( + (List.replicate nbPresenceBits (None: SeqChildInfo option) @ (sq.children |> List.map Some)) |> + List.indexed |> + List.map (fun (i, c) -> + match c with + | Some (Asn1Child asn1) -> + match asn1.Type.Kind with + | NullType _ -> + // For NullType, we only bind a new codec + // TODO: Not quite, if the NT has an encoding pattern, there is some logic to do + let c = {Var.name = $"c{i + 1}"; tpe = ClassType codecTpe} + let nextC = {Var.name = $"c{i + 2}"; tpe = ClassType codecTpe} + if i = 0 then + // `c1` must be bound to codec.resetAt(codec_0_1) + letsIn [(c, resetAtACN (Var cdc) (Var fstSnap)); (nextC, Var c)] (mkBlock []) + else letsIn [nextC, Var c] (mkBlock []) + | _ -> mkFieldSubproof i c + | Some (AcnChild _) | None -> mkFieldSubproof i c + )) + + let proof = + let cpy = {Var.name = "cpy"; tpe = ClassType codecTpe} + let c1 = {Var.name = "c1"; tpe = ClassType codecTpe} // Bound to codec.resetAt(codec_0_1) by mkFieldSubproof + let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} + let decValue = {Var.name = "decValue"; tpe = seqTpe} + let decInfo = + match decodeInfo (Asn1 t) t.id false with + | ComposedDecodeInfo info -> info + | PrimitiveDecodeInfo _ -> failwith "Cannot be the case" + let decMiscData = seqDecodeMiscData (nestingScope.parents |> List.map snd) t + let unfoldedCall = FunctionCall { + prefix = []; id = decInfo.decodeId; tps = [] + args = Var cpy :: (decMiscData.paramsAcn |> List.map Var) + parameterless = true + } + let retAcns = decMiscData.acns |> List.map (fun acn -> {Var.name = getAcnDeterminantName acn.id; tpe = fromAcnInsertedType acn.Type}) + let decRetAcns = retAcns |> List.map (fun v -> {v with name = $"dec_{v.name}"}) + let mkRightCase (resBdg: Var) (decodedAcnsBdgs: Var list): Expr = + mkTuple ((Var resBdg) :: (decodedAcnsBdgs |> List.map Var)) + let pureCall = decodePureCallComposedHelper decMiscData decInfo None "decRes" (Var c1) (fun _ _ -> mkBlock [Check (BoolLit false); TripleQMark]) mkRightCase + letsIn [cpy, Snapshot (Var c1)] ( + mkBlock [ + validateOffsetBitsContentIrrelevancyLemma (selBitStreamACN (Var fstSnap)) (selBufACN (Var cdc)) (longlit t.acnMaxSizeInBits) + Unfold unfoldedCall + letTuple [r2Got; pureCall.dec] pureCall.decCall ( + letTuple (decValue :: decRetAcns) pureCall.extracted (mkBlock ([ + Check (Equals (Var r2Got, Var cdc)) + Check (Equals (Var decValue, Var selVar)) + ] @ (List.zip decRetAcns retAcns |> List.map (fun (acn1, acn2) -> Check (Equals (Var acn1, Var acn2)))))) + ) + ]) + Some (Ghost (mkBlock ((sizeCheck |> Option.toList) @ transitiveLemmas @ subproofs @ [proof]))) + let generateSequenceAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = if r.args.stainlessInvertibility && enc = ACN && codec = Decode then [generatePrefixLemmaSequence enc t nestingScope sq] diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 7f7473c6b..947b4b8cb 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -176,6 +176,13 @@ object BitStream { () }.ensuring(_ => BitStream.remainingBits(b.buf.length.toLong, b.currentByte.toLong, b.currentBit.toLong) == b.buf.length.toLong * NO_OF_BITS_IN_BYTE - BitStream.bitIndex(b.buf.length, b.currentByte, b.currentBit )) + @ghost @pure @opaque @inlineOnce + def resetAtEqLemma(b1: BitStream, b2: BitStream, b3: BitStream): Unit = { + require(b1.buf == b2.buf) + require(b1.buf.length == b3.buf.length) + require(b1.bitIndex == b3.bitIndex) + }.ensuring(_ => b1 == b2.resetAt(b3)) + @ghost @pure @opaque @inlineOnce def validateOffsetBytesContentIrrelevancyLemma(b1: BitStream, buf: Array[Byte], bytes: Int): Unit = { require(b1.buf.length == buf.length) From dfb61dea907957ff6c686357831ee3ff2258ff2a Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Tue, 20 Aug 2024 13:12:53 +0200 Subject: [PATCH 27/35] Add prefix lemma proof for optional --- BackendAst/DAstACN.fs | 5 +- FrontEndAst/DAst.fs | 2 +- FrontEndAst/Language.fs | 2 + StgScala/LangGeneric_scala.fs | 4 + StgScala/ProofAst.fs | 35 ++- StgScala/ProofGen.fs | 207 ++++++++++-------- .../scala/asn1scala/asn1jvm_Bitstream.scala | 30 ++- .../main/scala/asn1scala/asn1jvm_Codec.scala | 32 ++- .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 29 +++ 9 files changed, 240 insertions(+), 106 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index a8ae68a84..eb8ce1ccc 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -797,13 +797,12 @@ let createBooleanFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Comm let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - {AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnBooleanEncodingType o.acnProperties.encodingPattern); auxiliaries=[]; icdResult = Some icd} + let aux = lm.lg.generateBooleanAuxiliaries r ACN t o nestingScope p.arg codec + {AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnBooleanEncodingType o.acnProperties.encodingPattern); auxiliaries=aux; icdResult = Some icd} let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> Some (funcBody e acnArgs nestingScope p), us) (fun atc -> true) soSparkAnnotations [] us - - let createAcnNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (o:Asn1AcnAst.AcnNullType) (us:State) = let errCodeName = ToC ("ERR_ACN" + (codec.suffix.ToUpper()) + "_" + ((typeId.AcnAbsPath |> Seq.skip 1 |> Seq.StrJoin("-")).Replace("#","elm"))) let errCode, ns = getNextValidErrorCode us errCodeName None diff --git a/FrontEndAst/DAst.fs b/FrontEndAst/DAst.fs index ed3ca0802..a4412b71d 100644 --- a/FrontEndAst/DAst.fs +++ b/FrontEndAst/DAst.fs @@ -993,7 +993,7 @@ and DastAcnParameter = { and Asn1Type = { id : ReferenceToType - acnAlignment : AcnGenericTypes.AcnAlignment option + acnAlignment : AcnGenericTypes.AcnAlignment option acnParameters : DastAcnParameter list Location : SrcLoc //Line no, Char pos moduleName : string diff --git a/FrontEndAst/Language.fs b/FrontEndAst/Language.fs index e10227fa8..b90382d16 100644 --- a/FrontEndAst/Language.fs +++ b/FrontEndAst/Language.fs @@ -343,6 +343,7 @@ type ILangGeneric () = abstract member adaptAcnFuncBody: Asn1AcnAst.AstRoot -> AcnFuncBody -> isValidFuncName: string option -> Asn1AcnAst.Asn1Type -> Codec -> AcnFuncBody abstract member generateSequenceAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list abstract member generateIntegerAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Integer -> NestingScope -> Selection -> Codec -> string list + abstract member generateBooleanAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Boolean -> NestingScope -> Selection -> Codec -> string list abstract member generateSequenceOfLikeAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> string list * string option abstract member generateOptionalAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> SequenceOptionalChild -> Codec -> string list * string abstract member generateChoiceAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Choice -> NestingScope -> Selection -> Codec -> string list @@ -382,6 +383,7 @@ type ILangGeneric () = default this.adaptAcnFuncBody _ f _ _ _ = f default this.generateSequenceAuxiliaries _ _ _ _ _ _ _ = [] default this.generateIntegerAuxiliaries _ _ _ _ _ _ _ = [] + default this.generateBooleanAuxiliaries _ _ _ _ _ _ _ = [] default this.generateSequenceOfLikeAuxiliaries _ _ _ _ _ = [], None default this.generateOptionalAuxiliaries _ _ soc _ = // By default, languages do not have wrapped optional and have an `exist` field: they "attach" the child field themselves diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index a7e508c55..260634d7d 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -326,6 +326,10 @@ type LangGeneric_scala() = let fds = generateIntegerAuxiliaries r enc t int nestingScope sel codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) + override this.generateBooleanAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (boolean: Asn1AcnAst.Boolean) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): string list = + let fds = generateBooleanAuxiliaries r enc t boolean nestingScope sel codec + fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) + override this.generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (o: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): string list * string option = let fds, call = generateSequenceOfLikeAuxiliaries r enc o pg codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]), Some (show (ExprTree call)) diff --git a/StgScala/ProofAst.fs b/StgScala/ProofAst.fs index 156c37c92..0e467b518 100644 --- a/StgScala/ProofAst.fs +++ b/StgScala/ProofAst.fs @@ -577,14 +577,19 @@ let ifElseBranches (branches: (Expr * Expr) list) (els: Expr): Expr = let selBaseACN (recv: Expr): Expr = FieldSelect (recv, "base") let selBitStreamCodec (recv: Expr): Expr = FieldSelect (recv, "bitStream") + let selBitStreamACN (recv: Expr): Expr = FieldSelect (selBaseACN recv, "bitStream") let selBufBitStream (recv: Expr): Expr = FieldSelect (recv, "buf") + let selBufCodec (recv: Expr): Expr = FieldSelect (selBitStreamCodec recv, "buf") + let selBufACN (recv: Expr): Expr = FieldSelect (selBaseACN recv, "buf") let selBufLengthBitStream (recv: Expr): Expr = ArrayLength recv + let selBufLengthCodec (recv: Expr): Expr = ArrayLength (selBufCodec recv) + let selBufLengthACN (recv: Expr): Expr = ArrayLength (selBufACN recv) let selCurrentByteACN (recv: Expr): Expr = FieldSelect (selBitStreamACN recv, "currentByte") @@ -592,13 +597,27 @@ let selCurrentByteACN (recv: Expr): Expr = FieldSelect (selBitStreamACN recv, " let selCurrentBitACN (recv: Expr): Expr = FieldSelect (selBitStreamACN recv, "currentBit") let bitIndexBitStream (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = recv; args = []; parameterless = true } + let bitIndexCodec (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStreamCodec recv; args = []; parameterless = true } + let bitIndexACN (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStreamACN recv; args = []; parameterless = true } let resetAtACN (recv: Expr) (arg: Expr): Expr = MethodCall { id = "resetAt"; recv = recv; args = [arg]; parameterless = true } let withMovedBitIndexACN (recv: Expr) (diff: Expr): Expr = MethodCall { id = "withMovedBitIndex"; recv = recv; args = [diff]; parameterless = true } +let withAlignedToByteACN (recv: Expr): Expr = MethodCall { id = "withAlignedToByte"; recv = recv; args = []; parameterless = false } + +let withAlignedToShortACN (recv: Expr): Expr = MethodCall { id = "withAlignedToShort"; recv = recv; args = []; parameterless = false } + +let withAlignedToIntACN (recv: Expr): Expr = MethodCall { id = "withAlignedToInt"; recv = recv; args = []; parameterless = false } + +let withAlignedToACN (align: AcnGenericTypes.AcnAlignment) (recv: Expr): Expr = + match align with + | AcnGenericTypes.AcnAlignment.NextByte -> withAlignedToByteACN recv + | AcnGenericTypes.AcnAlignment.NextWord -> withAlignedToShortACN recv + | AcnGenericTypes.AcnAlignment.NextDWord -> withAlignedToIntACN recv + let invariant (recv: Expr): Expr = FunctionCall { prefix = [bitStreamId]; id = "invariant"; tps = []; args = [selCurrentBitACN recv; selCurrentByteACN recv; selBufLengthACN recv]; parameterless = true } let getBitCountUnsigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetBitCountUnsigned"; tps = []; args = [arg]; parameterless = true } @@ -609,8 +628,6 @@ let isPrefixOfACN (recv: Expr) (other: Expr): Expr = MethodCall { id = "isPrefix let callSize (recv: Expr) (offset: Expr): Expr = MethodCall { id = "size"; recv = recv; args = [offset]; parameterless = true } -// let sizeRange (recv: Expr) (offset: Expr) (from: Expr) (tto: Expr): Expr = MethodCall { id = "sizeRange"; recv = recv; args = [offset; from; tto] } - let getLengthForEncodingSigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetLengthForEncodingSigned"; tps = []; args = [arg]; parameterless = true } let acnReader (oldCdc: Expr) (cdc: Expr): Expr = FunctionCall { prefix = [acnId]; id = "reader"; tps = []; args = [oldCdc; cdc]; parameterless = true } @@ -628,7 +645,9 @@ let alignedToWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedT let alignedToDWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToDWord"; tps = []; args = [bits]; parameterless = true} let codecWrapper (bitstream: Expr): Expr = ClassCtor {ct = codecClsTpe; args = [bitstream]} + let acnWrapperBitstream (bitstream: Expr): Expr = ClassCtor {ct = acnClsTpe; args = [codecWrapper bitstream]} + let acnWrapperCodec (codec: Expr): Expr = ClassCtor {ct = acnClsTpe; args = [codec]} @@ -639,11 +658,17 @@ let alignedTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr): Exp | Some AcnGenericTypes.NextWord -> alignedToWord bits | Some AcnGenericTypes.NextDWord -> alignedToDWord bits -let alignedSizeToByte (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToByte"; tps = []; args = [bits; offset]; parameterless = true} +let alignedSizeToByteId: Identifier = "alignedSizeToByte" + +let alignedSizeToWordId: Identifier = "alignedSizeToWord" + +let alignedSizeToDWordId: Identifier = "alignedSizeToDWord" + +let alignedSizeToByte (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = alignedSizeToByteId; tps = []; args = [bits; offset]; parameterless = true} -let alignedSizeToWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToWord"; tps = []; args = [bits; offset]; parameterless = true} +let alignedSizeToWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = alignedSizeToWordId; tps = []; args = [bits; offset]; parameterless = true} -let alignedSizeToDWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToDWord"; tps = []; args = [bits; offset]; parameterless = true} +let alignedSizeToDWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = alignedSizeToDWordId; tps = []; args = [bits; offset]; parameterless = true} let alignedSizeTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr) (offset: Expr): Expr = match alignment with diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index f60eb981b..1c2a74672 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -1362,6 +1362,14 @@ let generatePrefixLemma (enc: Asn1Encoding) let mkSizeExpr = fun v1 c1 -> asn1SizeExpr t.acnAlignment t.Kind (Var v1) (bitIndexACN (Var c1)) 0I 0I generatePrefixLemmaCommon enc tpe t.acnMaxSizeInBits baseId paramsAcn acnTps mkSizeExpr nestingScope mkProof +let generatePrefixLemmaBool (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (boolean: Boolean): FunDef = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkProof + let generatePrefixLemmaInteger (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (nestingScope: NestingScope) @@ -1537,7 +1545,7 @@ let decodePureCallComposedHelper (data: SeqDecodeMiscData) let dec = {Var.name = decodedName; tpe = decResTpe} let decCall = FunctionCall { prefix = []; id = info.decodePureId; tps = [] - args = [selectCodecDecodeInfo (ComposedDecodeInfo info) codec] @ (existArg |> Option.toList) @ (data.paramsAcn |> List.map Var) + args = [codec] @ (existArg |> Option.toList) @ (data.paramsAcn |> List.map Var) parameterless = true } let resBdg = {Var.name = "res"; tpe = data.elemTpe} @@ -1579,6 +1587,8 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let bodyWithC1Id = "bodyWithC1" let bodyWithC2Id = "bodyWithC2" + // TODO: Alignment? + let mkUnfoldedDecodeWrapper (data: PrefixLemmaData) (id: Identifier) (c: Var): FunDef = let cpy = {Var.name = $"{c.name}Cpy"; tpe = c.tpe} let call = FunctionCall {prefix = []; id = data.decodeId; tps = []; args = [Var cpy]; parameterless = true} @@ -1657,10 +1667,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | ComposedDecodeInfo info -> let prefixLemmaApp = FunctionCall { prefix = []; id = info.prefixLemmaId; tps = [] - args = [ - selectCodecDecodeInfo childData.decInfo (Var c1) - selectCodecDecodeInfo childData.decInfo (Var c2Moved) - ] @ [Var childSize] @ existArgList @ (childData.common.paramsAcn |> List.map Var) + args = [Var c1; Var c2Moved; Var childSize] @ existArgList @ (childData.common.paramsAcn |> List.map Var) parameterless = true } @@ -2508,6 +2515,10 @@ let generateIntegerAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: A if r.args.stainlessInvertibility && enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaInteger enc t nestingScope int] else [] +let generateBooleanAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (boolean: Asn1AcnAst.Boolean) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = + if r.args.stainlessInvertibility && enc = ACN && codec = Decode && t.id.tasInfo.IsSome then [generatePrefixLemmaBool enc t nestingScope boolean] + else [] + let generateChoiceAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (ch: Asn1AcnAst.Choice) (nestingScope: NestingScope) (sel: Selection) (codec: Codec): FunDef list = if r.args.stainlessInvertibility && enc = ACN && codec = Decode then [generatePrefixLemmaChoice enc t nestingScope ch] else [] @@ -2924,102 +2935,112 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding returnedFds @ prefixLemma, auxCall let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc: SequenceOptionalChild): FunDef = - let mkProof (data: PrefixLemmaData): Expr = - UnitLit // TODO - - // let isTopLevel = soc.nestingScope.parents.IsEmpty - // let paramsAcn, acnTps = - // if isTopLevel then [], [] - // else - let paramsAcn = acnExternDependenciesVariableDecode soc.child.toAsn1AcnAst.Type (soc.nestingScope.parents |> List.map snd) - // let acns = collectNestedAcnChildren soc.t.Kind - // let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) - // paramsAcn, acnTps - let baseId = $"{ToC soc.child.Type.id.dropModule.AsString}_Optional" // The `existVar` does not exist for always present/absent let existVar = soc.existVar |> Option.map (fun v -> {Var.name = v; tpe = BooleanType}) + let baseId = $"{ToC soc.child.Type.id.dropModule.AsString}_Optional" + + let paramsAcn = acnExternDependenciesVariableDecode soc.child.toAsn1AcnAst.Type (soc.nestingScope.parents |> List.map snd) let mkSizeExpr = fun v1 c1 -> optionalSizeExpr soc.child.toAsn1AcnAst (Var v1) (bitIndexACN (Var c1)) 0I 0I let elemTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind let tpe = optionMutTpe elemTpe - generatePrefixLemmaCommon enc tpe soc.child.Type.toAsn1AcnAst.acnMaxSizeInBits baseId ((existVar |> Option.toList) @ paramsAcn) [] mkSizeExpr soc.nestingScope mkProof - (* - let codecTpe = runtimeCodecTypeFor enc - let c1 = {Var.name = "c1"; tpe = ClassType codecTpe} - let c2 = {Var.name = "c2"; tpe = ClassType codecTpe} - // The `existVar` does not exist for always present/absent - let existVar = soc.existVar |> Option.map (fun v -> {Var.name = v; tpe = BooleanType}) - let sz = {Var.name = "sz"; tpe = IntegerType Long} - let maxSizeExpr = longlit soc.child.Type.Kind.baseKind.acnMaxSizeInBits - let preconds = [ - Precond (Equals (selBufLength (Var c1), selBufLength (Var c2))) - Precond (validateOffsetBitsACN (Var c1) maxSizeExpr) - Precond (And [Leq (longlit 0I, Var sz); Leq (Var sz, maxSizeExpr)]) - Precond (arrayBitRangesEq - (selBufACN (Var c1)) - (selBufACN (Var c2)) - (longlit 0I) - (plus [bitIndexACN (Var c1); Var sz]) - ) - ] - let elemTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind - let existExprArg = existVar |> Option.map Var |> Option.toList - let decodeId = $"{ToC soc.child.Type.id.dropModule.AsString}_Optional_ACN_Decode" - let decodePureId = $"{decodeId}_pure" - let c2Reset = {Var.name = "c2Reset"; tpe = ClassType codecTpe} - let c1Res = {Var.name = "c1Res"; tpe = ClassType codecTpe} - let v1 = {Var.name = "v1"; tpe = elemTpe} - let dec1 = {Var.name = "dec1"; tpe = TupleType [c1Res.tpe; v1.tpe]} - let call1 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = [Var c1] @ existExprArg} - let c2Res = {Var.name = "c2Res"; tpe = ClassType codecTpe} - let v2 = {Var.name = "v2"; tpe = elemTpe} - let dec2 = {Var.name = "dec2"; tpe = TupleType [c2Res.tpe; v2.tpe]} - let call2 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = [Var c2Reset] @ existExprArg} + let mkProof (data: PrefixLemmaData): Expr = + // Note: data.paramsAcn = existVar @ paramsAcn + // since we concatenate these in generatePrefixLemmaCommon + let unfoldC1, unfoldC2 = + let mkCall (cdc: Expr): Expr = + FunctionCall { + prefix = []; id = data.decodeId; tps = [] + args = [cdc] @ (data.paramsAcn |> List.map Var) + parameterless = true + } + let unfoldC1 = Unfold (mkCall (Snapshot (Var data.c1))) + let unfoldC2 = Unfold (mkCall (Snapshot (Var data.c2Reset))) + unfoldC1, unfoldC2 - let preSpecs = - preconds @ [ - LetSpec (c2Reset, resetAtACN (Var c2) (Var c1)) - LetSpec (dec1, call1) - LetSpec (c1Res, TupleSelect (Var dec1, 1)) - LetSpec (v1, TupleSelect (Var dec1, 2)) - LetSpec (dec2, call2) - LetSpec (c2Res, TupleSelect (Var dec2, 1)) - LetSpec (v2, TupleSelect (Var dec2, 2)) - ] - let postcond = And [Equals (bitIndexACN (Var c1Res), bitIndexACN (Var c2Res)); Equals (Var v1, Var v2)] - - let c1Cpy = {Var.name = "c1Cpy"; tpe = ClassType codecTpe} - let c2ResetCpy = {Var.name = "c2ResetCpy"; tpe = ClassType codecTpe} - let underlyingPrefixLemma = readPrefixLemmaIdentifier (Asn1 soc.child.Type.toAsn1AcnAst) soc.child.Type.id false - let c1Recv, c2Recv = selectCodecReadPrefixLemma underlyingPrefixLemma (Var c1) (Var c2) - let underlyingPrefixLemmaCall = - match underlyingPrefixLemma with - | PrimitiveDecodeInfo info -> - FunctionCall {prefix = info.prefix; id = info.id; tps = []; args = [c1Recv; c2Recv] @ info.extraConstArgs} - | ComposedDecodeInfo info -> - FunctionCall {prefix = []; id = info.id; tps = []; args = [c1Recv; c2Recv] @ [Var sz]} - - let body = (letsIn [ - (c1Cpy, Snapshot (Var c1)) - (c2ResetCpy, Snapshot (Var c2Reset)) - ] (mkBlock [ - Unfold (FunctionCall {prefix = []; id = decodeId; tps = []; args = [Var c1Cpy] @ existExprArg}) - Unfold (FunctionCall {prefix = []; id = decodeId; tps = []; args = [Var c2ResetCpy] @ existExprArg}) - existVar |> - Option.map (fun exist -> IfExpr {cond = Var exist; thn = underlyingPrefixLemmaCall; els = UnitLit}) |> - Option.defaultValue underlyingPrefixLemmaCall - ])) + match soc.child.Type.Kind with + | DAst.NullType _ -> mkBlock [unfoldC1; unfoldC2] + | _ -> + let decInfo = decodeInfo (Asn1 soc.child.Type.toAsn1AcnAst) soc.child.Type.id false + + let c1Aligned, unalignedSize, slicedLemmaApp = + match soc.child.Type.acnAlignment with + | Some align -> + let c1Aligned = withAlignedToACN align (Var data.c1) + let unalignedSize = + match data.v1SizeExpr.resSize with + | FunctionCall f when [alignedSizeToByteId; alignedSizeToWordId; alignedSizeToDWordId] |> List.contains f.id -> + assert (f.args.Length = 2) + f.args.Head // The first argument is the unaligned size + | other -> failwith $"Size is not aligned, got {other}" + let slicedLemmaApp = (arrayBitRangesEqSlicedLemma + (selBufACN (Var data.c1)) (selBufACN (Var data.c2)) + (longlit 0I) (plus [bitIndexACN (Var data.c1); Var data.sz]) + (longlit 0I) (plus [bitIndexACN c1Aligned; unalignedSize])) + c1Aligned, unalignedSize, Some slicedLemmaApp + | None -> + Var data.c1, Var data.sz, None + + let prefixLemmaApp = + match decInfo with + | PrimitiveDecodeInfo info -> + let prefixLemmaApp = FunctionCall { + prefix = info.prefix; id = info.prefixLemmaId; tps = [] + args = [ + selectCodecDecodeInfo decInfo c1Aligned + selectCodecDecodeInfo decInfo (Var data.c2) + ] @ info.extraConstArgs + parameterless = true + } + prefixLemmaApp + | ComposedDecodeInfo info -> + let prefixLemmaApp = FunctionCall { + prefix = []; id = info.prefixLemmaId; tps = [] + args = [c1Aligned; Var data.c2; unalignedSize] @ (paramsAcn |> List.map Var) + parameterless = true + } + prefixLemmaApp + + let proofRightMutCase = + let ifCond = + let szEq = Equals (Var data.v1SizeVar, Var data.sz) + match existVar with + | Some existVar -> And [szEq; Var existVar] + | None -> szEq + IfExpr { + cond = ifCond + thn = mkBlock ((slicedLemmaApp |> Option.toList) @ [prefixLemmaApp]) + els = UnitLit + } + let boundProofRightMutCase = letsIn (data.v1SizeExpr.bdgs @ [data.v1SizeVar, data.v1SizeExpr.resSize]) proofRightMutCase + mkBlock [ + unfoldC1 + unfoldC2 + MatchExpr { + scrut = Var data.decodingRes1 + cases = [ + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [data.subPat1] + } + rhs = boundProofRightMutCase + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = UnitLit + } + ] + } + ] + + generatePrefixLemmaCommon enc tpe soc.child.Type.toAsn1AcnAst.acnMaxSizeInBits baseId ((existVar |> Option.toList) @ paramsAcn) [] mkSizeExpr soc.nestingScope mkProof - { - FunDef.id = $"{ToC soc.child.Type.id.dropModule.AsString}_Optional_prefixLemma" - prms = [c1; c2] @ (existVar |> Option.toList) @ [sz] - annots = [GhostAnnot; Pure; Opaque; InlineOnce] - specs = preSpecs - postcond = Some ({Var.name = "_"; tpe = UnitType}, postcond) - returnTpe = UnitType - body = body - } - *) let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): FunDef list * Expr = if soc.child.Optionality.IsNone then [], EncDec (soc.childBody soc.p soc.existVar) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 947b4b8cb..d8316e9f7 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -287,7 +287,7 @@ object BitStream { val read2 = bs2Reset.readBytePure()._2 { - val aligned = BitStream.bitIndex(bs1.withAlignedByte().buf.length, bs1.withAlignedByte().currentByte, bs1.withAlignedByte().currentBit ) + val aligned = BitStream.bitIndex(bs1.withAlignedToByte().buf.length, bs1.withAlignedToByte().currentByte, bs1.withAlignedToByte().currentBit ) arrayBitRangesEqSlicedLemma(bs1.buf, bs2.buf, 0, rangeEqUntil, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ), aligned) arrayBitRangesEqSlicedLemma(bs1.buf, bs2.buf, 0, rangeEqUntil, aligned, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 8) }.ensuring { _ => @@ -2573,7 +2573,7 @@ case class BitStream private [asn1scala]( }.ensuring(_ => this.buf == old(this).buf && BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) <= BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + 7) @pure @ghost - def withAlignedByte(): BitStream = { + def withAlignedToByte(): BitStream = { require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, (NO_OF_BITS_IN_BYTE - currentBit) & (NO_OF_BITS_IN_BYTE - 1) )) @@ -2593,6 +2593,19 @@ case class BitStream private [asn1scala]( currentByte = ((currentByte + (NO_OF_BYTES_IN_JVM_SHORT - 1)) / NO_OF_BYTES_IN_JVM_SHORT) * NO_OF_BYTES_IN_JVM_SHORT } + @pure @ghost + def withAlignedToShort(): BitStream = { + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, + (NO_OF_BITS_IN_SHORT - // max alignment (16) - + (NO_OF_BITS_IN_BYTE * (currentByte & (NO_OF_BYTES_IN_JVM_SHORT - 1)) + currentBit) // current pos + ) & (NO_OF_BITS_IN_SHORT - 1)) // edge case (0,0) -> 0 + ) + + val cpy = snapshot(this) + cpy.alignToShort() + cpy + } + def alignToInt(): Unit = { require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, (NO_OF_BITS_IN_INT - // max alignment (32) - @@ -2603,4 +2616,17 @@ case class BitStream private [asn1scala]( alignToByte() currentByte = ((currentByte + (NO_OF_BYTES_IN_JVM_INT - 1)) / NO_OF_BYTES_IN_JVM_INT) * NO_OF_BYTES_IN_JVM_INT } + + @pure @ghost + def withAlignedToInt(): BitStream = { + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, + (NO_OF_BITS_IN_INT - // max alignment (32) - + (NO_OF_BITS_IN_BYTE * (currentByte & (NO_OF_BYTES_IN_JVM_INT - 1)) + currentBit) // current pos + ) & (NO_OF_BITS_IN_INT - 1)) // edge case (0,0) -> 0 + ) + + val cpy = snapshot(this) + cpy.alignToInt() + cpy + } } // BitStream class diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index 44893dd89..e162e24bc 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -172,7 +172,7 @@ object Codec { */ case class Codec(bitStream: BitStream) { import Codec.* - export bitStream.{resetAt => _, withMovedByteIndex => _, withMovedBitIndex => _, isPrefixOf => _, readNLSBBitsMSBFirstPure => _, *} + export bitStream.{resetAt => _, withMovedByteIndex => _, withMovedBitIndex => _, isPrefixOf => _, readNLSBBitsMSBFirstPure => _, withAlignedToByte => _, withAlignedToShort => _, withAlignedToInt => _, *} @ghost @pure @inline def resetAt(other: Codec): Codec = { @@ -348,7 +348,7 @@ case class Codec(bitStream: BitStream) { // assert(min + decVal <= max) // TODO: T.O (min + decVal): ULong - }.ensuring(_ => buf == old(this).buf && BitStream.bitIndex(this.bitStream.buf.length, this.bitStream.currentByte, this.bitStream.currentBit) == BitStream.bitIndex(old(this).bitStream.buf.length, old(this).bitStream.currentByte, old(this).bitStream.currentBit) + GetBitCountUnsigned(max - min)) + }.ensuring(res => buf == old(this).buf && BitStream.bitIndex(this.bitStream.buf.length, this.bitStream.currentByte, this.bitStream.currentBit) == BitStream.bitIndex(old(this).bitStream.buf.length, old(this).bitStream.currentByte, old(this).bitStream.currentBit) + GetBitCountUnsigned(max - min) && min <= res && res <= max) @ghost @pure def decodeConstrainedPosWholeNumberPure(min: ULong, max: ULong): (Codec, ULong) = { @@ -2186,4 +2186,32 @@ case class Codec(bitStream: BitStream) { arr.length == asn1SizeMax.toInt && old(arr).length == arr.length ) + + @inline @pure @ghost + def withAlignedToByte(): Codec = { + require(BitStream.validate_offset_bits(bitStream.buf.length.toLong, bitStream.currentByte.toLong, bitStream.currentBit.toLong, + (NO_OF_BITS_IN_BYTE - bitStream.currentBit) & (NO_OF_BITS_IN_BYTE - 1) + )) + Codec(bitStream.withAlignedToByte()) + } + + @inline @pure @ghost + def withAlignedToShort(): Codec = { + require(BitStream.validate_offset_bits(bitStream.buf.length.toLong, bitStream.currentByte.toLong, bitStream.currentBit.toLong, + (NO_OF_BITS_IN_SHORT - // max alignment (16) - + (NO_OF_BITS_IN_BYTE * (bitStream.currentByte & (NO_OF_BYTES_IN_JVM_SHORT - 1)) + bitStream.currentBit) // current pos + ) & (NO_OF_BITS_IN_SHORT - 1)) // edge case (0,0) -> 0 + ) + Codec(bitStream.withAlignedToShort()) + } + + @inline @pure @ghost + def withAlignedToInt(): Codec = { + require(BitStream.validate_offset_bits(bitStream.buf.length.toLong, bitStream.currentByte.toLong, bitStream.currentBit.toLong, + (NO_OF_BITS_IN_INT - // max alignment (32) - + (NO_OF_BITS_IN_BYTE * (bitStream.currentByte & (NO_OF_BYTES_IN_JVM_INT - 1)) + bitStream.currentBit) // current pos + ) & (NO_OF_BITS_IN_INT - 1)) // edge case (0,0) -> 0 + ) + Codec(bitStream.withAlignedToInt()) + } } diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 1875220a6..361e1f4b5 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -419,6 +419,35 @@ case class ACN(base: Codec) { @pure @inline def isPrefixOf(acn2: ACN): Boolean = bitStream.isPrefixOf(acn2.base.bitStream) + + @inline @pure @ghost + def withAlignedToByte(): ACN = { + require(BitStream.validate_offset_bits(base.bitStream.buf.length.toLong, base.bitStream.currentByte.toLong, base.bitStream.currentBit.toLong, + (NO_OF_BITS_IN_BYTE - base.bitStream.currentBit) & (NO_OF_BITS_IN_BYTE - 1) + )) + ACN(base.withAlignedToByte()) + } + + @inline @pure @ghost + def withAlignedToShort(): ACN = { + require(BitStream.validate_offset_bits(base.bitStream.buf.length.toLong, base.bitStream.currentByte.toLong, base.bitStream.currentBit.toLong, + (NO_OF_BITS_IN_SHORT - // max alignment (16) - + (NO_OF_BITS_IN_BYTE * (base.bitStream.currentByte & (NO_OF_BYTES_IN_JVM_SHORT - 1)) + base.bitStream.currentBit) // current pos + ) & (NO_OF_BITS_IN_SHORT - 1)) // edge case (0,0) -> 0 + ) + ACN(base.withAlignedToShort()) + } + + @inline @pure @ghost + def withAlignedToInt(): ACN = { + require(BitStream.validate_offset_bits(base.bitStream.buf.length.toLong, base.bitStream.currentByte.toLong, base.bitStream.currentBit.toLong, + (NO_OF_BITS_IN_INT - // max alignment (32) - + (NO_OF_BITS_IN_BYTE * (base.bitStream.currentByte & (NO_OF_BYTES_IN_JVM_INT - 1)) + base.bitStream.currentBit) // current pos + ) & (NO_OF_BITS_IN_INT - 1)) // edge case (0,0) -> 0 + ) + ACN(base.withAlignedToInt()) + } + // @opaque @inlineOnce def enc_Int_PositiveInteger_ConstSize_8(intVal: ULong): Unit = { require(BitStream.validate_offset_byte(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit)) From dad93c30f8eaaad3ec6a243d13fef6239c230e8c Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Tue, 20 Aug 2024 16:55:14 +0200 Subject: [PATCH 28/35] prefix lemma proof: add intermediate inner function to prove decoding success --- StgScala/ProofGen.fs | 290 ++++++++++++++++++++++++++++++++----------- 1 file changed, 220 insertions(+), 70 deletions(-) diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 1c2a74672..48b3dbe9e 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -1603,7 +1603,120 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) body = body } - let mkFieldSubproofFn (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo option): SeqPrefixLemmaSubproofData = + let transformAcnEnumerated (enm: AcnReferenceToEnumerated) (info: PrimitiveDecodeInfo) (decodedVar: Var): Expr = + // For Enumerated, we need to transform the integer to a Scala enum + let intTpe = + match info.tpe with + | IntegerType tp -> tp + | _ -> failwith $"Enumerated is not an IntegerType type" + let branches = enm.enumerated.items |> List.map (fun i -> + let cond = Equals (Var decodedVar, IntLit (intTpe, i.acnEncodeValue)) + let branch = ClassCtor {ct = {prefix = [enm.enumerated.typeDef.[Scala].typeName]; id = i.scala_name; tps = []; parameterless = true}; args = []} + cond, branch + ) + // TODO: For mkFieldCodecOriginFn, what about the "???" ? + ifElseBranches branches (mkBlock [Check (BoolLit false); TripleQMark]) + + + let mkFieldCodecOriginFn (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo option) (childData: SeqChildDecodeMiscData) (prevChildrenData: (Asn1AcnAst.SeqChildInfo option * SeqChildDecodeMiscData option) list): FunDef = + assert (ix <> 0) + let origC1 = data.c1 + let c1 = {Var.name = $"c1_{ix + 1}"; tpe = origC1.tpe} + let allReturnedCodecs = [0..ix] |> List.map (fun i -> {Var.name = $"c1_{i + 2}_got"; tpe = origC1.tpe}) + // The ACN parameter passed to this "origin function", which we distinguish with prefix "prm_" + let acnParams = childData.common.paramsAcn |> List.map (fun v -> {v with name = $"prm_{v.name}"}) + + let mkAcnBinding (child: AcnChild) (decInfo: DecodeInfo) (decodedVar: Var): Var * Expr = + let v = {Var.name = getAcnDeterminantName child.id; tpe = fromAcnInsertedType child.Type} + match child.Type with + | AcnReferenceToEnumerated enm -> + let primDecInfo = + match decInfo with + | PrimitiveDecodeInfo info -> info + | _ -> failwith "Enumerated ACN child decoded with a generated function?" + v, transformAcnEnumerated enm primDecInfo decodedVar + | _ -> v, Var decodedVar + + let makeCall (ix: int) (child: Asn1AcnAst.SeqChildInfo option) (childData: SeqChildDecodeMiscData option) (rest: Expr): Expr = + let currCodec = + if ix = 0 then origC1 + else allReturnedCodecs.[ix - 1] + let retCdc = allReturnedCodecs.[ix] + match childData with + | None -> + // NullType, we only bind the codecs + letsIn [retCdc, Var currCodec] rest + | Some childData -> + let assertion = + if ix = 0 then [] + else + let overallOffset = childrenSizes |> List.take ix |> List.map Var |> plus + [Assert (Equals (bitIndexACN (Var currCodec), plus [bitIndexACN (Var origC1); overallOffset]))] + let call = + match childData.decInfo with + | PrimitiveDecodeInfo info -> + let decData = decodePureCallPrimitiveHelper childData child info $"dec_{ix + 2}_got" (Var currCodec) + // Note: methods from BitStream/Codec return BitStream/Codec, so we need to wrap them back into an ACN codec. + let wrapAcn (cdcId: Identifier) (recv: Expr): Expr = + assert (cdcId = bitStreamId || cdcId = codecId) + if cdcId = codecId then ClassCtor {ct = acnClsTpe; args = [recv]} + else ClassCtor {ct = acnClsTpe; args = [ClassCtor {ct = codecClsTpe; args = [recv]}]} + + let acnBinding = + match child with + | Some (AcnChild c) -> [mkAcnBinding c childData.decInfo decData.dec] + | Some (Asn1Child _) | None -> [] + + let mkNonAcnBdg (cdcId: Identifier): Expr = + assert (cdcId = bitStreamId || cdcId = codecId) + let cdcTpe = ClassType {prefix = []; id = cdcId; tps = []; parameterless = false} + let retCdcTmp = {Var.name = $"{retCdc.name}_tmp"; tpe = cdcTpe} + letTuple [retCdcTmp; decData.dec] decData.decCall (mkBlock [ + letsIn [retCdc, wrapAcn cdcId (Var retCdcTmp)] (letsIn acnBinding rest) + ]) + if info.prefix = [bitStreamId] then mkNonAcnBdg bitStreamId + else if info.prefix = [codecId] then mkNonAcnBdg codecId + else letTuple [retCdc; decData.dec] decData.decCall (letsIn acnBinding rest) + | ComposedDecodeInfo info -> + let mkRightCase (decodedRes: Var) (decodedAcns: Var list): Expr = + // The ACN values returned by this function. The variable names are important here as + // they will be picked up by later calls that depends on these ACNs. + let acnVars = childData.common.acns |> List.map (fun c -> {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type}) + assert (acnVars.Length = decodedAcns.Length) + if decodedAcns.IsEmpty then + match child with + | Some (AcnChild c) -> + letsIn [mkAcnBinding c childData.decInfo decodedRes] rest + | Some (Asn1Child _) | None -> rest + else + // Only Asn1 children (in particular, sequences) may return ACN values + assert ( + match child with + | Some (AcnChild _) | None -> false + | Some (Asn1Child _) -> true + ) + let bdgs = List.zip acnVars (decodedAcns |> List.map Var) + letsIn bdgs rest + let helperRes = decodePureCallComposedHelper childData.common info childData.existArg $"dec_{ix + 2}_got" (Var currCodec) (fun _ _ -> BoolLit false) mkRightCase + letTuple [retCdc; helperRes.dec] helperRes.decCall helperRes.extracted + + mkBlock (assertion @ [call]) + + /////////////// + + let theCondition = + let lastCodec = allReturnedCodecs.[ix - 1] + let cdcEq = Equals (Var lastCodec, Var c1) + let acnsEq = List.zip childData.common.paramsAcn acnParams |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2)) + if acnsEq.IsEmpty then cdcEq + else And (cdcEq :: acnsEq) + + let body = List.foldBack (fun (ix, (child, childData)) rest -> makeCall ix child childData rest) (prevChildrenData |> List.indexed) theCondition + {FunDef.id = $"{childData.name}_codec_origin"; prms = c1 :: acnParams; annots = [Opaque]; specs = []; postcond = None; returnTpe = BooleanType; body = body} + + ///////////////////////////////// + + let mkFieldSubproofFn (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo option) (childData: SeqChildDecodeMiscData) (originFnId: Identifier option): FunDef = let origC1 = data.c1 let origC2Reset = data.c2Reset let c1, c2 = @@ -1613,9 +1726,14 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let overallOffset = if ix = 0 then longlit 0I else childrenSizes |> List.take ix |> List.map Var |> plus let childSize = childrenSizes.[ix] + // This is None for the first child, since this function only make sense for the subsequent children + let origCodecFnCall = originFnId |> Option.map (fun id -> + ApplyLetRec {id = id; args = (Var c1) :: (childData.common.paramsAcn |> List.map Var)} + ) + let specs = if ix = 0 then [] - else [ + else (origCodecFnCall |> Option.map Precond |> Option.toList) @ [ Precond (Equals (selBufACN (Var c1), selBufACN (Var origC1))) Precond (Equals (selBufACN (Var c2), selBufACN (Var origC2Reset))) Precond (Equals (bitIndexACN (Var c1), plus [bitIndexACN (Var origC1); overallOffset])) @@ -1637,7 +1755,6 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) Assert (arrayBitRangesEq (selBufACN (Var c1)) (selBufACN (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) ] - let childData = seqChildDecodeMiscData (t :: (nestingScope.parents |> List.map snd)) ix child (Var data.v1) let acnTps = childData.common.acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) let existArgList = childData.existArg |> Option.toList let c1Next = {Var.name = $"c1_{ix + 2}"; tpe = origC1.tpe} @@ -1672,6 +1789,16 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) } let proofLeftCase1 (_: Var) (_: Var list): Expr = + let body = + let callBodyWithC1 = ApplyLetRec {id = bodyWithC1Id; args = []} + match origCodecFnCall with + | Some origCodecFnCall -> + mkBlock [ + Check origCodecFnCall + Unfold origCodecFnCall + callBodyWithC1 + ] + | None -> callBodyWithC1 let proofContradiction = { FunDef.id = $"proof_unreachability_{childData.name}" @@ -1680,7 +1807,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) specs = [] postcond = Some ({Var.name = "_"; tpe = UnitType}, BoolLit false) returnTpe = UnitType - body = ApplyLetRec {id = bodyWithC1Id; args = []} + body = body } LetRec {fds = [proofContradiction]; body = mkBlock [ApplyLetRec {id = proofContradiction.id; args = []}; TripleQMark]} let mkRightCase (resBdg: Var) (decodedAcnsBdgs: Var list): Expr = @@ -1726,7 +1853,12 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) // Presence bits {bdgs = []; resSize = longlit 1I} - let conds = ([ + let isRightConds = + match childData.decInfo with + | PrimitiveDecodeInfo _ -> [] + | ComposedDecodeInfo _ -> [isRightExpr (Var decDataPostcond1.dec); isRightExpr (Var decDataPostcond2.dec)] + + let conds = (isRightConds @ [ Equals (v1Size.resSize, Var childSize) Equals (Var res1, Var res2) ] @ (List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2))) @ [ @@ -1764,7 +1896,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) ]) ]) - let fd = { + { FunDef.id = $"proof_{ToC childData.name}" prms = if ix = 0 then childData.common.paramsAcn else [c1; c2] @ childData.common.paramsAcn annots = [Opaque; InlineOnce] @@ -1773,9 +1905,8 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) returnTpe = UnitType body = proof } - {fd = fd; existArg = childData.existArg; elemTpe = childData.common.elemTpe; decInfo = childData.decInfo; acns = childData.common.acns; paramsAcn = childData.common.paramsAcn} - let mkSubfieldProofCall (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo option) (proofData: SeqPrefixLemmaSubproofData option): Expr = + let mkSubfieldProofCall (data: PrefixLemmaData) (ix: int) (child: Asn1AcnAst.SeqChildInfo option) (proofIdAndChildData: (Identifier * SeqChildDecodeMiscData) option) (originFnId: Identifier option): Expr = let origC1 = data.c1 let origC2Reset = data.c2Reset let c1Prev, c2Prev = @@ -1783,52 +1914,48 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) else {Var.name = $"c1_{ix}"; tpe = origC1.tpe}, {Var.name = $"c2_{ix}"; tpe = origC1.tpe} let c1, c2 = {Var.name = $"c1_{ix + 1}"; tpe = origC1.tpe}, {Var.name = $"c2_{ix + 1}"; tpe = origC1.tpe} - match proofData with + let mkAcnBinding (decInfo: DecodeInfo) (dec1: Var) (c: AcnChild): Expr = + // This ACN variable will be picked up by the later decode functions. It is important it to be bound with that specific name + // Note that the calls with c1 and c2 yield the same values, we arbitrarily pick the value from the call with c1. + let v = {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type} + match c.Type with + | AcnReferenceToEnumerated enm -> + let primDecInfo = + match decInfo with + | PrimitiveDecodeInfo info -> info + | _ -> failwith "Enumerated ACN child decoded with a generated function?" + let transformed = transformAcnEnumerated enm primDecInfo dec1 + letsIn [v, transformed] (mkBlock []) + | _ -> + match decInfo with + | PrimitiveDecodeInfo _ -> letsIn [v, Var dec1] (mkBlock []) + | ComposedDecodeInfo _ -> + let bdg = {Var.name = "bdg"; tpe = v.tpe} + let extracted = eitherMutMatchExpr (Var dec1) None (mkBlock [Check (BoolLit false); TripleQMark]) (Some bdg) (Var bdg) + letsIn [v, extracted] (mkBlock []) + + match proofIdAndChildData with | None -> // NullType case: we assign the codecs to the previous ones // TODO: handle case where there is a bitpattern letsIn [(c1, Snapshot (Var c1Prev)); (c2, Snapshot (Var c2Prev))] (mkBlock []) - | Some proofData -> + | Some (proofId, childData) -> let codecArgs = if ix = 0 then [] else [Var c1Prev; Var c2Prev] - let existArgList = proofData.existArg |> Option.toList - - let mkAcnBinding (dec1: Var) (c: AcnChild): Expr = - // This ACN variable will be picked up by the later decode functions. It is important it to be bound with that specific name - // Note that the calls with c1 and c2 yield the same values, we arbitrarily pick the value from the call with c1. - let v = {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type} - match c.Type with - | AcnReferenceToEnumerated enm -> - // For Enumerated, we need to transform the integer to a Scala enum - let primDecInfo = - match proofData.decInfo with - | PrimitiveDecodeInfo info -> info - | _ -> failwith "Enumerated ACN child decoded with a generated function?" - let intTpe = - match primDecInfo.tpe with - | IntegerType tp -> tp - | _ -> failwith $"${v.name} has not an IntegerType type" - let branches = enm.enumerated.items |> List.map (fun i -> - let cond = Equals (Var dec1, IntLit (intTpe, i.acnEncodeValue)) - let branch = ClassCtor {ct = {prefix = [enm.enumerated.typeDef.[Scala].typeName]; id = i.scala_name; tps = []; parameterless = true}; args = []} - cond, branch - ) - let transform = ifElseBranches branches (mkBlock [Check (BoolLit false); TripleQMark]) - letsIn [v, transform] (mkBlock []) - | _ -> - match proofData.decInfo with - | PrimitiveDecodeInfo _ -> letsIn [v, Var dec1] (mkBlock []) - | ComposedDecodeInfo _ -> - let bdg = {Var.name = "bdg"; tpe = v.tpe} - let extracted = eitherMutMatchExpr (Var dec1) None (mkBlock [Check (BoolLit false); TripleQMark]) (Some bdg) (Var bdg) - letsIn [v, extracted] (mkBlock []) + let existArgList = childData.existArg |> Option.toList + + // This is None for the first child, since this function only make sense for the subsequent children + let origCodecFnCheck = originFnId |> Option.toList |> List.collect (fun id -> + let call = ApplyLetRec {id = id; args = (Var c1Prev) :: (childData.common.paramsAcn |> List.map Var)} + [Unfold call; Assert call] + ) let callsBdgs = - match proofData.decInfo with + match childData.decInfo with | PrimitiveDecodeInfo info -> - let dec1 = {Var.name = $"dec1_{ix + 1}"; tpe = proofData.elemTpe} - let dec2 = {Var.name = $"dec2_{ix + 1}"; tpe = proofData.elemTpe} - let dec1Call = MethodCall {recv = selectCodecDecodeInfo proofData.decInfo (Var c1Prev); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} - let dec2Call = MethodCall {recv = selectCodecDecodeInfo proofData.decInfo (Var c2Prev); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} + let dec1 = {Var.name = $"dec1_{ix + 1}"; tpe = childData.common.elemTpe} + let dec2 = {Var.name = $"dec2_{ix + 1}"; tpe = childData.common.elemTpe} + let dec1Call = MethodCall {recv = selectCodecDecodeInfo childData.decInfo (Var c1Prev); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} + let dec2Call = MethodCall {recv = selectCodecDecodeInfo childData.decInfo (Var c2Prev); id = info.decodePureId; args = existArgList @ info.extraConstArgs; parameterless = false} // Note: methods from BitStream/Codec return BitStream/Codec, so we need to wrap them back into an ACN codec. let callsBdgs = @@ -1853,7 +1980,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let acnBinding = match child with - | Some (AcnChild c) -> mkAcnBinding dec1 c + | Some (AcnChild c) -> mkAcnBinding childData.decInfo dec1 c | Some (Asn1Child _) | None -> mkBlock [] mkBlock [ @@ -1862,27 +1989,27 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) ] | ComposedDecodeInfo info -> // The ACN values returned by this function. Since the calls with c1 and c2 yield the same values, we arbitrarily bind - // these variables to the first call. The variable name is important here as it will be picked up by later fields + // these variables to the first call. The variable name are important here as they will be picked up by later calls // that depends on these ACNs. - let acnVars = proofData.acns |> List.map (fun c -> {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type}) + let acnVars = childData.common.acns |> List.map (fun c -> {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type}) let acnTps = acnVars |> List.map (fun v -> v.tpe) - let decResTpe = eitherMutTpe (IntegerType Int) (tupleType (proofData.elemTpe :: acnTps)) + let decResTpe = eitherMutTpe (IntegerType Int) (tupleType (childData.common.elemTpe :: acnTps)) let dec1 = {Var.name = $"dec1_{ix + 1}"; tpe = decResTpe} let dec2 = {Var.name = $"dec2_{ix + 1}"; tpe = decResTpe} let dec1Call = FunctionCall { prefix = []; id = info.decodePureId; tps = [] - args = [selectCodecDecodeInfo proofData.decInfo (Var c1Prev)] @ existArgList @ (proofData.paramsAcn |> List.map Var) + args = [Var c1Prev] @ existArgList @ (childData.common.paramsAcn |> List.map Var) parameterless = true } let dec2Call = FunctionCall { prefix = []; id = info.decodePureId; tps = [] - args = [selectCodecDecodeInfo proofData.decInfo (Var c2Prev)] @ existArgList @ (proofData.paramsAcn |> List.map Var) + args = [Var c2Prev] @ existArgList @ (childData.common.paramsAcn |> List.map Var) parameterless = true } let acnBinding = if acnVars.IsEmpty then match child with - | Some (AcnChild c) -> mkAcnBinding dec1 c + | Some (AcnChild c) -> mkAcnBinding childData.decInfo dec1 c | Some (Asn1Child _) | None -> mkBlock [] else // Only Asn1 children (in particular, sequences) may return ACN values @@ -1891,7 +2018,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | Some (AcnChild _) | None -> false | Some (Asn1Child _) -> true ) - let decTmp = {Var.name = $"decTmp_{ix + 1}"; tpe = tupleType (proofData.elemTpe :: acnTps)} + let decTmp = {Var.name = $"decTmp_{ix + 1}"; tpe = tupleType (childData.common.elemTpe :: acnTps)} let decTmpValue = eitherMutMatchExpr (Var dec1) None (mkBlock [Check (BoolLit false); TripleQMark]) (Some decTmp) (Var decTmp) let acnBdgs = acnVars |> List.indexed |> List.map (fun (ix, v) -> v, TupleSelect (Var decTmp, ix + 2)) letsIn ((decTmp, decTmpValue) :: acnBdgs) (mkBlock []) @@ -1899,10 +2026,10 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) letTuple [c1; dec1] dec1Call (mkBlock [ letTuple [c2; dec2] dec2Call acnBinding]) - mkBlock [ - ApplyLetRec {id = proofData.fd.id; args = codecArgs @ (proofData.paramsAcn |> List.map Var)} + mkBlock (origCodecFnCheck @ [ + ApplyLetRec {id = proofId; args = codecArgs @ (childData.common.paramsAcn |> List.map Var)} callsBdgs - ] + ]) //////////////////////////// @@ -1910,19 +2037,40 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let bodyWithC1 = mkUnfoldedDecodeWrapper data bodyWithC1Id data.c1 let bodyWithC2 = mkUnfoldedDecodeWrapper data bodyWithC2Id data.c2Reset - let subproofs = ( + let isNullType (c: SeqChildInfo option): bool = + match c with + | Some (Asn1Child asn1) -> + match asn1.Type.Kind with + | NullType _ -> true + | _ -> false + | _ -> false + + let construct (previousChildData: (Asn1AcnAst.SeqChildInfo option * SeqChildDecodeMiscData option) list, + originFnsAcc: FunDef list, + subproofFnsAcc: FunDef list, + subproofCallsAcc: Expr list) (ix: int, child: SeqChildInfo option) = + // `child` is None for presence bits + + if isNullType child then + // TODO: Not quite, if the NT has an encoding pattern, there is some logic to do + // This only does the codec bindings + let subproofCall = mkSubfieldProofCall data ix child None None + previousChildData @ [child, None], originFnsAcc, subproofFnsAcc, subproofCallsAcc @ [subproofCall] + else + let childData = seqChildDecodeMiscData (t :: (nestingScope.parents |> List.map snd)) ix child (Var data.v1) + let originFn = + if ix = 0 then None + else Some (mkFieldCodecOriginFn data ix child childData previousChildData) + let originFnId = originFn |> Option.map (fun fd -> fd.id) + let subproofFn = mkFieldSubproofFn data ix child childData originFnId + let subproofCall = mkSubfieldProofCall data ix child (Some (subproofFn.id, childData)) originFnId + previousChildData @ [child, Some childData], originFnsAcc @ (originFn |> Option.toList), subproofFnsAcc @ [subproofFn], subproofCallsAcc @ [subproofCall] + + let _, originFns, subproofFns, subproofCalls = ( (List.replicate nbPresenceBits (None: SeqChildInfo option) @ (sq.children |> List.map Some)) |> List.indexed |> - List.map (fun (i, c) -> - match c with - | Some (Asn1Child asn1) -> - match asn1.Type.Kind with - | NullType _ -> i, c, None // TODO: Not quite, if the NT has an encoding pattern, there is some logic to do - | _ -> i, c, Some (mkFieldSubproofFn data i c) - | Some (AcnChild _) | None -> i, c, Some (mkFieldSubproofFn data i c) - )) - let subproofFns = subproofs |> List.choose (fun (_, _, sp) -> sp |> Option.map (fun sp -> sp.fd)) - let subproofCalls = subproofs |> List.map (fun (i, c, sp) -> mkSubfieldProofCall data i c sp) + List.fold (construct) ([], [], [], [])) + let finalCheck = let ixChecks = Check (Equals (bitIndexACN (Var data.c1Res), bitIndexACN (Var data.c2Res))) let decodedChecks = Check (Equals (Var data.v1, Var data.v2)) @@ -1950,9 +2098,11 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) } let body = mkBlock ([ ApplyLetRec {id = bodyWithC1.id; args = []} + ] @ subproofCalls @ [ ApplyLetRec {id = bodyWithC2.id; args = []} - ] @ subproofCalls @ [finalCheck]) - let proof = LetRec {fds = subproofFns; body = body} + finalCheck + ]) + let proof = LetRec {fds = originFns @ subproofFns; body = body} let rightMutCase = letsIn (data.v1SizeExpr.bdgs @ [data.v1SizeVar, data.v1SizeExpr.resSize]) ( From 5ed043c5a14178c756bb0e34d62ae5cc50b08b3e Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Wed, 21 Aug 2024 10:39:14 +0200 Subject: [PATCH 29/35] prefix lemma: bind size computation in specs instead of duplicating it in body and postcond --- StgScala/ProofGen.fs | 72 ++++++++++++++++++++++++++++++-------------- 1 file changed, 50 insertions(+), 22 deletions(-) diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 48b3dbe9e..bfe6bbd6f 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -1240,17 +1240,6 @@ let generatePrefixLemmaCommon (enc: Asn1Encoding) let dec2 = {Var.name = "dec2"; tpe = TupleType [c2Res.tpe; decodingRes2.tpe]} let call2 = FunctionCall {prefix = []; id = decodePureId; tps = []; args = Var c2Reset :: (paramsAcn |> List.map Var); parameterless = true} - let preSpecs = - preconds @ [ - LetSpec (c2Reset, resetAtACN (Var c2) (Var c1)) - LetSpec (dec1, call1) - LetSpec (c1Res, TupleSelect (Var dec1, 1)) - LetSpec (decodingRes1, TupleSelect (Var dec1, 2)) - LetSpec (dec2, call2) - LetSpec (c2Res, TupleSelect (Var dec2, 1)) - LetSpec (decodingRes2, TupleSelect (Var dec2, 2)) - ] - let v1 = {Var.name = "v1"; tpe = tpe} let v2 = {Var.name = "v2"; tpe = tpe} let decodedAcn1 = acnTps |> List.indexed |> List.map (fun (i, tpe) -> {Var.name = $"acn1_{i + 1}"; tpe = tpe}) @@ -1271,8 +1260,51 @@ let generatePrefixLemmaCommon (enc: Asn1Encoding) subPat1, subPat2 let acnsEq = List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2)) + // The size of the decoded value, in case of success let v1SizeExpr = mkSizeExpr v1 c1 + // We pattern match on the result and bind v1Size to the result of v1SizeExpr in case of success or to 0L otherwise + // We also re-bind the intermediate bindings (e.g. size_1_0) since these are used by the Sequence proof let v1SizeVar = {Var.name = "v1Size"; tpe = IntegerType Long} + let v1SizePatMat = + MatchExpr { + scrut = Var decodingRes1 + cases = [ + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [subPat1] + } + rhs = letsIn v1SizeExpr.bdgs (mkTuple (v1SizeExpr.resSize :: (v1SizeExpr.bdgs |> List.map fst |> List.map Var))) + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = mkTuple (List.replicate (v1SizeExpr.bdgs.Length + 1) (longlit 0I)) + } + ] + } + + let preSpecs = + let sizeBdgs = + if v1SizeExpr.bdgs.IsEmpty then [LetSpec (v1SizeVar, v1SizePatMat)] + else + let v1SizeTuple = {v1SizeVar with name = $"v1SizeTuple"} + let tupleBdgs = (v1SizeVar :: (v1SizeExpr.bdgs |> List.map fst)) |> List.indexed |> List.map (fun (i, v) -> LetSpec (v, TupleSelect (Var v1SizeTuple, i + 1))) + LetSpec (v1SizeTuple, v1SizePatMat) :: tupleBdgs + preconds @ [ + LetSpec (c2Reset, resetAtACN (Var c2) (Var c1)) + LetSpec (dec1, call1) + LetSpec (c1Res, TupleSelect (Var dec1, 1)) + LetSpec (decodingRes1, TupleSelect (Var dec1, 2)) + LetSpec (dec2, call2) + LetSpec (c2Res, TupleSelect (Var dec2, 1)) + LetSpec (decodingRes2, TupleSelect (Var dec2, 2)) + ] @ sizeBdgs + let prop = let prop = And ([Equals (bitIndexACN (Var c1Res), bitIndexACN (Var c2Res)); Equals (Var v1, Var v2)] @ acnsEq) IfExpr { @@ -1302,7 +1334,6 @@ let generatePrefixLemmaCommon (enc: Asn1Encoding) } let postcond = - let boundProp = letsIn (v1SizeExpr.bdgs @ [v1SizeVar, v1SizeExpr.resSize]) prop MatchExpr { scrut = Var decodingRes1 cases = [ @@ -1312,7 +1343,7 @@ let generatePrefixLemmaCommon (enc: Asn1Encoding) id = rightMutId subPatterns = [subPat1] } - rhs = boundProp + rhs = prop } { pattern = ADTPattern { @@ -2105,13 +2136,11 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let proof = LetRec {fds = originFns @ subproofFns; body = body} let rightMutCase = - letsIn (data.v1SizeExpr.bdgs @ [data.v1SizeVar, data.v1SizeExpr.resSize]) ( - IfExpr { - cond = Equals (Var data.v1SizeVar, Var data.sz) - thn = proof - els = UnitLit - } - ) + IfExpr { + cond = Equals (Var data.v1SizeVar, Var data.sz) + thn = proof + els = UnitLit + } LetRec { fds = [bodyWithC1; bodyWithC2] body = MatchExpr { @@ -3162,7 +3191,6 @@ let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc thn = mkBlock ((slicedLemmaApp |> Option.toList) @ [prefixLemmaApp]) els = UnitLit } - let boundProofRightMutCase = letsIn (data.v1SizeExpr.bdgs @ [data.v1SizeVar, data.v1SizeExpr.resSize]) proofRightMutCase mkBlock [ unfoldC1 unfoldC2 @@ -3175,7 +3203,7 @@ let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc id = rightMutId subPatterns = [data.subPat1] } - rhs = boundProofRightMutCase + rhs = proofRightMutCase } { pattern = ADTPattern { From 08700c22781afa2ec323ca3d0364b8e5aa43df2d Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Wed, 21 Aug 2024 13:31:40 +0200 Subject: [PATCH 30/35] Add proof for Choice prefix lemma --- StgScala/ProofGen.fs | 205 ++++++++++++------ .../scala/asn1scala/asn1jvm_Codec_ACN.scala | 2 +- 2 files changed, 137 insertions(+), 70 deletions(-) diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index bfe6bbd6f..1926cbb34 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -1393,74 +1393,6 @@ let generatePrefixLemma (enc: Asn1Encoding) let mkSizeExpr = fun v1 c1 -> asn1SizeExpr t.acnAlignment t.Kind (Var v1) (bitIndexACN (Var c1)) 0I 0I generatePrefixLemmaCommon enc tpe t.acnMaxSizeInBits baseId paramsAcn acnTps mkSizeExpr nestingScope mkProof -let generatePrefixLemmaBool (enc: Asn1Encoding) - (t: Asn1AcnAst.Asn1Type) - (nestingScope: NestingScope) - (boolean: Boolean): FunDef = - let mkProof (data: PrefixLemmaData): Expr = - UnitLit // TODO - generatePrefixLemma enc t nestingScope mkProof - -let generatePrefixLemmaInteger (enc: Asn1Encoding) - (t: Asn1AcnAst.Asn1Type) - (nestingScope: NestingScope) - (int: Integer): FunDef = - let mkProof (data: PrefixLemmaData): Expr = - UnitLit // TODO - generatePrefixLemma enc t nestingScope mkProof - -let generatePrefixLemmaChoice (enc: Asn1Encoding) - (t: Asn1AcnAst.Asn1Type) - (nestingScope: NestingScope) - (ch: Asn1AcnAst.Choice): FunDef = - let mkProof (data: PrefixLemmaData): Expr = - UnitLit // TODO - generatePrefixLemma enc t nestingScope mkProof - -let generatePrefixLemmaNullType (enc: Asn1Encoding) - (t: Asn1AcnAst.Asn1Type) - (nestingScope: NestingScope) - (nt: Asn1AcnAst.NullType): FunDef = - let mkProof (data: PrefixLemmaData): Expr = - UnitLit // TODO - generatePrefixLemma enc t nestingScope mkProof - -let generatePrefixLemmaEnum (enc: Asn1Encoding) - (t: Asn1AcnAst.Asn1Type) - (nestingScope: NestingScope) - (enm: Asn1AcnAst.Enumerated): FunDef = - let mkProof (data: PrefixLemmaData): Expr = - UnitLit // TODO - generatePrefixLemma enc t nestingScope mkProof - -let generatePrefixLemmaSequenceOfLike (enc: Asn1Encoding) - (t: Asn1TypeOrAcnRefIA5) - (nestingScope: NestingScope) - (sqf: SequenceOfLike): FunDef = - let mkSqOfLikeProof (data: PrefixLemmaData): Expr = - UnitLit // TODO - let tpe = fromSequenceOfLike sqf - let mkSizeExpr = - // TODO: Alignment? - match sqf with - | SqOf _ -> fun v1 c1 -> {bdgs = []; resSize = callSize (Var v1) (bitIndexACN (Var c1))} - | _ -> - let maxElemSz = sqf.maxElemSizeInBits enc - fun v1 _ -> {bdgs = []; resSize = Mult (longlit maxElemSz, vecSize (Var v1))} - let baseId, paramsAcn, acnTps = - match t with - | Asn1TypeOrAcnRefIA5.Asn1 t -> - let isTopLevel = nestingScope.parents.IsEmpty - let baseId = - if isTopLevel then t.FT_TypeDefinition.[Scala].typeName - else ToC t.id.dropModule.AsString - let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) - let acns = collectNestedAcnChildren t.Kind - let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) - baseId, paramsAcn, acnTps - | Asn1TypeOrAcnRefIA5.AcnRefIA5 (tId, _) -> ToC tId.dropModule.AsString, [], [] - generatePrefixLemmaCommon enc tpe (sqf.maxSizeInBits enc) baseId paramsAcn acnTps mkSizeExpr nestingScope mkSqOfLikeProof - type SeqPrefixLemmaSubproofData = { fd: FunDef decInfo: DecodeInfo @@ -1608,6 +1540,141 @@ let decodePureCallComposedHelper (data: SeqDecodeMiscData) {dec = dec; decCall = decCall; extracted = extracted} +let generatePrefixLemmaBool (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (boolean: Boolean): FunDef = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaInteger (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (int: Integer): FunDef = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaChoice (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (ch: Asn1AcnAst.Choice): FunDef = + let mkProofSubcase (data: PrefixLemmaData) (cse: ChChildInfo): Expr = + match cse.Type.Kind with + | NullType _ -> UnitLit + | _ -> + let decMiscData = seqDecodeMiscData (t :: (nestingScope.parents |> List.map snd)) cse.Type + let decInfo = decodeInfo (Asn1 cse.Type) cse.Type.id false + match decInfo with + | PrimitiveDecodeInfo info -> + assert decMiscData.acns.IsEmpty + FunctionCall { + prefix = info.prefix; id = info.prefixLemmaId; tps = [] + args = [ + selectCodecDecodeInfo decInfo (Var data.c1) + selectCodecDecodeInfo decInfo (Var data.c2) + ] @ info.extraConstArgs + parameterless = true + } + | ComposedDecodeInfo info -> + FunctionCall { + prefix = []; id = info.prefixLemmaId; tps = [] + args = [Var data.c1; Var data.c2; Var data.sz] @ (decMiscData.paramsAcn |> List.map Var) + parameterless = true + } + + let mkProof (data: PrefixLemmaData): Expr = + let mkUnfoldCall (cdc: Var): Expr = + Unfold (FunctionCall {prefix = []; id = data.decodeId; tps = []; args = [Snapshot (Var cdc)] @ (data.paramsAcn |> List.map Var); parameterless = true}) + + let callC1 = mkUnfoldCall data.c1 + let callC2 = mkUnfoldCall data.c2Reset + + let cases = ch.children |> List.map (fun child -> + let tpeId = (ToC ch.typeDef[Scala].typeName) + "." + (ToC child.present_when_name) + "_PRESENT" + let tpe = fromAsn1TypeKind child.Type.Kind + let binder = {Var.name = child._scala_name; tpe = tpe} + let pat = ADTPattern {binder = None; id = tpeId; subPatterns = [Wildcard (Some binder)]} + {MatchCase.pattern = pat; rhs = mkProofSubcase data child} + ) + let proof = + IfExpr { + cond = Equals (Var data.v1SizeVar, Var data.sz) + thn = MatchExpr {scrut = Var data.v1; cases = cases} + els = UnitLit + } + mkBlock [ + callC1 + callC2 + MatchExpr { + scrut = Var data.decodingRes1 + cases = [ + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [data.subPat1] + } + rhs = proof + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = UnitLit + } + ] + } + ] + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaNullType (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (nt: Asn1AcnAst.NullType): FunDef = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaEnum (enc: Asn1Encoding) + (t: Asn1AcnAst.Asn1Type) + (nestingScope: NestingScope) + (enm: Asn1AcnAst.Enumerated): FunDef = + let mkProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + generatePrefixLemma enc t nestingScope mkProof + +let generatePrefixLemmaSequenceOfLike (enc: Asn1Encoding) + (t: Asn1TypeOrAcnRefIA5) + (nestingScope: NestingScope) + (sqf: SequenceOfLike): FunDef = + let mkSqOfLikeProof (data: PrefixLemmaData): Expr = + UnitLit // TODO + let tpe = fromSequenceOfLike sqf + let mkSizeExpr = + // TODO: Alignment? + match sqf with + | SqOf _ -> fun v1 c1 -> {bdgs = []; resSize = callSize (Var v1) (bitIndexACN (Var c1))} + | _ -> + let maxElemSz = sqf.maxElemSizeInBits enc + fun v1 _ -> {bdgs = []; resSize = Mult (longlit maxElemSz, vecSize (Var v1))} + let baseId, paramsAcn, acnTps = + match t with + | Asn1TypeOrAcnRefIA5.Asn1 t -> + let isTopLevel = nestingScope.parents.IsEmpty + let baseId = + if isTopLevel then t.FT_TypeDefinition.[Scala].typeName + else ToC t.id.dropModule.AsString + let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) + let acns = collectNestedAcnChildren t.Kind + let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) + baseId, paramsAcn, acnTps + | Asn1TypeOrAcnRefIA5.AcnRefIA5 (tId, _) -> ToC tId.dropModule.AsString, [], [] + generatePrefixLemmaCommon enc tpe (sqf.maxSizeInBits enc) baseId paramsAcn acnTps mkSizeExpr nestingScope mkSqOfLikeProof + let generatePrefixLemmaSequence (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) @@ -1622,7 +1689,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let mkUnfoldedDecodeWrapper (data: PrefixLemmaData) (id: Identifier) (c: Var): FunDef = let cpy = {Var.name = $"{c.name}Cpy"; tpe = c.tpe} - let call = FunctionCall {prefix = []; id = data.decodeId; tps = []; args = [Var cpy]; parameterless = true} + let call = FunctionCall {prefix = []; id = data.decodeId; tps = []; args = [Var cpy] @ (data.paramsAcn |> List.map Var); parameterless = true} let body = letsIn [cpy, Snapshot (Var c)] (Unfold call) { FunDef.id = id; diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 361e1f4b5..b2f27174a 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -27,7 +27,7 @@ object ACN { } // TODO: Placeholder - def readPrefixLemma_TODO(acn1: ACN, acn2: ACN): Unit = () + def TODO_ASN1_OTHER_prefixLemma(acn1: ACN, acn2: ACN): Unit = () @ghost @pure @opaque @inlineOnce def dec_Int_TwosComplement_ConstSize_8_prefixLemma(acn1: ACN, acn2: ACN): Unit = { From 61dba8650abe0ec8f75ed5f961d68fc8d2758a6b Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Thu, 22 Aug 2024 10:09:57 +0200 Subject: [PATCH 31/35] prefix lemma: add further assertions to help prove decoding success --- StgScala/ProofGen.fs | 53 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 42 insertions(+), 11 deletions(-) diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 1926cbb34..75b725c9a 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -1851,6 +1851,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let c2MovedAssertions = [ Assert (Equals (bitIndexACN (Var c2Moved), plus [bitIndexACN (Var c1); Var childSize])) Assert (arrayBitRangesEq (selBufACN (Var c1)) (selBufACN (Var c2Moved)) (longlit 0I) (plus [bitIndexACN (Var c1); Var childSize])) + Assert (Equals (resetAtACN (Var c2Moved) (Var c1), Var c2)) ] let acnTps = childData.common.acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) @@ -1939,6 +1940,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) | ComposedDecodeInfo _ -> bitIndexACN cdc let accOffsets = if ix = 0 then longlit 0I else childrenSizes |> List.take ix |> List.map Var |> plus + let v1SizeVar = {Var.name = $"size_{childData.name}"; tpe = IntegerType Long} let v1Size = match child with | Some (Asn1Child asn1) -> @@ -1951,13 +1953,39 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) // Presence bits {bdgs = []; resSize = longlit 1I} + // A small lemma to prove that the size of the child decoded from the Sequence's decode function + // is the same as the size of the child decoded by just calling the child's decode function + // This lemma is trivial if the child is first, so it's omitted. + // It should go before pattern matching on the success of `res2` since it also helps prove + // that `res2` cannot fail. + let proofSizeEq = + match origCodecFnCall with + | None -> [] + | Some origCodecFnCall -> + let body = mkBlock [ + Check origCodecFnCall + Unfold origCodecFnCall + ApplyLetRec {id = bodyWithC1Id; args = []} + ] + let proofSizeEq = + { + FunDef.id = $"proof_size_eq_{childData.name}" + prms = [] + annots = [Pure; Opaque; InlineOnce] + specs = [] + postcond = Some ({Var.name = "_"; tpe = UnitType}, Equals (Var v1SizeVar, Var childSize)) + returnTpe = UnitType + body = body + } + [LetRec {fds = [proofSizeEq]; body = ApplyLetRec {id = proofSizeEq.id; args = []}}] + let isRightConds = match childData.decInfo with | PrimitiveDecodeInfo _ -> [] | ComposedDecodeInfo _ -> [isRightExpr (Var decDataPostcond1.dec); isRightExpr (Var decDataPostcond2.dec)] let conds = (isRightConds @ [ - Equals (v1Size.resSize, Var childSize) + Equals (Var v1SizeVar, Var childSize) Equals (Var res1, Var res2) ] @ (List.zip decodedAcn1 decodedAcn2 |> List.map (fun (acn1, acn2) -> Equals (Var acn1, Var acn2))) @ [ // Note: c1Next and c2Next may be Codec/BitStream instead of ACN, we therefore need to adjust as said in the comment above @@ -1971,15 +1999,18 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) slicedLemmaApp letsIn [c2Moved, c2MovedValue] (mkBlock ( c2MovedAssertions @ [prefixLemmaApp; validateOffsLemma] @ - [letTuple [c1Next; decDataProof1.dec] decDataProof1.decCall (mkBlock [ - letTuple [c2Next; decDataProof2.dec] decDataProof2.decCall (mkBlock [ - letTuple (res1 ::decodedAcn1) decDataProof1.extracted (mkBlock [ - letTuple (res2 ::decodedAcn2) decDataProof2.extracted ( - letsIn v1Size.bdgs (mkBlock (conds |> List.map Check)) - ) - ]) - ]) - ])] + [letTuple [c1Next; decDataProof1.dec] decDataProof1.decCall ( + letTuple [c2Next; decDataProof2.dec] decDataProof2.decCall ( + letTuple (res1 ::decodedAcn1) decDataProof1.extracted ( + letsIn (v1Size.bdgs @ [v1SizeVar, v1Size.resSize]) (mkBlock ( + proofSizeEq @ [ + letTuple (res2 ::decodedAcn2) decDataProof2.extracted ( + (mkBlock (conds |> List.map Check)) + )] + )) + ) + ) + )] )) ] @@ -1988,7 +2019,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) letTuple [c2Next; decDataPostcond2.dec] decDataPostcond2.decCall (mkBlock [ letTuple (res1 ::decodedAcn1) decDataPostcond1.extracted (mkBlock [ letTuple (res2 ::decodedAcn2) decDataPostcond2.extracted ( - letsIn v1Size.bdgs (And conds) + letsIn (v1Size.bdgs @ [v1SizeVar, v1Size.resSize]) (And conds) ) ]) ]) From 065edefb3dea2cbdbce1a350a1f003f086eee522 Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Thu, 22 Aug 2024 15:47:54 +0200 Subject: [PATCH 32/35] Fix resetAtEqLemma not being applied to the correct codecs --- StgScala/ProofGen.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 75b725c9a..199155868 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -2702,7 +2702,7 @@ let generateSequenceProof (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (t: Asn1Ac let cdcAssertions = if ix = nbPresenceBits + sq.children.Length - 1 then [Assert (Equals (Var nextC, Var cdc))] else [ - resetAtEqLemma (Var c) (Var cdc) (Var snap) + resetAtEqLemma (Var nextC) (Var cdc) (Var nextSnap) Assert (Equals (Var nextC, resetAtACN (Var cdc) (Var nextSnap))) ] let assertions = mkBlock ( From 27cacc33a3886003b8e6a4c876b0a9a8dbee2b71 Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Thu, 29 Aug 2024 16:54:25 +0200 Subject: [PATCH 33/35] Forward 'deps' to fetch ACN dependencies --- BackendAst/DAstACN.fs | 63 ++++++++++++++------------- BackendAst/DAstConstruction.fs | 72 +++++++++++++++---------------- FrontEndAst/AcnCreateFromAntlr.fs | 15 ++++--- FrontEndAst/Asn1AcnAst.fs | 5 ++- FrontEndAst/Language.fs | 4 +- StgScala/LangGeneric_scala.fs | 4 +- StgScala/ProofGen.fs | 25 ++++++----- 7 files changed, 98 insertions(+), 90 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index eb8ce1ccc..646a5091a 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -236,6 +236,7 @@ let adaptArgumentValue = DAstUPer.adaptArgumentValue let joinedOrAsIdentifier = DAstUPer.joinedOrAsIdentifier let private createAcnFunction (r: Asn1AcnAst.AstRoot) + (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm: LanguageMacros) (codec: CommonTypes.Codec) (t: Asn1AcnAst.Asn1Type) @@ -272,11 +273,11 @@ let private createAcnFunction (r: Asn1AcnAst.AstRoot) (c_name: string): ((AcnFuncBodyResult option)*State) = let funcBody = handleSavePosition funcBody t.SaveBitStreamPosition c_name t.id lm codec let ret = handleAlignmentForAsn1Types r lm codec t.acnAlignment funcBody - let ret = lm.lg.adaptAcnFuncBody r ret isValidFuncName t codec + let ret = lm.lg.adaptAcnFuncBody r deps ret isValidFuncName t codec ret st errCode prms nestingScope p let funcBody = handleAlignmentForAsn1Types r lm codec t.acnAlignment funcBody - let funcBody = lm.lg.adaptAcnFuncBody r funcBody isValidFuncName t codec + let funcBody = lm.lg.adaptAcnFuncBody r deps funcBody isValidFuncName t codec let p : CallerScope = lm.lg.getParamType t codec let varName = p.arg.receiverId @@ -497,7 +498,7 @@ let getMappingFunctionModule (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (soMapFu | true -> Some (acn_a.rtlModuleName() ) | false -> r.args.mappingFunctionsModule -let createAcnIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (t:Asn1AcnAst.AcnInteger) (us:State) = +let createAcnIntegerFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (t:Asn1AcnAst.AcnInteger) (us:State) = let errCodeName = ToC ("ERR_ACN" + (codec.suffix.ToUpper()) + "_" + ((typeId.AcnAbsPath |> Seq.skip 1 |> Seq.StrJoin("-")).Replace("#","elm"))) let errCode, ns = getNextValidErrorCode us errCodeName None @@ -519,7 +520,7 @@ let createAcnIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C (funcBody errCode), ns -let createIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Integer) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = +let createIntegerFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Integer) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = let sAsn1Constraints = let sTmpCons = o.AllCons |> List.map (DastValidate2.printRangeConAsAsn1 (fun z -> z.ToString())) |> Seq.StrJoin "" match sTmpCons.Trim() with @@ -545,7 +546,7 @@ let createIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Comm {res with auxiliaries = res.auxiliaries @ aux}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us let createAcnChildIcdFunction (ch:AcnChild) = let icd fieldName comments = @@ -573,7 +574,7 @@ let enumComment stgFileName (o:Asn1AcnAst.Enumerated) = List.map EmitItem icd_uper.EmitEnumInternalContents stgFileName itemsHtml -let createEnumCommon (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (o:Asn1AcnAst.Enumerated) (defOrRef:TypeDefinitionOrReference ) (typeDefinitionName:string) (icdStgFileName:string) sAsn1Constraints acnMinSizeInBits acnMaxSizeInBits unitsOfMeasure = +let createEnumCommon (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (o:Asn1AcnAst.Enumerated) (defOrRef:TypeDefinitionOrReference ) (typeDefinitionName:string) (icdStgFileName:string) sAsn1Constraints acnMinSizeInBits acnMaxSizeInBits unitsOfMeasure = let EnumeratedEncValues = lm.acn.EnumeratedEncValues let Enumerated_item = lm.acn.Enumerated_item let IntFullyConstraintPos = lm.uper.IntFullyConstraintPos @@ -645,9 +646,9 @@ let createEnumCommon (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTyp -let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (defOrRef:TypeDefinitionOrReference) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = +let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (icdStgFileName:string) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (defOrRef:TypeDefinitionOrReference) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = let typeDefinitionName = defOrRef.longTypedefName2 lm.lg.hasModules //getTypeDefinitionName t.id.tasInfo typeDefinition - let funcBodyOrig = createEnumCommon r lm codec t.id o defOrRef typeDefinitionName icdStgFileName None t.acnMinSizeInBits t.acnMaxSizeInBits t.unitsOfMeasure + let funcBodyOrig = createEnumCommon r deps lm codec t.id o defOrRef typeDefinitionName icdStgFileName None t.acnMinSizeInBits t.acnMaxSizeInBits t.unitsOfMeasure let funcBody (errCode: ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) @@ -658,18 +659,18 @@ let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (lm: {res with auxiliaries = res.auxiliaries @ aux}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us -let createAcnEnumeratedFunction (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (t:Asn1AcnAst.AcnReferenceToEnumerated) (defOrRef:TypeDefinitionOrReference) (us:State) = +let createAcnEnumeratedFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (icdStgFileName:string) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (t:Asn1AcnAst.AcnReferenceToEnumerated) (defOrRef:TypeDefinitionOrReference) (us:State) = let errCodeName = ToC ("ERR_ACN" + (codec.suffix.ToUpper()) + "_" + ((typeId.AcnAbsPath |> Seq.skip 1 |> Seq.StrJoin("-")).Replace("#","elm"))) let errCode, ns = getNextValidErrorCode us errCodeName None let td = lm.lg.getTypeDefinition (t.getType r).FT_TypeDefinition let typeDefinitionName = td.typeName - let funcBody = createEnumCommon r lm codec typeId t.enumerated defOrRef typeDefinitionName icdStgFileName None t.enumerated.acnMinSizeInBits t.enumerated.acnMaxSizeInBits None + let funcBody = createEnumCommon r deps lm codec typeId t.enumerated defOrRef typeDefinitionName icdStgFileName None t.enumerated.acnMinSizeInBits t.enumerated.acnMaxSizeInBits None (funcBody errCode), ns -let createRealFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Real) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = +let createRealFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Real) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = let Real_32_big_endian = lm.acn.Real_32_big_endian let Real_64_big_endian = lm.acn.Real_64_big_endian let Real_32_little_endian = lm.acn.Real_32_little_endian @@ -706,10 +707,10 @@ let createRealFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonT match ST.lang with | Scala -> ["extern"] | _ -> [] - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations annots us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations annots us -let createObjectIdentifierFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.ObjectIdentifier) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = +let createObjectIdentifierFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.ObjectIdentifier) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = let funcBodyContent = uperFunc.funcBody_e errCode nestingScope p true |> Option.map(fun x -> x.funcBody, x.errCodes, x.resultExpr, x.typeEncodingKind, x.auxiliaries) @@ -721,10 +722,10 @@ let createObjectIdentifierFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (c let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; auxiliaries=auxiliaries; icdResult = Some icd}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us -let createTimeTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.TimeType) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = +let createTimeTypeFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.TimeType) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = let funcBodyContent = uperFunc.funcBody_e errCode nestingScope p true |> Option.map(fun x -> x.funcBody, x.errCodes, x.resultExpr, x.typeEncodingKind, x.auxiliaries) @@ -736,14 +737,14 @@ let createTimeTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None;} Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; auxiliaries=auxiliaries; icdResult = Some icd}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us let nestChildItems (lm:LanguageMacros) (codec:CommonTypes.Codec) children = DAstUtilFunctions.nestItems lm.isvalid.JoinItems2 children -let createAcnBooleanFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (o:Asn1AcnAst.AcnBoolean) (us:State) = +let createAcnBooleanFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (o:Asn1AcnAst.AcnBoolean) (us:State) = let errCodeName = ToC ("ERR_ACN" + (codec.suffix.ToUpper()) + "_" + ((typeId.AcnAbsPath |> Seq.skip 1 |> Seq.StrJoin("-")).Replace("#","elm"))) let errCode, ns = getNextValidErrorCode us errCodeName None @@ -758,7 +759,7 @@ let createAcnBooleanFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C Some {AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnBooleanEncodingType None); auxiliaries=[]; icdResult = Some icd} (funcBody errCode), ns -let createBooleanFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Boolean) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : AcnFunction option) (isValidFunc: IsValidFunction option) (us:State) = +let createBooleanFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Boolean) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : AcnFunction option) (isValidFunc: IsValidFunction option) (us:State) = let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = let Boolean = lm.uper.Boolean let acnBoolean = lm.acn.Boolean @@ -800,10 +801,10 @@ let createBooleanFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Comm let aux = lm.lg.generateBooleanAuxiliaries r ACN t o nestingScope p.arg codec {AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnBooleanEncodingType o.acnProperties.encodingPattern); auxiliaries=aux; icdResult = Some icd} let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> Some (funcBody e acnArgs nestingScope p), us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> Some (funcBody e acnArgs nestingScope p), us) (fun atc -> true) soSparkAnnotations [] us -let createAcnNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (o:Asn1AcnAst.AcnNullType) (us:State) = +let createAcnNullTypeFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (o:Asn1AcnAst.AcnNullType) (us:State) = let errCodeName = ToC ("ERR_ACN" + (codec.suffix.ToUpper()) + "_" + ((typeId.AcnAbsPath |> Seq.skip 1 |> Seq.StrJoin("-")).Replace("#","elm"))) let errCode, ns = getNextValidErrorCode us errCodeName None @@ -831,7 +832,7 @@ let createAcnNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec: Some ({AcnFuncBodyResult.funcBody = ret; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnNullEncodingType (Some encPattern)); auxiliaries=[]; icdResult = Some icd}) (funcBody errCode), ns -let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.NullType) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (us:State) = +let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.NullType) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (us:State) = let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = let pp, resultExpr = adaptArgument lm codec p let nullType = lm.acn.Null_pattern @@ -862,7 +863,7 @@ let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} Some ({AcnFuncBodyResult.funcBody = ret; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= lm.lg.acn.null_valIsUnReferenced; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnNullEncodingType (Some encPattern)); auxiliaries=aux; icdResult = Some icd}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us let getExternalField0 (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) asn1TypeIdWithDependency func1 = @@ -977,7 +978,7 @@ let createStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVars; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnStringEncodingType o.acnEncodingClass); auxiliaries=auxiliaries; icdResult = Some icd} ), ns let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p us) (fun atc -> true) soSparkAnnotations [] us let createAcnStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (typeId : ReferenceToType) (t:Asn1AcnAst.AcnReferenceToIA5String) (us:State) = @@ -1166,7 +1167,7 @@ let createOctetStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserte Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnOctetStringEncodingType o.acnEncodingClass); auxiliaries=[]; icdResult = Some icd}) let soSparkAnnotations = Some (sparkAnnotations lm td codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us let createBitStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.BitString) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = let nAlignSize = 0I; @@ -1217,7 +1218,7 @@ let createBitStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnBitStringEncodingType o.acnEncodingClass); auxiliaries=[]; icdResult = Some icd}) let soSparkAnnotations = Some(sparkAnnotations lm td codec) - createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.SequenceOf) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (child:Asn1Type) (us:State) = let oct_sqf_null_terminated = lm.acn.oct_sqf_null_terminated @@ -1383,7 +1384,7 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCode::childErrCodes; localVariables = lv2@lv@localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=None; typeEncodingKind=typeEncodingKind; auxiliaries=internalItem.auxiliaries; icdResult = Some icd}) ret,ns let soSparkAnnotations = Some(sparkAnnotations lm td codec) - createAcnFunction r lm codec t typeDefinition isValidFunc funcBody (fun atc -> true) soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc funcBody (fun atc -> true) soSparkAnnotations [] us let initExpr (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (t: Asn1AcnAst.AcnInsertedType): string = match t with @@ -2205,7 +2206,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi | None -> false) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc funcBody isTestVaseValid soSparkAnnotations [] us + createAcnFunction r deps lm codec t typeDefinition isValidFunc funcBody isTestVaseValid soSparkAnnotations [] us @@ -2435,7 +2436,7 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - createAcnFunction r lm codec t typeDefinition isValidFunc funcBody (fun atc -> true) soSparkAnnotations [] us, ec + createAcnFunction r deps lm codec t typeDefinition isValidFunc funcBody (fun atc -> true) soSparkAnnotations [] us, ec let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.ReferenceType) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (baseType:Asn1Type) (us:State) = @@ -2527,7 +2528,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - let a, ns = createAcnFunction r lm codec t typeDefinition isValidFunc funcBody (fun atc -> true) soSparkAnnotations [] us + let a, ns = createAcnFunction r deps lm codec t typeDefinition isValidFunc funcBody (fun atc -> true) soSparkAnnotations [] us Some a, ns | Some encOptions -> @@ -2596,5 +2597,5 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ReferenceEncodingType baseTypeDefinitionName); auxiliaries=[]; icdResult = icd}) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) - let a,b = createAcnFunction r lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us + let a,b = createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us Some a, b diff --git a/BackendAst/DAstConstruction.fs b/BackendAst/DAstConstruction.fs index f57bea338..622f94680 100644 --- a/BackendAst/DAstConstruction.fs +++ b/BackendAst/DAstConstruction.fs @@ -46,18 +46,18 @@ let private createAcnChild (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps: let funcBodyEncode, ns1= match ch.Type with - | Asn1AcnAst.AcnInteger a -> DAstACN.createAcnIntegerFunction r lm Codec.Encode ch.id a us - | Asn1AcnAst.AcnBoolean a -> DAstACN.createAcnBooleanFunction r lm Codec.Encode ch.id a us - | Asn1AcnAst.AcnNullType a -> DAstACN.createAcnNullTypeFunction r lm Codec.Encode ch.id a us - | Asn1AcnAst.AcnReferenceToEnumerated a -> DAstACN.createAcnEnumeratedFunction r icdStgFileName lm Codec.Encode ch.id a (defOrRef r m a) us + | Asn1AcnAst.AcnInteger a -> DAstACN.createAcnIntegerFunction r deps lm Codec.Encode ch.id a us + | Asn1AcnAst.AcnBoolean a -> DAstACN.createAcnBooleanFunction r deps lm Codec.Encode ch.id a us + | Asn1AcnAst.AcnNullType a -> DAstACN.createAcnNullTypeFunction r deps lm Codec.Encode ch.id a us + | Asn1AcnAst.AcnReferenceToEnumerated a -> DAstACN.createAcnEnumeratedFunction r deps icdStgFileName lm Codec.Encode ch.id a (defOrRef r m a) us | Asn1AcnAst.AcnReferenceToIA5String a -> DAstACN.createAcnStringFunction r deps lm Codec.Encode ch.id a us let funcBodyDecode, ns2 = match ch.Type with - | Asn1AcnAst.AcnInteger a -> DAstACN.createAcnIntegerFunction r lm Codec.Decode ch.id a ns1 - | Asn1AcnAst.AcnBoolean a -> DAstACN.createAcnBooleanFunction r lm Codec.Decode ch.id a ns1 - | Asn1AcnAst.AcnNullType a -> DAstACN.createAcnNullTypeFunction r lm Codec.Decode ch.id a ns1 - | Asn1AcnAst.AcnReferenceToEnumerated a -> DAstACN.createAcnEnumeratedFunction r icdStgFileName lm Codec.Decode ch.id a (defOrRef r m a) ns1 + | Asn1AcnAst.AcnInteger a -> DAstACN.createAcnIntegerFunction r deps lm Codec.Decode ch.id a ns1 + | Asn1AcnAst.AcnBoolean a -> DAstACN.createAcnBooleanFunction r deps lm Codec.Decode ch.id a ns1 + | Asn1AcnAst.AcnNullType a -> DAstACN.createAcnNullTypeFunction r deps lm Codec.Decode ch.id a ns1 + | Asn1AcnAst.AcnReferenceToEnumerated a -> DAstACN.createAcnEnumeratedFunction r deps icdStgFileName lm Codec.Decode ch.id a (defOrRef r m a) ns1 | Asn1AcnAst.AcnReferenceToIA5String a -> DAstACN.createAcnStringFunction r deps lm Codec.Decode ch.id a ns1 let funcUpdateStatement, ns3 = DAstACN.getUpdateFunctionUsedInEncoding r deps lm m ch.id ns2 @@ -106,15 +106,15 @@ let private createAcnChild (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps: type ParentInfoData = unit -let private createInteger (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Integer) (us:State) = +let private createInteger (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Integer) (us:State) = let defOrRef = TL "DAstTypeDefinition" (fun () -> DAstTypeDefinition.createInteger_u r lm t o us) let initFunction = TL "DAstInitialize" (fun () -> DAstInitialize.createIntegerInitFunc r lm t o defOrRef) let equalFunction = TL "DAstEqual" (fun () -> DAstEqual.createIntegerEqualFunction r lm t o defOrRef) let isValidFunction, s1 = TL "DastValidate2" (fun () -> DastValidate2.createIntegerFunction r lm t o defOrRef us) let uperEncFunction, s2 = TL "DAstUPer" (fun () -> DAstUPer.createIntegerFunction r lm Codec.Encode t o defOrRef None isValidFunction s1) let uperDecFunction, s3 = TL "DAstUPer" (fun () -> DAstUPer.createIntegerFunction r lm Codec.Decode t o defOrRef None isValidFunction s2) - let acnEncFunction, s4 = TL "DAstACN" (fun () -> DAstACN.createIntegerFunction r lm Codec.Encode t o defOrRef isValidFunction uperEncFunction s3) - let acnDecFunction, s5 = TL "DAstACN" (fun () -> DAstACN.createIntegerFunction r lm Codec.Decode t o defOrRef isValidFunction uperDecFunction s4) + let acnEncFunction, s4 = TL "DAstACN" (fun () -> DAstACN.createIntegerFunction r deps lm Codec.Encode t o defOrRef isValidFunction uperEncFunction s3) + let acnDecFunction, s5 = TL "DAstACN" (fun () -> DAstACN.createIntegerFunction r deps lm Codec.Decode t o defOrRef isValidFunction uperDecFunction s4) let uperEncDecTestFunc,s6 = EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5 let acnEncDecTestFunc ,s7 = EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6 @@ -148,7 +148,7 @@ let private createInteger (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1Acn } ((Integer ret),[]), s10 -let private createReal (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Real) (us:State) = +let private createReal (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Real) (us:State) = //let typeDefinition = DAstTypeDefinition.createReal r l t o us let defOrRef = DAstTypeDefinition.createReal_u r lm t o us let equalFunction = DAstEqual.createRealEqualFunction r lm t o defOrRef @@ -157,8 +157,8 @@ let private createReal (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst let isValidFunction, s1 = DastValidate2.createRealFunction r lm t o defOrRef us let uperEncFunction, s2 = DAstUPer.createRealFunction r lm Codec.Encode t o defOrRef None isValidFunction s1 let uperDecFunction, s3 = DAstUPer.createRealFunction r lm Codec.Decode t o defOrRef None isValidFunction s2 - let acnEncFunction, s4 = DAstACN.createRealFunction r lm Codec.Encode t o defOrRef isValidFunction uperEncFunction s3 - let acnDecFunction, s5 = DAstACN.createRealFunction r lm Codec.Decode t o defOrRef isValidFunction uperDecFunction s4 + let acnEncFunction, s4 = DAstACN.createRealFunction r deps lm Codec.Encode t o defOrRef isValidFunction uperEncFunction s3 + let acnDecFunction, s5 = DAstACN.createRealFunction r deps lm Codec.Decode t o defOrRef isValidFunction uperDecFunction s4 let uperEncDecTestFunc,s6 = EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5 let acnEncDecTestFunc ,s7 = EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6 @@ -285,15 +285,15 @@ let private createOctetString (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserte -let private createNullType (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.NullType) (us:State) = +let private createNullType (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.NullType) (us:State) = //let typeDefinition = DAstTypeDefinition.createNull r l t o us let defOrRef = DAstTypeDefinition.createNull_u r lm t o us let equalFunction = DAstEqual.createNullTypeEqualFunction r lm t o defOrRef let initFunction = DAstInitialize.createNullTypeInitFunc r lm t o defOrRef let uperEncFunction, s2 = DAstUPer.createNullTypeFunction r lm Codec.Encode t o defOrRef None None us let uperDecFunction, s3 = DAstUPer.createNullTypeFunction r lm Codec.Decode t o defOrRef None None s2 - let acnEncFunction, s4 = DAstACN.createNullTypeFunction r lm Codec.Encode t o defOrRef None s3 - let acnDecFunction, s5 = DAstACN.createNullTypeFunction r lm Codec.Decode t o defOrRef None s4 + let acnEncFunction, s4 = DAstACN.createNullTypeFunction r deps lm Codec.Encode t o defOrRef None s3 + let acnDecFunction, s5 = DAstACN.createNullTypeFunction r deps lm Codec.Decode t o defOrRef None s4 let uperEncDecTestFunc,s6 = EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction None (Some uperEncFunction) (Some uperDecFunction) s5 let acnEncDecTestFunc ,s7 = EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction None (Some acnEncFunction) (Some acnDecFunction) s6 let xerEncFunction, s8 = XER r (fun () -> DAstXer.createNullTypeFunction r lm Codec.Encode t o defOrRef None s7) s7 @@ -368,7 +368,7 @@ let private createBitString (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF ((BitString ret),newPrms), s10 -let private createBoolean (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Boolean) (us:State) = +let private createBoolean (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Boolean) (us:State) = //let typeDefinition = DAstTypeDefinition.createBoolean r l t o us let defOrRef = DAstTypeDefinition.createBoolean_u r lm t o us let equalFunction = DAstEqual.createBooleanEqualFunction r lm t o defOrRef @@ -377,8 +377,8 @@ let private createBoolean (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1Acn let isValidFunction, s1 = DastValidate2.createBoolFunction r lm t o defOrRef us let uperEncFunction, s2 = DAstUPer.createBooleanFunction r lm Codec.Encode t o defOrRef None isValidFunction s1 let uperDecFunction, s3 = DAstUPer.createBooleanFunction r lm Codec.Decode t o defOrRef None isValidFunction s2 - let acnEncFunction, s4 = DAstACN.createBooleanFunction r lm Codec.Encode t o defOrRef None isValidFunction s3 - let acnDecFunction, s5 = DAstACN.createBooleanFunction r lm Codec.Decode t o defOrRef None isValidFunction s4 + let acnEncFunction, s4 = DAstACN.createBooleanFunction r deps lm Codec.Encode t o defOrRef None isValidFunction s3 + let acnDecFunction, s5 = DAstACN.createBooleanFunction r deps lm Codec.Decode t o defOrRef None isValidFunction s4 let uperEncDecTestFunc,s6 = EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5 let acnEncDecTestFunc ,s7 = EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6 let automaticTestCasesValues = EncodeDecodeTestCase.BooleanAutomaticTestCaseValues r t o |> List.mapi (fun i x -> createAsn1ValueFromValueKind t i (BooleanValue x)) @@ -410,7 +410,7 @@ let private createBoolean (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1Acn ((Boolean ret),[]), s10 -let private createEnumerated (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (us:State) = +let private createEnumerated (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (us:State) = //let typeDefinition = DAstTypeDefinition.createEnumerated r l t o us let defOrRef = DAstTypeDefinition.createEnumerated_u r lm t o us let equalFunction = DAstEqual.createEnumeratedEqualFunction r lm t o defOrRef @@ -421,8 +421,8 @@ let private createEnumerated (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (lm: let uperEncFunction, s2 = DAstUPer.createEnumeratedFunction r lm Codec.Encode t o defOrRef None isValidFunction s1 let uperDecFunction, s3 = DAstUPer.createEnumeratedFunction r lm Codec.Decode t o defOrRef None isValidFunction s2 - let acnEncFunction, s4 = DAstACN.createEnumeratedFunction r icdStgFileName lm Codec.Encode t o defOrRef defOrRef isValidFunction uperEncFunction s3 - let acnDecFunction, s5 = DAstACN.createEnumeratedFunction r icdStgFileName lm Codec.Decode t o defOrRef defOrRef isValidFunction uperDecFunction s4 + let acnEncFunction, s4 = DAstACN.createEnumeratedFunction r deps icdStgFileName lm Codec.Encode t o defOrRef defOrRef isValidFunction uperEncFunction s3 + let acnDecFunction, s5 = DAstACN.createEnumeratedFunction r deps icdStgFileName lm Codec.Decode t o defOrRef defOrRef isValidFunction uperDecFunction s4 let uperEncDecTestFunc,s6 = EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5 let acnEncDecTestFunc ,s7 = EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6 @@ -462,7 +462,7 @@ let private createEnumerated (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (lm: -let private createObjectIdentifier (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.ObjectIdentifier) (us:State) = +let private createObjectIdentifier (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.ObjectIdentifier) (us:State) = //let typeDefinition = DAstTypeDefinition.createEnumerated r l t o us let defOrRef = DAstTypeDefinition.createObjectIdentifier_u r lm t o us let equalFunction = DAstEqual.createObjectIdentifierEqualFunction r lm t o defOrRef @@ -473,8 +473,8 @@ let private createObjectIdentifier (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) ( let uperEncFunction, s2 = DAstUPer.createObjectIdentifierFunction r lm Codec.Encode t o defOrRef None isValidFunction s1 let uperDecFunction, s3 = DAstUPer.createObjectIdentifierFunction r lm Codec.Decode t o defOrRef None isValidFunction s2 - let acnEncFunction, s4 = DAstACN.createObjectIdentifierFunction r lm Codec.Encode t o defOrRef isValidFunction uperEncFunction s3 - let acnDecFunction, s5 = DAstACN.createObjectIdentifierFunction r lm Codec.Decode t o defOrRef isValidFunction uperDecFunction s4 + let acnEncFunction, s4 = DAstACN.createObjectIdentifierFunction r deps lm Codec.Encode t o defOrRef isValidFunction uperEncFunction s3 + let acnDecFunction, s5 = DAstACN.createObjectIdentifierFunction r deps lm Codec.Decode t o defOrRef isValidFunction uperDecFunction s4 let uperEncDecTestFunc,s6 = EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5 let acnEncDecTestFunc ,s7 = EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6 @@ -508,7 +508,7 @@ let private createObjectIdentifier (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) ( ((ObjectIdentifier ret),[]), s10 -let private createTimeType (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.TimeType) (us:State) = +let private createTimeType (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.TimeType) (us:State) = let defOrRef = DAstTypeDefinition.createTimeType_u r lm t o us let equalFunction = DAstEqual.createTimeTypeEqualFunction r lm t o defOrRef @@ -519,8 +519,8 @@ let private createTimeType (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1Ac let uperEncFunction, s2 = DAstUPer.createTimeTypeFunction r lm Codec.Encode t o defOrRef None isValidFunction s1 let uperDecFunction, s3 = DAstUPer.createTimeTypeFunction r lm Codec.Decode t o defOrRef None isValidFunction s2 - let acnEncFunction, s4 = DAstACN.createTimeTypeFunction r lm Codec.Encode t o defOrRef isValidFunction uperEncFunction s3 - let acnDecFunction, s5 = DAstACN.createTimeTypeFunction r lm Codec.Decode t o defOrRef isValidFunction uperDecFunction s4 + let acnEncFunction, s4 = DAstACN.createTimeTypeFunction r deps lm Codec.Encode t o defOrRef isValidFunction uperEncFunction s3 + let acnDecFunction, s5 = DAstACN.createTimeTypeFunction r deps lm Codec.Decode t o defOrRef isValidFunction uperDecFunction s4 let uperEncDecTestFunc,s6 = EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5 let acnEncDecTestFunc ,s7 = EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6 @@ -795,8 +795,8 @@ let private createType (r:Asn1AcnAst.AstRoot) pi (t:Asn1AcnAst.Asn1Type) ((newKi let private mapType (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (t:Asn1AcnAst.Asn1Type, us:State) = Asn1Fold.foldType2 - (fun pi t ti us -> TL "createInteger" (fun () -> createInteger r lm m pi t ti us)) - (fun pi t ti us -> TL "createReal" (fun () -> createReal r lm m pi t ti us)) + (fun pi t ti us -> TL "createInteger" (fun () -> createInteger r deps lm m pi t ti us)) + (fun pi t ti us -> TL "createReal" (fun () -> createReal r deps lm m pi t ti us)) (fun pi t ti us -> let (strtype, prms), ns = TL "createStringType" (fun () -> createStringType r deps lm m pi t ti us) ((IA5String strtype),prms), ns) @@ -804,13 +804,13 @@ let private mapType (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps:Asn1Acn let (strtype, prms), ns = TL "createStringType" (fun () -> createStringType r deps lm m pi t ti us) ((IA5String strtype),prms), ns) (fun pi t ti us -> TL "createOctetString" (fun () -> createOctetString r deps lm m pi t ti us)) - (fun pi t ti us -> TL "createTimeType" (fun () -> createTimeType r lm m pi t ti us)) - (fun pi t ti us -> TL "createNullType" (fun () -> createNullType r lm m pi t ti us)) + (fun pi t ti us -> TL "createTimeType" (fun () -> createTimeType r deps lm m pi t ti us)) + (fun pi t ti us -> TL "createNullType" (fun () -> createNullType r deps lm m pi t ti us)) (fun pi t ti us -> TL "createBitString" (fun () -> createBitString r deps lm m pi t ti us)) - (fun pi t ti us -> TL "createBoolean" (fun () -> createBoolean r lm m pi t ti us)) - (fun pi t ti us -> TL "createEnumerated" (fun () -> createEnumerated r icdStgFileName lm m pi t ti us)) - (fun pi t ti us -> TL "createObjectIdentifier" (fun () -> createObjectIdentifier r lm m pi t ti us)) + (fun pi t ti us -> TL "createBoolean" (fun () -> createBoolean r deps lm m pi t ti us)) + (fun pi t ti us -> TL "createEnumerated" (fun () -> createEnumerated r icdStgFileName deps lm m pi t ti us)) + (fun pi t ti us -> TL "createObjectIdentifier" (fun () -> createObjectIdentifier r deps lm m pi t ti us)) (fun pi t ti newChild -> TL "createSequenceOf" (fun () -> createSequenceOf r deps lm m pi t ti newChild)) diff --git a/FrontEndAst/AcnCreateFromAntlr.fs b/FrontEndAst/AcnCreateFromAntlr.fs index 058ed9f79..3dd2a4b63 100644 --- a/FrontEndAst/AcnCreateFromAntlr.fs +++ b/FrontEndAst/AcnCreateFromAntlr.fs @@ -1378,14 +1378,17 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo let alignment = tryGetProp combinedProperties (fun x -> match x with ALIGNTONEXT e -> Some e | _ -> None) let acnMinSizeInBits, acnMaxSizeInBits = AcnEncodingClasses.GetChoiceEncodingClass mergedChildren alignment t.Location acnProperties - let detArg = acnType |> Option.bind (fun acnType -> acnType.acnProperties |> List.tryFindMap (fun prop -> - match prop with - | SIZE (GP_SizeDeterminant det) -> Some det - | _ -> None)) - let acnArgsSubsted = substAcnArgs acnParamSubst (acnArgs @ Option.toList detArg) + // TODO: Voir si cela ne prove pas de dup? + SequenceOf + // let detArg = acnType |> Option.bind (fun acnType -> acnType.acnProperties |> List.tryFindMap (fun prop -> + // match prop with + // | CHOICE_DETERMINANT det -> Some det + // | _ -> None)) + // let detArgSubsted = detArg |> Option.map (fun detArg -> substAcnArg acnParamSubst detArg) + let allAcnArgsSubsted = substAcnArgs acnParamSubst acnArgs + // let allAcnArgsSubsted = acnArgsSubsted @ (detArgSubsted |> Option.toList) Choice ({Choice.children = mergedChildren; acnProperties = acnProperties; cons=cons; withcons = wcons; uperMaxSizeInBits=indexSize+maxChildSize; uperMinSizeInBits=indexSize+minChildSize; acnMinSizeInBits =acnMinSizeInBits; - acnMaxSizeInBits=acnMaxSizeInBits; acnParameters = acnParameters; acnArgs = acnArgsSubsted; acnLoc = acnLoc; typeDef=typeDef}), chus + acnMaxSizeInBits=acnMaxSizeInBits; acnParameters = acnParameters; acnArgs = allAcnArgsSubsted; acnLoc = acnLoc; typeDef=typeDef}), chus | Asn1Ast.ReferenceType rf -> let acnArguments = acnArgs diff --git a/FrontEndAst/Asn1AcnAst.fs b/FrontEndAst/Asn1AcnAst.fs index 67a7b1898..0b10209f1 100644 --- a/FrontEndAst/Asn1AcnAst.fs +++ b/FrontEndAst/Asn1AcnAst.fs @@ -778,6 +778,7 @@ and Choice = { acnMaxSizeInBits : BigInteger acnMinSizeInBits : BigInteger acnParameters : AcnParameter list + // detArg : RelativePath option acnArgs : RelativePath list acnLoc : SrcLoc option typeDef : Map @@ -869,7 +870,7 @@ type AstRoot = { Files: list acnConstants : Map args:CommandLineSettings - acnParseResults:CommonTypes.AntlrParserResult list //used in ICDs to regenerate with collors the initial ACN input + acnParseResults:CommonTypes.AntlrParserResult list //used in ICDs to regenerate with colors the initial ACN input } @@ -912,7 +913,7 @@ type AcnDependency = { } type AcnInsertedFieldDependencies = { - acnDependencies : AcnDependency list + acnDependencies: AcnDependency list } diff --git a/FrontEndAst/Language.fs b/FrontEndAst/Language.fs index b90382d16..ed5ef871c 100644 --- a/FrontEndAst/Language.fs +++ b/FrontEndAst/Language.fs @@ -340,7 +340,7 @@ type ILangGeneric () = abstract member getBoardNames : Targets option -> string list abstract member getBoardDirs : Targets option -> string list - abstract member adaptAcnFuncBody: Asn1AcnAst.AstRoot -> AcnFuncBody -> isValidFuncName: string option -> Asn1AcnAst.Asn1Type -> Codec -> AcnFuncBody + abstract member adaptAcnFuncBody: Asn1AcnAst.AstRoot -> Asn1AcnAst.AcnInsertedFieldDependencies -> AcnFuncBody -> isValidFuncName: string option -> Asn1AcnAst.Asn1Type -> Codec -> AcnFuncBody abstract member generateSequenceAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> NestingScope -> Selection -> Codec -> string list abstract member generateIntegerAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Integer -> NestingScope -> Selection -> Codec -> string list abstract member generateBooleanAuxiliaries: Asn1AcnAst.AstRoot -> Asn1Encoding -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Boolean -> NestingScope -> Selection -> Codec -> string list @@ -380,7 +380,7 @@ type ILangGeneric () = default this.removeFunctionFromBody (sourceCode: string) (functionName: string) : string = sourceCode - default this.adaptAcnFuncBody _ f _ _ _ = f + default this.adaptAcnFuncBody _ _ f _ _ _ = f default this.generateSequenceAuxiliaries _ _ _ _ _ _ _ = [] default this.generateIntegerAuxiliaries _ _ _ _ _ _ _ = [] default this.generateBooleanAuxiliaries _ _ _ _ _ _ _ = [] diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index 260634d7d..82b59b6ad 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -351,7 +351,7 @@ type LangGeneric_scala() = let fds = generateEnumAuxiliaries r enc t enm nestingScope sel codec fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]) - override this.adaptAcnFuncBody (r: Asn1AcnAst.AstRoot) (funcBody: AcnFuncBody) (isValidFuncName: string option) (t: Asn1AcnAst.Asn1Type) (codec: Codec): AcnFuncBody = + override this.adaptAcnFuncBody (r: Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (funcBody: AcnFuncBody) (isValidFuncName: string option) (t: Asn1AcnAst.Asn1Type) (codec: Codec): AcnFuncBody = let shouldWrap = match t.Kind with | Asn1AcnAst.ReferenceType rt -> rt.hasExtraConstrainsOrChildrenOrAcnArgs @@ -380,7 +380,7 @@ type LangGeneric_scala() = match res with | Some res -> assert (not nestingScope.parents.IsEmpty) - let fds, call = wrapAcnFuncBody r t res.funcBody codec nestingScope p recP + let fds, call = wrapAcnFuncBody r deps t res.funcBody codec nestingScope p recP let fdsStr = fds |> List.map (fun fd -> show (FunDefTree fd)) let callStr = show (ExprTree call) // TODO: Hack to determine how to change the "result variable" diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 199155868..4102a7dbf 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -938,19 +938,20 @@ let rec firstOutermostSeqParent (parents: Asn1AcnAst.Asn1Type list): Asn1AcnAst. match parent.ActualType.Kind with | Sequence _ -> firstOutermostSeqParent rest |> Option.orElse (Some parent) | _ -> None + // We must provide all ACN dependencies to auxiliary decoding functions, which can come from two sources: // * From the current function (not the one we create but the one where we "stand") parameter list (forwarded dependency) // * In case this is a Sequence, the corresponding decoded ACN inserted field, stored in a local variable // In both cases, the variable names are the same, so we can (ab)use this fact and not worry from where // we got the ACN dependency. -let acnExternDependenciesVariableDecode (t: Asn1AcnAst.Asn1Type) (parents: Asn1AcnAst.Asn1Type list): Var list = +let acnExternDependenciesVariableDecode (t: Asn1AcnAst.Asn1Type) (parents: Asn1AcnAst.Asn1Type list): (Asn1AcnAst.Asn1Type * AcnChild * Var) list = t.externalDependencies |> List.map (fun dep -> let acnDep = tryFindFirstParentACNDependency parents dep assert acnDep.IsSome - let _, acnParam = acnDep.Value + let parent, acnParam = acnDep.Value let nme = ToC (acnParam.id.dropModule.AcnAbsPath.StrJoin "_") let tpe = fromAcnInsertedType acnParam.Type - {Var.name = nme; tpe = tpe} + parent, acnParam, {Var.name = nme; tpe = tpe} ) // For auxiliary encoding function, we sometimes need to encode bytes that depend on the determinant @@ -959,7 +960,7 @@ let acnExternDependenciesVariableDecode (t: Asn1AcnAst.Asn1Type) (parents: Asn1A // * Add the dependency as a parameter and forward it as needed. // * Refer to it from the outermost "pVal" (always in the function parameter) when possible // The second way is preferred but not always possible (e.g. if there is a Choice in the path), -// we cannot access the field pass the choice since we need to pattern match). +// we cannot access the field past the choice since we need to pattern match). let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: NestingScope): Var option = let rec allDependenciesExcept (t: Asn1AcnAst.Asn1Type) (avoid: ReferenceToType): RelativePath list = if t.id = avoid then [] @@ -1383,7 +1384,7 @@ let generatePrefixLemma (enc: Asn1Encoding) let paramsAcn, acnTps = if isTopLevel then [], [] else - let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) + let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) |> List.map (fun (_, _, v) -> v) let acns = collectNestedAcnChildren t.Kind let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) paramsAcn, acnTps @@ -1418,7 +1419,7 @@ let seqDecodeMiscData (allParents: Asn1AcnAst.Asn1Type list) let elemTpe = fromAsn1TypeKind t.Kind let acns, paramsAcn = let acns = fun () -> collectNestedAcnChildren t.Kind - let paramAcns = fun () -> acnExternDependenciesVariableDecode t allParents + let paramAcns = fun () -> acnExternDependenciesVariableDecode t allParents |> List.map (fun (_, _, v) -> v) // Top-level definitions do not return ACNs (and can't have parameter ACNs as well) if allParents.IsEmpty then [], [] else @@ -1668,7 +1669,7 @@ let generatePrefixLemmaSequenceOfLike (enc: Asn1Encoding) let baseId = if isTopLevel then t.FT_TypeDefinition.[Scala].typeName else ToC t.id.dropModule.AsString - let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) + let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) |> List.map (fun (_, _, v) -> v) let acns = collectNestedAcnChildren t.Kind let acnTps = acns |> List.map (fun acn -> fromAcnInsertedType acn.Type) baseId, paramsAcn, acnTps @@ -2268,6 +2269,7 @@ let generatePrefixLemmaSequence (enc: Asn1Encoding) let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) + (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (t: Asn1AcnAst.Asn1Type) (body: string) (codec: Codec) @@ -2287,7 +2289,8 @@ let wrapAcnFuncBody (r: Asn1AcnAst.AstRoot) // Computing external ACN dependencies for decoding // We also pass them to the encoding function because its postcondition // refers to the decoding function, which needs them - let paramsAcn = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) + let paramsAcnInfo = acnExternDependenciesVariableDecode t (nestingScope.parents |> List.map snd) + let paramsAcn = paramsAcnInfo |> List.map (fun (_, _, v) -> v) // All ACN fields present in this SEQUENCE, including nested ones // Encoding functions will return them so that we can refer to them in the postcondition when calling the decoding function let acns = collectNestedAcnChildren t.Kind @@ -3215,8 +3218,8 @@ let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc // The `existVar` does not exist for always present/absent let existVar = soc.existVar |> Option.map (fun v -> {Var.name = v; tpe = BooleanType}) let baseId = $"{ToC soc.child.Type.id.dropModule.AsString}_Optional" - - let paramsAcn = acnExternDependenciesVariableDecode soc.child.toAsn1AcnAst.Type (soc.nestingScope.parents |> List.map snd) + // TODO: paramAcn comme wrapAcnFuncBody + let paramsAcn = acnExternDependenciesVariableDecode soc.child.toAsn1AcnAst.Type (soc.nestingScope.parents |> List.map snd) |> List.map (fun (_, _, v) -> v) let mkSizeExpr = fun v1 c1 -> optionalSizeExpr soc.child.toAsn1AcnAst (Var v1) (bitIndexACN (Var c1)) 0I 0I let elemTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind let tpe = optionMutTpe elemTpe @@ -3343,7 +3346,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc // Computing external ACN dependencies for decoding // We also pass them to the encoding function because its postcondition // refers to the decoding function, which needs them - let paramsAcn = acnExternDependenciesVariableDecode soc.child.Type.toAsn1AcnAst (soc.nestingScope.parents |> List.map snd) + let paramsAcn = acnExternDependenciesVariableDecode soc.child.Type.toAsn1AcnAst (soc.nestingScope.parents |> List.map snd) |> List.map (fun (_, _, v) -> v) match codec with | Encode -> From fcebb1df4e146ecfcb56c6fc1e3de4ee81007b28 Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Sat, 7 Sep 2024 17:22:28 +0300 Subject: [PATCH 34/35] Do not generate lemmas for encodings other than ACN, dedup dependencies --- StgScala/ProofGen.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 4102a7dbf..9a96b2f46 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -952,7 +952,7 @@ let acnExternDependenciesVariableDecode (t: Asn1AcnAst.Asn1Type) (parents: Asn1A let nme = ToC (acnParam.id.dropModule.AcnAbsPath.StrJoin "_") let tpe = fromAcnInsertedType acnParam.Type parent, acnParam, {Var.name = nme; tpe = tpe} - ) + ) |> List.distinctBy (fun (_, _, v) -> v) // For auxiliary encoding function, we sometimes need to encode bytes that depend on the determinant // of a field that is outside of the current encoding function. We therefore need to somehow refer to it. @@ -3209,7 +3209,7 @@ let generateSequenceOfLikeAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding } [fd; fdWrapper; fdWrapperPure], fdWrapperCall let prefixLemma = - if r.args.stainlessInvertibility then + if enc = ACN && r.args.stainlessInvertibility then [generatePrefixLemmaSequenceOfLike enc pg.t pg.nestingScope sqf] else [] returnedFds @ prefixLemma, auxCall @@ -3471,7 +3471,7 @@ let generateOptionalAuxiliaries (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc body = pureBody } let prefixLemma = - if r.args.stainlessInvertibility then + if enc = ACN && r.args.stainlessInvertibility then [generateOptionalPrefixLemma r enc soc] else [] [fd; fdPure] @ prefixLemma, ret From af4ddef2cdc09c9f23c66f9a29df6d97cdc31fb6 Mon Sep 17 00:00:00 2001 From: Mario Bucev Date: Sun, 8 Sep 2024 12:01:45 +0300 Subject: [PATCH 35/35] Fix reference to prefix lemma for 'PositiveInteger_ConstSize' --- asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index b2f27174a..3e1095abe 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -90,7 +90,7 @@ object ACN { val (acn2Res, l2) = acn2Reset.dec_Int_PositiveInteger_ConstSize_pure(nBits) { - BitStream.readNLeastSignificantBitsPrefixLemma(acn1.base.bitStream, acn2.base.bitStream, nBits) + BitStream.readNLSBBitsMSBFirstPrefixLemma(acn1.base.bitStream, acn2.base.bitStream, nBits) }.ensuring { _ => acn1Res.base.bitStream.bitIndex == acn2Res.base.bitStream.bitIndex && l1 == l2 }