diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index 29a45a38b..32c7f8851 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 @@ -236,6 +237,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 +274,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 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 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 @@ -286,8 +288,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 @@ -327,7 +329,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])} @@ -482,7 +485,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 @@ -498,7 +500,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 @@ -520,7 +522,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 @@ -535,23 +537,19 @@ 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 r ACN t o nestingScope p.arg codec + {res with auxiliaries = res.auxiliaries @ aux}) - 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 soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) + 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 = - 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) = @@ -567,7 +565,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 @@ -639,22 +637,31 @@ 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 funcBody = 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) + (p: CallerScope) = + let res = funcBodyOrig errCode acnArgs nestingScope p + res |> Option.map (fun res -> + 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) - 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 @@ -691,10 +698,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) @@ -706,10 +713,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) @@ -721,14 +728,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 @@ -743,7 +750,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 @@ -782,14 +789,13 @@ 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 - + 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 @@ -799,55 +805,60 @@ 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)); 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 + let aux = lm.lg.generateNullTypeAuxiliaries r 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 = + 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)); 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 + 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 = @@ -962,7 +973,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) = @@ -1015,7 +1026,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 (typeId, t) + acnOuterMaxSize = nestingScope.acnOuterMaxSize uperOuterMaxSize = nestingScope.uperOuterMaxSize nestingLevel = nestingScope.nestingLevel nestingIx = nestingScope.nestingIx @@ -1033,7 +1045,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 @@ -1150,7 +1162,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; @@ -1201,7 +1213,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 @@ -1269,7 +1281,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 @@ -1286,7 +1299,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 @@ -1366,7 +1379,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 @@ -1704,7 +1717,7 @@ type private SequenceChildResult = { props: SequenceChildProps typeKindEncoding: TypeEncodingKind option auxiliaries: 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 @@ -1804,47 +1817,49 @@ 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 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 + let funcBody (us:State) (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = @@ -2031,16 +2046,16 @@ 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 = []} 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 res = {stmts=[stmts]; resultExpr=childResultExpr; existVar=existVar; props=props; typeKindEncoding=tpeKind; auxiliaries=auxiliaries @ optAux; icdComments=[]} + let props = {info=childInfo.toAsn1AcnAst; sel=childSel; uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits} + let icdResult = icd_asn1_child child stmts.icdComments + let res = {stmts=[stmts]; resultExpr=childResultExpr; existVar=existVar; props=props; typeKindEncoding=tpeKind; auxiliaries=auxiliaries @ optAux; icdResult=icdResult} let newAcc = {us=ns3; childIx=s.childIx + 1I; uperAccBits=s.uperAccBits + child.uperMaxSizeInBits; acnAccBits=s.acnAccBits + child.acnMaxSizeInBits} res, newAcc | AcnChild acnChild -> @@ -2084,9 +2099,9 @@ 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 res = {stmts=stmts; resultExpr=None; existVar=None; props=props; typeKindEncoding=childTpeKind; icdComments=icdComments; auxiliaries=auxiliaries} + let props = {info=childInfo.toAsn1AcnAst; sel=childP.arg; uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits} + let icdResult = icd_acn_child acnChild icdComments + let res = {stmts=stmts; resultExpr=None; existVar=None; props=props; typeKindEncoding=childTpeKind; auxiliaries=auxiliaries; 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. @@ -2111,42 +2126,17 @@ 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) 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) @@ -2170,9 +2160,17 @@ 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 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 + 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} + match existsAcnChildWithNoUpdates with | [] -> match seqContent with @@ -2183,9 +2181,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 = @@ -2214,7 +2212,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 @@ -2436,14 +2434,15 @@ 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 - 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 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 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) = @@ -2451,12 +2450,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 @@ -2535,7 +2537,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 -> @@ -2604,5 +2606,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/BackendAst/DAstUPer.fs b/BackendAst/DAstUPer.fs index 673738438..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)) @@ -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 @@ -473,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 @@ -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 @@ -633,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 @@ -753,8 +755,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,19 +804,16 @@ 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 - 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) @@ -908,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/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/BackendAst/GenerateAcnIcd.fs b/BackendAst/GenerateAcnIcd.fs index 6fdf0bfd9..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,10 +692,33 @@ let PrintTasses2 stgFileName (r:AstRoot) : string list = | None -> None) |> Seq.toList - - -let PrintAsn1FileInColorizedHtml (stgFileName:string) (r:AstRoot) (f:Asn1File) = +let printTasses3 stgFileName (r:DAst.AstRoot) : (string list)*(string list) = + let pdus = r.args.icdPdus |> Option.map Set.ofList + 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 |> @@ -701,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) @@ -744,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 @@ -769,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 = PrintTasses2 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/CommonTypes/CommonTypes.fs b/CommonTypes/CommonTypes.fs index e1cb35903..2f2d48b4b 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 @@ -924,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/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 ..) 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 ..) diff --git a/FrontEndAst/AcnCreateFromAntlr.fs b/FrontEndAst/AcnCreateFromAntlr.fs index bf07160ab..3dd2a4b63 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 = [] @@ -1350,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 780656456..0b10209f1 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 = @@ -774,6 +778,7 @@ and Choice = { acnMaxSizeInBits : BigInteger acnMinSizeInBits : BigInteger acnParameters : AcnParameter list + // detArg : RelativePath option acnArgs : RelativePath list acnLoc : SrcLoc option typeDef : Map @@ -819,9 +824,9 @@ and ReferenceType = { refCons : AnyConstraint list } -type Asn1AcnTypeKind = +type Asn1AcnType = | Acn of AcnInsertedType - | Asn1 of Asn1TypeKind + | Asn1 of Asn1Type type TypeAssignment = { Name:StringLoc @@ -865,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 } @@ -908,7 +913,7 @@ type AcnDependency = { } type AcnInsertedFieldDependencies = { - acnDependencies : AcnDependency list + acnDependencies: AcnDependency list } 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/FrontEndAst/DAst.fs b/FrontEndAst/DAst.fs index ed3ca0802..482fb679c 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 } @@ -993,7 +994,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 3f7027348..ed5ef871c 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 @@ -175,8 +170,13 @@ with | SqOf sqf -> sqf.isFixedSize | StrType st -> st.isFixedSize +type Asn1TypeOrAcnRefIA5 = +| Asn1 of Asn1AcnAst.Asn1Type +| AcnRefIA5 of ReferenceToType * Asn1AcnAst.AcnReferenceToIA5String + // TODO: rename type SequenceOfLikeProofGen = { + t: Asn1TypeOrAcnRefIA5 acnOuterMaxSize: bigint uperOuterMaxSize: bigint nestingLevel: bigint @@ -340,16 +340,22 @@ 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 generateSequenceOfLikeAuxiliaries: Asn1Encoding -> SequenceOfLike -> SequenceOfLikeProofGen -> Codec -> string list * string option - // TODO: Bad name - abstract member generateOptionalAuxiliaries: Asn1Encoding -> SequenceOptionalChild -> Codec -> string list * string - 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 -> 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 + 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 @@ -374,17 +380,24 @@ type ILangGeneric () = default this.removeFunctionFromBody (sourceCode: string) (functionName: string) : string = sourceCode - default this.adaptAcnFuncBody f _ _ _ = f - default this.generateSequenceOfLikeAuxiliaries _ _ _ _ = [], None - default this.generateOptionalAuxiliaries _ soc _ = + 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 [], soc.childBody {soc.p with arg = soc.p.arg.dropLast} soc.existVar - 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 7ba6db19a..82b59b6ad 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -318,16 +318,40 @@ type LangGeneric_scala() = override this.bitStringValueToByteArray (v : BitStringValue) = FsUtils.bitStringValueToByteArray (StringLoc.ByValue v) - 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.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 (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.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)) - 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.adaptAcnFuncBody (funcBody: AcnFuncBody) (isValidFuncName: string option) (t: Asn1AcnAst.Asn1Type) (codec: Codec): AcnFuncBody = + 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 (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 (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 (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 @@ -356,61 +380,54 @@ 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 r deps 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 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) = - 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)) - - override this.generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec): string list = - generateSequenceChildProof 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.generatePostcond (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (funcNameBase: string) (p: CallerScope) (t: Asn1AcnAst.Asn1Type) (codec: Codec) = + match enc with + | ACN -> + let errTpe = IntegerType Int + let postcondExpr = + match codec with + | Encode -> + 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 = eitherMutTpe errTpe (fromAsn1TypeKind t.Kind)} + generateDecodePostcondExpr r t resPostcond + Some (show (ExprTree postcondExpr)) + | _ -> Some (show (ExprTree (BoolLit true))) + + 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 (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/ProofAst.fs b/StgScala/ProofAst.fs index 367f86928..0e467b518 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 @@ -116,7 +118,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 +144,7 @@ and FunctionCall = { id: Identifier tps: Type list args: Expr list + parameterless: bool } and ApplyLetRec = { id: Identifier @@ -149,6 +154,7 @@ and MethodCall = { recv: Expr id: Identifier args: Expr list + parameterless: bool } and IfExpr = { cond: Expr @@ -191,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 @@ -271,7 +281,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" @@ -301,70 +312,101 @@ 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 = []} 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 iapply (list: Expr) (ix: Expr): Expr = MethodCall {recv = list; id = "iapply"; args = [ix]} - -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 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 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]; parameterless = true} + +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 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 = []} +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 -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 = []} + +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) @@ -470,7 +512,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,48 +571,84 @@ 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 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 selBitStream (recv: Expr): Expr = FieldSelect (selBase recv, "bitStream") +let selBitStreamCodec (recv: Expr): Expr = FieldSelect (recv, "bitStream") -let selBuf (recv: Expr): Expr = FieldSelect (selBase recv, "buf") +let selBitStreamACN (recv: Expr): Expr = FieldSelect (selBaseACN recv, "bitStream") -let selBufLength (recv: Expr): Expr = ArrayLength (selBuf recv) +let selBufBitStream (recv: Expr): Expr = FieldSelect (recv, "buf") -let selCurrentByteACN (recv: Expr): Expr = FieldSelect (selBitStream recv, "currentByte") +let selBufCodec (recv: Expr): Expr = FieldSelect (selBitStreamCodec recv, "buf") -let selCurrentBitACN (recv: Expr): Expr = FieldSelect (selBitStream recv, "currentBit") +let selBufACN (recv: Expr): Expr = FieldSelect (selBaseACN recv, "buf") -let bitIndexACN (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStream recv; args = [] } +let selBufLengthBitStream (recv: Expr): Expr = ArrayLength recv -let resetAtACN (recv: Expr) (arg: Expr): Expr = MethodCall { id = "resetAt"; recv = recv; args = [arg] } +let selBufLengthCodec (recv: Expr): Expr = ArrayLength (selBufCodec recv) -let invariant (recv: Expr): Expr = FunctionCall { prefix = [bitStreamId]; id = "invariant"; tps = []; args = [selCurrentBitACN recv; selCurrentByteACN recv; selBufLength recv] } +let selBufLengthACN (recv: Expr): Expr = ArrayLength (selBufACN recv) -let getBitCountUnsigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetBitCountUnsigned"; tps = []; args = [arg] } +let selCurrentByteACN (recv: Expr): Expr = FieldSelect (selBitStreamACN recv, "currentByte") -let validateOffsetBitsACN (recv: Expr) (offset: Expr): Expr = MethodCall { id = "validate_offset_bits"; recv = selBitStream recv; args = [offset] } +let selCurrentBitACN (recv: Expr): Expr = FieldSelect (selBitStreamACN recv, "currentBit") -let isPrefixOfACN (recv: Expr) (other: Expr): Expr = MethodCall { id = "isPrefixOf"; recv = selBitStream recv; args = [selBitStream other] } +let bitIndexBitStream (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = recv; args = []; parameterless = true } -let callSize (recv: Expr) (offset: Expr): Expr = MethodCall { id = "size"; recv = recv; args = [offset] } +let bitIndexCodec (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStreamCodec recv; args = []; parameterless = true } -// let sizeRange (recv: Expr) (offset: Expr) (from: Expr) (tto: Expr): Expr = MethodCall { id = "sizeRange"; recv = recv; args = [offset; from; tto] } +let bitIndexACN (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStreamACN recv; args = []; parameterless = true } -let getLengthForEncodingSigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetLengthForEncodingSigned"; tps = []; 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]; 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 } + +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 = selBitStreamACN recv; args = [selBitStreamACN other]; parameterless = true } + +let callSize (recv: Expr) (offset: Expr): Expr = MethodCall { id = "size"; recv = recv; args = [offset]; parameterless = true } + +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 } 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]; parameterless = true} + +let alignedToDWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToDWord"; tps = []; args = [bits]; parameterless = true} -let alignedToWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToWord"; tps = []; args = [bits]} +let codecWrapper (bitstream: Expr): Expr = ClassCtor {ct = codecClsTpe; args = [bitstream]} -let alignedToDWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToDWord"; tps = []; args = [bits]} +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 = @@ -580,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]} +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]} +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]} +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 @@ -593,90 +677,96 @@ 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 = [selBitStream b] } +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 = [selBitStream b1; selBitStream b2; selBitStream b3] } +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] } + 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]; 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 = @@ -692,16 +782,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}" @@ -710,13 +800,13 @@ 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 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 @@ -860,7 +950,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 @@ -1046,13 +1139,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) @@ -1090,7 +1183,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 @@ -1171,10 +1264,24 @@ 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" + | _ when from = tto -> e2 + | _ -> 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 c4cb27e4e..9a96b2f46 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 -> @@ -155,7 +157,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? @@ -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) @@ -434,7 +436,23 @@ 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 (recv: Expr) = + match child.Type.Kind with + | Choice _ | Sequence _ | SequenceOf _ -> + {bdgs = []; resSize = callSize recv offset} + | _ -> asn1SizeExpr child.Type.acnAlignment child.Type.Kind recv offset nestingLevel nestingIx + match child.Optionality with + | 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) @@ -452,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 = @@ -545,7 +563,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 = @@ -554,6 +572,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 = @@ -664,6 +683,7 @@ let seqOfSizeFunDefs (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.SequenceOf): FunDe plus [Var from; int32lit 1I] Var tto ] + parameterless = true } let proofElsePart = mkBlock ([ elemSizeAssert elemSizeOffVar @@ -691,7 +711,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 @@ -739,7 +759,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" @@ -753,10 +773,12 @@ 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) + (acnTps: Type list) (sz: SizeExprRes) (extraCondsPre: Expr list) (decodePureId: string) @@ -765,50 +787,97 @@ 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} - // TODO: Invertibility for ACN parameters as well + + 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 = resetAtACN (Var cdc) oldCdc - let lemmaCall = validateOffsetBitsContentIrrelevancyLemma (selBitStream oldCdc) (selBuf (Var cdc)) (longlit maxSize) - let r2Got = {Var.name = "r2Got"; tpe = ClassType codecTpe} - 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 - } - ]) - [prefix; block] + if not r.args.stainlessInvertibility then [] + else + let prefix = isPrefixOfACN oldCdc (Var cdc) + let r1 = {Var.name = "r1"; tpe = ClassType codecTpe} + 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 = 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 r2Got, Var cdc) + Equals (Var resGot, Var szRecv) + ] @ 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 + } + ] + } + let boundCall = + letsIn [r1, resetAtACN (Var cdc) oldCdc] ( + 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 (selBufLengthACN oldCdc, selBufLengthACN (Var cdc)) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) - ] (*@ invertibility*)) + ] @ 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 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) 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 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) @@ -820,9 +889,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) @@ -843,8 +912,8 @@ let generateDecodePostcondExpr (t: Asn1AcnAst.Asn1Type) (resPostcond: Var): Expr | NullType _ -> [] | _ -> let isValidFuncName = $"{t.FT_TypeDefinition.[Scala].typeName}_IsConstraintValid" - [isRightExpr (FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var szRecv]})] - generateDecodePostcondExprCommon resPostcond szRecv sz [] (strSize @ cstrIsValid) + [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 = match parents with @@ -853,7 +922,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 @@ -865,20 +938,21 @@ 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) (nestingScope: NestingScope): 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 (nestingScope.parents |> List.map snd) 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} + ) |> 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. @@ -886,7 +960,7 @@ let acnExternDependenciesVariableDecode (t: Asn1AcnAst.Asn1Type) (nestingScope: // * 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 [] @@ -901,6 +975,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 @@ -925,12 +1001,1281 @@ let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: let nme = seqParent.id.lastItem Some {Var.name = nme; tpe = tpe} -let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) +type PrimitiveDecodeInfo = { + prefix: string list + tpe: Type + decodeId: string + decodePureId: string + prefixLemmaId: string + extraConstArgs: Expr list +} +type ComposedDecodeInfo = { + decodeId: string + decodePureId: string + prefixLemmaId: string +} +type DecodeInfo = +| PrimitiveDecodeInfo of PrimitiveDecodeInfo +| ComposedDecodeInfo of ComposedDecodeInfo + +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; 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; 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; 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; 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; 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; 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; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | PositiveInteger_ConstSize bits -> + let baseId = "dec_Int_PositiveInteger_ConstSize" + {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; 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; 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; 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; 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; 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; 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; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | TwosComplement_ConstSize _ -> + let baseId = "dec_Int_TwosComplement_ConstSize" + {prefix = [acnId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}_pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + + | Integer_uPER -> failwith "UPER encoding selected for ACN integers?" + + | _ -> failwith $"TODO: {encCls}" + + let forIntClass (intCls:Asn1AcnAst.IntegerClass) (encCls: IntEncodingClass) (range: BigIntegerUperRange): PrimitiveDecodeInfo = + match encCls with + | Integer_uPER -> + match range with + | Full -> + let baseId = "decodeUnconstrainedWholeNumber" + {prefix = [codecId]; tpe = IntegerType Long; decodeId = baseId; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = []} + | PosInf min -> + let baseId = "decodeConstrainedPosWholeNumber" + {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; decodeId = baseId; decodePureId = $"{baseId}Pure"; prefixLemmaId = $"{baseId}_prefixLemma"; extraConstArgs = [ulonglit min; ulonglit max]} + else + let baseId = "decodeConstrainedWholeNumber" + {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); 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); decodeId = "readBitsVec"; decodePureId = "readBitsVecPure"; prefixLemmaId = "readBitsVecPrefixLemma"; extraConstArgs = [longlit bt.maxSize.acn]} + + if isOptional then + let baseId = $"{ToC id.dropModule.AsString}_Optional" + ComposedDecodeInfo {decodeId = $"{baseId}_ACN_Decode"; decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + else + match t with + | Asn1 t -> + match t.Kind with + | Integer int -> PrimitiveDecodeInfo (forIntClass int.intClass int.acnEncodingClass int.uperRange) + | BitString bt -> bitString bt + | OctetString ot -> octetString ot + | Boolean _ -> PrimitiveDecodeInfo booleanDecodeInfo + | ReferenceType rt -> + match rt.resolvedType.ActualType.Kind with + | BitString bt -> bitString bt + | IA5String str -> + match str.acnEncodingClass with + | Acn_Enc_String_uPER _ -> + let baseId = t.ActualType.FT_TypeDefinition.[Scala].typeName + 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); 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 + else t.ActualType.FT_TypeDefinition.[Scala].typeName + ComposedDecodeInfo {decodeId = $"{baseId}_ACN_Decode"; decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + | Sequence _ | SequenceOf _ | Choice _ -> + 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; 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 + | 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]; 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 {decodeId = $"{baseId}_ACN_Decode"; decodePureId = $"{baseId}_ACN_Decode_pure"; prefixLemmaId = $"{baseId}_prefixLemma"} + | _ -> + let baseId = "TODO_ACN_OTHER" + 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 + | 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 + 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 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 maxSizeExpr = longlit maxSize + let preconds = [ + 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 + (selBufACN (Var c1)) + (selBufACN (Var c2)) + (longlit 0I) + (plus [bitIndexACN (Var c1); Var sz]) + ) + ] + 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); 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); parameterless = true} + + 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)) + // 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 { + 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 = + MatchExpr { + scrut = Var decodingRes1 + cases = [ + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [subPat1] + } + rhs = prop + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = BoolLit true + } + ] + } + + 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 + annots = [GhostAnnot; Opaque; InlineOnce] + specs = preSpecs + postcond = Some ({Var.name = "_"; tpe = UnitType}, postcond) + returnTpe = UnitType + 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) |> List.map (fun (_, _, v) -> v) + 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 + +type SeqPrefixLemmaSubproofData = { + fd: FunDef + decInfo: DecodeInfo + elemTpe: Type + existArg: Expr option + 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 |> 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 + 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 = [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 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) |> List.map (fun (_, _, v) -> v) + 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) + (nestingScope: NestingScope) + (sq: Sequence): FunDef = + 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" + + // 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] @ (data.paramsAcn |> List.map Var); parameterless = true} + let body = letsIn [cpy, Snapshot (Var c)] (Unfold call) + { + FunDef.id = id; + prms = [] + annots = [] + specs = [] + postcond = None + returnTpe = UnitType + body = body + } + + 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 = + 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] + + // 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 (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])) + Precond (Equals (bitIndexACN (Var c1), bitIndexACN (Var c2))) + ] + + let slicedLemmaApp = (arrayBitRangesEqSlicedLemma + (selBufACN (Var c1)) + (selBufACN (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 (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) + 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 = $"{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}) + + 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 + // 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 childData.decInfo (Var c1) + selectCodecDecodeInfo childData.decInfo (Var c2Moved) + ] @ existArgList @ info.extraConstArgs + parameterless = true + } + 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 = [Var c1; Var c2Moved; Var childSize] @ existArgList @ (childData.common.paramsAcn |> List.map Var) + parameterless = true + } + + 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}" + prms = [] + annots = [Pure; Opaque; InlineOnce] + specs = [] + postcond = Some ({Var.name = "_"; tpe = UnitType}, BoolLit false) + returnTpe = UnitType + body = body + } + 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 childData.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 childData.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 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) -> + // 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 $"_{childData.name}" + | Some (AcnChild child) -> {bdgs = []; resSize = acnTypeSizeExpr child.Type} + | None -> + // 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 (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 + // 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; 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)) + )] + )) + ) + ) + )] + )) + ] + + let postcondExpr = + 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 @ [v1SizeVar, v1Size.resSize]) (And conds) + ) + ]) + ]) + ]) + + { + 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 + } + + 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 = + 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} + + 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 (proofId, childData) -> + let codecArgs = if ix = 0 then [] else [Var c1Prev; Var c2Prev] + 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 childData.decInfo with + | PrimitiveDecodeInfo info -> + 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 = + 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 + | Some (AcnChild c) -> mkAcnBinding childData.decInfo dec1 c + | Some (Asn1Child _) | None -> 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 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}) + let acnTps = acnVars |> List.map (fun v -> v.tpe) + 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 = [Var c1Prev] @ existArgList @ (childData.common.paramsAcn |> List.map Var) + parameterless = true + } + let dec2Call = FunctionCall { + prefix = []; id = info.decodePureId; tps = [] + 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 childData.decInfo dec1 c + | Some (Asn1Child _) | None -> mkBlock [] + else + // Only Asn1 children (in particular, sequences) may return ACN values + assert ( + match child with + | Some (AcnChild _) | None -> false + | Some (Asn1Child _) -> true + ) + 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 []) + + letTuple [c1; dec1] dec1Call (mkBlock [ + letTuple [c2; dec2] dec2Call acnBinding]) + + mkBlock (origCodecFnCheck @ [ + ApplyLetRec {id = proofId; args = codecArgs @ (childData.common.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 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.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)) + 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 (ixChecks :: decodedChecks :: acnChecks) + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = Check (BoolLit false) + } + ] + } + let body = mkBlock ([ + ApplyLetRec {id = bodyWithC1.id; args = []} + ] @ subproofCalls @ [ + ApplyLetRec {id = bodyWithC2.id; args = []} + finalCheck + ]) + let proof = LetRec {fds = originFns @ subproofFns; body = body} + + let rightMutCase = + 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 (r: Asn1AcnAst.AstRoot) + (deps: Asn1AcnAst.AcnInsertedFieldDependencies) + (t: Asn1AcnAst.Asn1Type) (body: string) (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} @@ -940,13 +2285,24 @@ 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 = 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 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 + 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]} + 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 []) @@ -954,13 +2310,13 @@ 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 decodePureId = $"{t.FT_TypeDefinition.[Scala].typeName}_ACN_Decode_pure" + let acnExtVars = acnExternDependenciesVariableEncode t nestingScope |> Option.toList + 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 = match t.Kind with @@ -970,44 +2326,64 @@ 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 r 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] @ acnVars @ [recPVal] + id = $"{baseId}_ACN_Encode" + prms = [cdc; outermostPVal] @ acnExtVars @ paramsAcn @ [recPVal] specs = precond annots = [Opaque; InlineOnce] postcond = Some (resPostcond, postcondExpr) - returnTpe = ClassType (eitherTpe errTpe retTpe) + returnTpe = eitherTpe errTpe retTpe body = body } 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 Var) @ [outerPVal]; parameterless = true} 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 = {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 + 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 + [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 fnRetTpe = eitherMutTpe errTpe retTpe 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 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 @@ -1017,17 +2393,15 @@ 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 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 resPostcond szRecv sz [] [cstrIsValid] + generateDecodePostcondExprCommon r 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)) + Equals (selBufACN oldCdc, selBufACN (Var cdc)) Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) cstrIsValid ]) @@ -1053,20 +2427,20 @@ 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] postcond = Some (resPostcond, postcondExpr) - returnTpe = ClassType (eitherMutTpe errTpe retTpe) + returnTpe = fnRetTpe body = body } 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]} + 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 @@ -1079,64 +2453,90 @@ 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); parameterless = true}] + (mkTuple [Var varCpy; Var varRes])) + { + FunDef.id = $"{baseId}_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 = - 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) + // Apparently, not needed? + (* + 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 = @@ -1144,11 +2544,11 @@ 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 = 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)])) @@ -1157,34 +2557,36 @@ let annotateSequenceChildStmt (enc: Asn1Encoding) (snapshots: Var list) (cdc: Va | _ -> [] let checks = offsetCheckOverall :: offsetCheckNested @ bufCheck @ offsetWidening let validateOffsetLemma = - if stmt.IsSome && ix < nbChildren - 1 then - [validateOffsetBitsIneqLemma (selBitStream (Var snap)) (selBitStream (Var cdc)) (longlit (outerMaxSize - offsetAcc + sz)) (longlit sz)] + if stmt.IsSome && ix < nbTotalChildren - 1 then + [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] - 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 [] + // 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 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 = +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 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)]) @@ -1197,100 +2599,7 @@ 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 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 = +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 @@ -1300,98 +2609,212 @@ let generateSequenceProof (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) (sq: Asn1 | 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 = [selBitStream cdcSnapReset; selBitStream (Var cdc)]} - ) - let childrenPrefixLemmaApps = sq.children |> List.indexed |> List.initial |> List.map readPrefixLemmaApp - - 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)) - ]) - ]) + | 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 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 nextC) (Var cdc) (Var nextSnap) + 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]))) - *) -let generateSequenceOfLikeProof (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = - None + 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] + else [] + +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 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 [] -let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): FunDef list * Expr = +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 (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 (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = + None + +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 @@ -1406,6 +2829,7 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) let outerSqf = if enc = ACN || codec = Decode then Var sqfVar else SelectionExpr (joinedSelection pg.cs.arg) + let collTpe = vecTpe elemTpe let td = match sqf with | SqOf sqf -> sqf.typeDef.[Scala].typeName @@ -1417,13 +2841,17 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) 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 @@ -1442,30 +2870,32 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) 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 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 | StrType _ -> @@ -1525,7 +2955,7 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) | 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 @@ -1555,17 +2985,19 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) 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 fnRetTpe = eitherMutTpe (IntegerType Int) collTpe let sqfVecVar = {Var.name = pg.cs.arg.asIdentifier; tpe = collTpe} let thnCase = let ret = @@ -1591,7 +3023,7 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) 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)] ( @@ -1614,7 +3046,7 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) | 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]) @@ -1637,109 +3069,268 @@ let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) 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]} + 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 []) let call = letsGhostIn [cdcBeforeLoop, Snapshot (Var cdc)] call - [fd], call + fd, call -let generateOptionalPrefixLemma (enc: Asn1Encoding) (soc: SequenceOptionalChild): FunDef = - let codecTpe = runtimeCodecTypeFor enc - let c1 = {Var.name = "c1"; tpe = ClassType codecTpe} - let c2 = {Var.name = "c2"; tpe = ClassType codecTpe} + //////////////////////////// + + 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 = 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 = {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]) + 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 enc = ACN && r.args.stainlessInvertibility then + [generatePrefixLemmaSequenceOfLike enc pg.t pg.nestingScope sqf] + else [] + returnedFds @ prefixLemma, auxCall + +let generateOptionalPrefixLemma (r: Asn1AcnAst.AstRoot) (enc: Asn1Encoding) (soc: SequenceOptionalChild): FunDef = // 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 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) - existVar |> - Option.map (fun exist -> IfExpr {cond = Var exist; thn = sizeExpr; els = longlit 0I}) |> - Option.defaultValue sizeExpr - ]) - ) - ] + let baseId = $"{ToC soc.child.Type.id.dropModule.AsString}_Optional" + // 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 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 tpe = optionMutTpe elemTpe + + 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.Kind.baseKind) 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 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 + } + mkBlock [ + unfoldC1 + unfoldC2 + MatchExpr { + scrut = Var data.decodingRes1 + cases = [ + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [data.subPat1] + } + rhs = proofRightMutCase + } + { + pattern = ADTPattern { + binder = None + id = leftMutId + subPatterns = [Wildcard None] + } + rhs = UnitLit + } + ] + } + ] - { - FunDef.id = $"{ToC soc.child.Type.id.dropModule.AsString}_prefixLemma" - prms = [c1; c2] @ (existVar |> Option.toList) - annots = [GhostAnnot; Pure; Opaque; InlineOnce] - specs = preSpecs - postcond = Some ({Var.name = "_"; tpe = UnitType}, postcond) - returnTpe = UnitType - body = body - } + generatePrefixLemmaCommon enc tpe soc.child.Type.toAsn1AcnAst.acnMaxSizeInBits baseId ((existVar |> Option.toList) @ paramsAcn) [] mkSizeExpr soc.nestingScope mkProof -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 - //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} 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 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" @@ -1750,26 +3341,23 @@ 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.parents |> List.map snd) |> List.map (fun (_, _, v) -> v) 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 -> 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 []) @@ -1779,17 +3367,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 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 = { FunDef.id = fnid - prms = [cdc; outermostPVal; childVar] + prms = [cdc; outermostPVal] @ acnExtVars @ paramsAcn @ [childVar] annots = [Opaque; InlineOnce] specs = validateOffsetBitCond postcond = Some (resPostcond, postcondExpr) @@ -1797,12 +3387,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 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 + [fd], call | Decode -> // The `existVar` does not exist for always present/absent @@ -1810,7 +3401,7 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) 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) @@ -1818,7 +3409,7 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) | 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 @@ -1835,15 +3426,14 @@ let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) 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 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 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,31 +3442,36 @@ 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); 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 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); parameterless = true}] (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 returnTpe = tupleType [ClassType codecTpe; fnRetTpe] body = pureBody } - let prefixLemma = generateOptionalPrefixLemma enc soc - [fd; fdPure], ret + let prefixLemma = + if enc = ACN && r.args.stainlessInvertibility then + [generateOptionalPrefixLemma r enc soc] + else [] + [fd; fdPure] @ prefixLemma, ret 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_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index 695de0620..d8316e9f7 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 = { @@ -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) @@ -229,22 +236,21 @@ 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 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, @@ -281,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 { _ => @@ -520,28 +526,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 @@ -673,6 +679,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) { @@ -840,7 +871,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 +1575,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) &&& @@ -2118,7 +2149,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) @@ -2534,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) )) @@ -2554,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) - @@ -2564,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 ebd73d886..e162e24bc 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 @@ -140,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 + } + } } /** @@ -150,8 +172,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 => _, withAlignedToByte => _, withAlignedToShort => _, withAlignedToInt => _, *} @ghost @pure @inline def resetAt(other: Codec): Codec = { @@ -161,13 +182,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)) } @@ -196,17 +217,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 - }*/ + } } /** @@ -216,7 +252,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)) @@ -267,7 +302,7 @@ case class Codec(bitStream: BitStream) { appendLSBBitsMSBFirst(encVal, nRangeBits) else ghostExpr { - lemmaIsPrefixRefl(bitStream) + BitStream.lemmaIsPrefixRefl(bitStream) } }.ensuring { _ => val w1 = old(this) @@ -276,7 +311,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 } @@ -313,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) = { @@ -352,28 +387,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 { - // 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) - 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 - }*/ + } } /** @@ -391,7 +427,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( @@ -487,6 +522,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 * @@ -500,21 +536,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. * @@ -542,14 +618,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 * @@ -576,6 +668,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 * */ @@ -590,13 +683,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) /** @@ -605,6 +703,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 @@ -626,31 +725,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) - validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) + BitStream.validateOffsetBitsContentIrrelevancyLemma(w1.bitStream, w2.bitStream.buf, nBits) val (r2Got, vGot) = r1.decodeUnconstrainedWholeNumberPure() - vGot == v && r2Got == r2 - }*/ + (vGot.isEmpty || vGot.get == v) && r2Got == r2 + } } /** @@ -660,9 +760,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)) @@ -709,6 +809,9 @@ case class Codec(bitStream: BitStream) { /** * Facade function for real encoding + * + * Unused in PUS-C + * * @param vValDouble real input in IEEE754 double format */ @extern @@ -760,6 +863,8 @@ case class Codec(bitStream: BitStream) { * |1|S|0|0|a|b|c|d| * +-+-+-+-+-+-+-+-+ * + * + * */ private def encodeRealBitString(vVal: Long): Unit = { // Require from CalculateMantissaAndExponent @@ -1071,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 @@ -2072,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 3cb66f74a..3e1095abe 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -26,8 +26,76 @@ object ACN { (ACN(Codec(r1)), ACN(Codec(r2))) } - // For showing invertibility of encoding - not fully integrated yet - /* + // TODO: Placeholder + 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 = { + 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.readNLSBBitsMSBFirstPrefixLemma(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 = { require(acn1.base.bufLength() == acn2.base.bufLength()) @@ -48,8 +116,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 +212,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 +276,27 @@ 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 } - }*/ + } + + // 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.* @@ -223,9 +311,19 @@ 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 + // @opaque @inlineOnce def enc_Int_PositiveInteger_ConstSize(intVal: ULong, encodedSizeInBits: Int): Unit = { require(encodedSizeInBits >= 0 && encodedSizeInBits <= 64) /* Get number of bits*/ @@ -238,16 +336,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,29 +377,29 @@ 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 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 = { @@ -310,15 +408,47 @@ 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 + + @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)) require(intVal <= 255) @@ -326,93 +456,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 - 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) - }*/ + } }.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 - 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) - }*/ + } }.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 - 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) - }*/ + } }.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 +555,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 - 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) - }*/ + } }.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 +584,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 - 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) - }*/ + } }.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 - 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) - }*/ + } }.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 +649,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) @@ -526,7 +662,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 +678,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 +693,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 +708,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 +723,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 +738,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 +760,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 = { @@ -680,7 +813,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) @@ -692,12 +825,12 @@ 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) - 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) @@ -742,39 +875,80 @@ 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 = { 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 = { @@ -828,6 +1002,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 @@ -836,6 +1017,14 @@ 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 @@ -843,6 +1032,14 @@ case class ACN(base: Codec) { 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 0L @@ -850,6 +1047,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 @@ -1128,6 +1333,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 +1359,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 +1711,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 +1730,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 +1902,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 +1934,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 +1998,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] = { @@ -1790,6 +2009,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) @@ -1816,7 +2045,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..96681193b 100644 --- a/asn1scala/stainless.conf +++ b/asn1scala/stainless.conf @@ -3,7 +3,7 @@ vc-cache = true # debug = ["smt"] -timeout = 1200 +timeout = 200 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_acn_used_fcts.sh b/asn1scala/verify_acn_used_fcts.sh new file mode 100755 index 000000000..9bb430113 --- /dev/null +++ b/asn1scala/verify_acn_used_fcts.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 diff --git a/asn1scc/Program.fs b/asn1scc/Program.fs index 08e5848a1..9d1dc492f 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 @@ -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. @@ -100,7 +101,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" @@ -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 @@ -315,7 +318,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) @@ -351,14 +360,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 =