diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index 09b6d17f6..29a45a38b 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -114,7 +114,7 @@ let handleSavePosition (funcBody: FuncBody) Some {bodyResult with funcBody = funcBodyStr} | None -> let funcBodyStr = savePositionStatement - Some {funcBody = funcBodyStr; errCodes =[]; localVariables = []; bValIsUnReferenced= true; bBsIsUnReferenced=false; resultExpr = None; typeEncodingKind = None; icdResult = None } + Some {funcBody = funcBodyStr; errCodes =[]; localVariables = []; bValIsUnReferenced= true; bBsIsUnReferenced=false; resultExpr = None; typeEncodingKind = None; auxiliaries = []; icdResult = None } newContent, ns1a newFuncBody @@ -150,7 +150,7 @@ let handleAlignmentForAsn1Types (r:Asn1AcnAst.AstRoot) Some {bodyResult with funcBody = funcBodyStr} | None -> let funcBodyStr = alignToNext "" alStr nAlignmentVal nestingScope.acnOffset (nestingScope.acnOuterMaxSize - nestingScope.acnOffset) (nestingScope.nestingLevel - 1I) nestingScope.nestingIx nestingScope.acnRelativeOffset codec - Some {funcBody = funcBodyStr; errCodes =[errCode]; localVariables = []; bValIsUnReferenced= true; bBsIsUnReferenced=false; resultExpr = None; typeEncodingKind = None; icdResult=None} + Some {funcBody = funcBodyStr; errCodes =[errCode]; localVariables = []; bValIsUnReferenced= true; bBsIsUnReferenced=false; resultExpr = None; typeEncodingKind = None; auxiliaries = []; icdResult=None} newContent, ns1a newFuncBody @@ -176,7 +176,7 @@ let handleAlignmentForAcnTypes (r:Asn1AcnAst.AstRoot) Some {bodyResult with funcBody = funcBodyStr} | None -> let funcBodyStr = alignToNext "" alStr nAlignmentVal nestingScope.acnOffset (nestingScope.acnOuterMaxSize - nestingScope.acnOffset) (nestingScope.nestingLevel - 1I) nestingScope.nestingIx nestingScope.acnRelativeOffset codec - Some {funcBody = funcBodyStr; errCodes =[]; localVariables = []; bValIsUnReferenced= true; bBsIsUnReferenced=false; resultExpr = None; typeEncodingKind = None; icdResult= None} + Some {funcBody = funcBodyStr; errCodes =[]; localVariables = []; bValIsUnReferenced= true; bBsIsUnReferenced=false; resultExpr = None; typeEncodingKind = None; auxiliaries = []; icdResult= None} newContent newFuncBody @@ -260,6 +260,7 @@ let private createAcnFunction (r: Asn1AcnAst.AstRoot) let nMaxBytesInACN = BigInteger (ceil ((double t.acnMaxSizeInBits)/8.0)) let nMinBytesInACN = BigInteger (ceil ((double t.acnMinSizeInBits)/8.0)) let soInitFuncName = getFuncNameGeneric typeDefinition (lm.init.methodNameSuffix()) + let isValidFuncName = match isValidFunc with None -> None | Some f -> f.funcName let EmitTypeAssignment_primitive = lm.acn.EmitTypeAssignment_primitive let EmitTypeAssignment_primitive_def = lm.acn.EmitTypeAssignment_primitive_def let EmitTypeAssignment_def_err_code = lm.acn.EmitTypeAssignment_def_err_code @@ -271,38 +272,30 @@ 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 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 p : CallerScope = lm.lg.getParamType t codec let varName = p.arg.receiverId let sStar = lm.lg.getStar p.arg - let isValidFuncName = match isValidFunc with None -> None | Some f -> f.funcName let sInitialExp = "" - let func, funcDef,icdResult, ns2 = + let func, funcDef, auxiliaries, icdResult, ns2 = match funcNameAndtasInfo with - | None -> - let precondAnnots = lm.lg.generatePrecond ACN t - let postcondAnnots = lm.lg.generatePostcond ACN funcNameBase p t codec - let content, ns1a = funcBody ns errCode [] (NestingScope.init t.acnMaxSizeInBits t.uperMaxSizeInBits) p - let icdResult = - match content with - | None -> None - | Some bodyResult -> bodyResult.icdResult - - None, None, icdResult, ns1a + | None -> None, None, [], None, ns | Some funcName -> - let precondAnnots = lm.lg.generatePrecond ACN t + let precondAnnots = lm.lg.generatePrecond ACN t codec let postcondAnnots = lm.lg.generatePostcond 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, icdResult = + 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 | None -> let emptyStatement = lm.lg.emptyStatement - emptyStatement, [], [], true, isValidFuncName.IsNone, None + emptyStatement, [], [], true, isValidFuncName.IsNone, [], None | Some bodyResult -> - bodyResult.funcBody, bodyResult.errCodes, bodyResult.localVariables, bodyResult.bBsIsUnReferenced, bodyResult.bValIsUnReferenced, bodyResult.icdResult + bodyResult.funcBody, bodyResult.errCodes, bodyResult.localVariables, bodyResult.bBsIsUnReferenced, bodyResult.bValIsUnReferenced, bodyResult.auxiliaries, bodyResult.icdResult let handleAcnParameter (p:AcnGenericTypes.AcnParameter) = let intType = lm.typeDef.Declare_Integer () @@ -329,7 +322,7 @@ let private createAcnFunction (r: Asn1AcnAst.AstRoot) let errCodStr = errCodes |> List.map(fun x -> EmitTypeAssignment_def_err_code x.errCodeName (BigInteger x.errCodeValue) x.comment) |> List.distinct let funcDef = Some(EmitTypeAssignment_primitive_def varName sStar funcName (typeDefinition.longTypedefName2 lm.lg.hasModules) errCodStr (t.acnMaxSizeInBits = 0I) nMaxBytesInACN ( t.acnMaxSizeInBits) prms soSparkAnnotations codec) - func, funcDef,icdResult, ns1a + func, funcDef, auxiliaries, icdResult, ns1a let icdAux, ns3 = match icdResult with @@ -346,7 +339,8 @@ let private createAcnFunction (r: Asn1AcnAst.AstRoot) AcnFunction.funcName = funcNameAndtasInfo func = func funcDef = funcDef - funcBody = (fun us acnArgs p -> funcBody us errCode acnArgs p ) + auxiliaries = auxiliaries + funcBody = fun us acnArgs p -> funcBody us errCode acnArgs p funcBodyAsSeqComp = funcBodyAsSeqComp isTestVaseValid = isTestVaseValid icdTas = icdAux @@ -361,9 +355,9 @@ let private createAcnIntegerFunctionInternal (r:Asn1AcnAst.AstRoot) (uperRange : BigIntegerUperRange) (intClass:Asn1AcnAst.IntegerClass) (acnEncodingClass: IntEncodingClass) - (uperfuncBody : ErrorCode -> NestingScope -> CallerScope -> (UPERFuncBodyResult option)) + (uperfuncBody : ErrorCode -> NestingScope -> CallerScope -> bool -> (UPERFuncBodyResult option)) (sAsn1Constraints:string option) - acnMinSizeInBits + acnMinSizeInBits acnMaxSizeInBits unitsOfMeasure (soMF:string option, soMFM:string option): AcnIntegerFuncBody = @@ -418,7 +412,7 @@ let private createAcnIntegerFunctionInternal (r:Asn1AcnAst.AstRoot) let funcBodyContent = match acnEncodingClass with |Asn1AcnAst.Integer_uPER -> - uperfuncBody errCode nestingScope p |> Option.map(fun x -> x.funcBody, x.errCodes, x.bValIsUnReferenced, x.bBsIsUnReferenced, x.typeEncodingKind) + uperfuncBody errCode nestingScope p true |> Option.map(fun x -> x.funcBody, x.errCodes, x.bValIsUnReferenced, x.bBsIsUnReferenced, x.typeEncodingKind) |Asn1AcnAst.PositiveInteger_ConstSize_8 -> let typeEncodingKind = AcnIntegerEncodingType {signedness = Positive; endianness = Byte} Some(PositiveInteger_ConstSize_8 (castPp 8) sSsuffix errCode.errCodeName soMF soMFM (max 0I nUperMin) (uIntActualMax 8) codec, [errCode], false, false, Some typeEncodingKind) @@ -489,7 +483,7 @@ let private createAcnIntegerFunctionInternal (r:Asn1AcnAst.AstRoot) [{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; icdResult=Some icd}) + Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = []; bValIsUnReferenced= bValIsUnReferenced; bBsIsUnReferenced=bBsIsUnReferenced; resultExpr = resultExpr; typeEncodingKind = typeEncodingKind; auxiliaries = []; icdResult=Some icd}) funcBody let getMappingFunctionModule (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (soMapFuncName:string option) = @@ -508,7 +502,7 @@ let createAcnIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C 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 uperFuncBody (errCode) (nestingScope: NestingScope) (p:CallerScope) = + let uperFuncBody (errCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = DAstUPer.getIntfuncBodyByCons r lm codec t.uperRange t.Location (getAcnIntegerClass r.args t) (t.cons) (t.cons@t.withcons) typeId errCode nestingScope p let soMapFunMod, soMapFunc = match t.acnProperties.mappingFunction with @@ -598,7 +592,7 @@ let createEnumCommon (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTyp lv, varName let pVal = {CallerScope.modName = typeId.ModName; arg = Selection.valueEmptyPath intVal} let intFuncBody = - let uperInt (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let uperInt (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let pp, resultExpr = adaptArgument lm codec p let castPp = DAstUPer.castPp r lm codec pp intTypeClass let sSsuffix = DAstUPer.getIntDecFuncSuffix intTypeClass @@ -610,19 +604,19 @@ let createEnumCommon (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTyp lm.lg.generateIntFullyConstraintRangeAssert (ToC (r.args.TypePrefix + tasInfo.tasName)) p codec | None -> None let funcBody = IntFullyConstraintPos (castPp word_size_in_bits) min max nbits sSsuffix errCode.errCodeName rangeAssert codec - Some({UPERFuncBodyResult.funcBody = funcBody; errCodes = [errCode]; localVariables= []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (Asn1IntegerEncodingType (Some (FullyConstrainedPositive (min, max))))}) + Some({UPERFuncBodyResult.funcBody = funcBody; errCodes = [errCode]; localVariables= []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (Asn1IntegerEncodingType (Some (FullyConstrainedPositive (min, max)))); auxiliaries=[]}) createAcnIntegerFunctionInternal r lm codec (Concrete (min,max)) intTypeClass o.acnEncodingClass uperInt sAsn1Constraints acnMinSizeInBits acnMaxSizeInBits unitsOfMeasure (None, None) let funcBodyContent = match intFuncBody errCode acnArgs nestingScope pVal with | None -> None | Some intAcnFuncBdResult -> - let resultExpr, errCodes, typeEncodingKind = - intAcnFuncBdResult.resultExpr, intAcnFuncBdResult.errCodes, intAcnFuncBdResult.typeEncodingKind + let resultExpr, errCodes, typeEncodingKind, auxiliaries = + intAcnFuncBdResult.resultExpr, intAcnFuncBdResult.errCodes, intAcnFuncBdResult.typeEncodingKind, intAcnFuncBdResult.auxiliaries let mainContent, localVariables = match r.args.isEnumEfficientEnabled o.items.Length with | false -> - let arrItems = - o.items |> + let arrItems = + o.items |> List.map(fun it -> let enumClassName = extractEnumClassName "" it.scala_name it.Name.Value Enumerated_item (lm.lg.getValue p.arg) (lm.lg.getNamedItemBackendName (Some defOrRef) it) enumClassName it.acnEncodeValue (lm.lg.intValueToString it.acnEncodeValue intTypeClass) intVal codec) @@ -631,16 +625,16 @@ let createEnumCommon (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTyp let sEnumIndex = "nEnumIndex" let enumIndexVar = (Asn1SIntLocalVariable (sEnumIndex, None)) Enumerated_no_switch (lm.lg.getValue p.arg) td intAcnFuncBdResult.funcBody errCode.errCodeName sFirstItemName intVal sEnumIndex nLastItemIndex o.encodeValues codec, enumIndexVar::localVar@intAcnFuncBdResult.localVariables - Some (mainContent, resultExpr, errCodes, localVariables, typeEncodingKind) + Some (mainContent, resultExpr, errCodes, localVariables, typeEncodingKind, auxiliaries) match funcBodyContent with | None -> None - | Some (funcBodyContent, resultExpr, errCodes, localVariables, typeEncodingKind) -> + | Some (funcBodyContent, resultExpr, errCodes, localVariables, typeEncodingKind, auxiliaries) -> let icdFnc fieldName sPresent (comments:string list) = let newComments = comments@[enumComment icdStgFileName o] [{IcdRow.fieldName = fieldName; comments = newComments; sPresent=sPresent;sType=(IcdPlainType "ENUMERATED"); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = "ENUMERATED"; rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None;} - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; icdResult=Some icd}) + Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; auxiliaries=auxiliaries; icdResult=Some icd}) funcBody @@ -679,19 +673,19 @@ let createRealFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonT let funcBodyContent = match o.acnEncodingClass with - | Real_IEEE754_32_big_endian -> Some (Real_32_big_endian castPp sSuffix errCode.errCodeName codec, [errCode], Some (AcnRealEncodingType BigEndian32)) - | Real_IEEE754_64_big_endian -> Some (Real_64_big_endian pp errCode.errCodeName codec, [errCode], Some (AcnRealEncodingType BigEndian64)) - | Real_IEEE754_32_little_endian -> Some (Real_32_little_endian castPp sSuffix errCode.errCodeName codec, [errCode], Some (AcnRealEncodingType LittleEndian32)) - | Real_IEEE754_64_little_endian -> Some (Real_64_little_endian pp errCode.errCodeName codec, [errCode], Some (AcnRealEncodingType LittleEndian64)) - | Real_uPER -> uperFunc.funcBody_e errCode nestingScope p |> Option.map(fun x -> x.funcBody, x.errCodes, x.typeEncodingKind) + | Real_IEEE754_32_big_endian -> Some (Real_32_big_endian castPp sSuffix errCode.errCodeName codec, [errCode], Some (AcnRealEncodingType BigEndian32), []) + | Real_IEEE754_64_big_endian -> Some (Real_64_big_endian pp errCode.errCodeName codec, [errCode], Some (AcnRealEncodingType BigEndian64), []) + | Real_IEEE754_32_little_endian -> Some (Real_32_little_endian castPp sSuffix errCode.errCodeName codec, [errCode], Some (AcnRealEncodingType LittleEndian32), []) + | Real_IEEE754_64_little_endian -> Some (Real_64_little_endian pp errCode.errCodeName codec, [errCode], Some (AcnRealEncodingType LittleEndian64), []) + | Real_uPER -> uperFunc.funcBody_e errCode nestingScope p true |> Option.map(fun x -> x.funcBody, x.errCodes, x.typeEncodingKind, x.auxiliaries) match funcBodyContent with | None -> None - | Some (funcBodyContent,errCodes, typeEncodingKind) -> + | Some (funcBodyContent,errCodes, typeEncodingKind, auxiliaries) -> let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; icdResult=Some icd}) + + 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) let annots = match ST.lang with @@ -703,14 +697,14 @@ let createRealFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonT 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 funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = let funcBodyContent = - uperFunc.funcBody_e errCode nestingScope p |> Option.map(fun x -> x.funcBody, x.errCodes, x.resultExpr, x.typeEncodingKind) + uperFunc.funcBody_e errCode nestingScope p true |> Option.map(fun x -> x.funcBody, x.errCodes, x.resultExpr, x.typeEncodingKind, x.auxiliaries) match funcBodyContent with | None -> None - | Some (funcBodyContent,errCodes, resultExpr, typeEncodingKind) -> + | Some (funcBodyContent,errCodes, resultExpr, typeEncodingKind, auxiliaries) -> let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; icdResult = Some icd}) + 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 @@ -718,14 +712,14 @@ let createObjectIdentifierFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (c 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 funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = let funcBodyContent = - uperFunc.funcBody_e errCode nestingScope p |> Option.map(fun x -> x.funcBody, x.errCodes, x.resultExpr, x.typeEncodingKind) + uperFunc.funcBody_e errCode nestingScope p true |> Option.map(fun x -> x.funcBody, x.errCodes, x.resultExpr, x.typeEncodingKind, x.auxiliaries) match funcBodyContent with | None -> None - | Some (funcBodyContent,errCodes, resultExpr, typeEncodingKind) -> + | Some (funcBodyContent,errCodes, resultExpr, typeEncodingKind, auxiliaries) -> let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None;} - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; icdResult = Some icd}) + 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 @@ -746,9 +740,7 @@ let createAcnBooleanFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType "BOOLEAN"); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=None; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = "BOOLEAN"; rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - - - Some {AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnBooleanEncodingType None); icdResult = Some icd} + 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) = @@ -790,8 +782,7 @@ 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); icdResult = Some icd} + {AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnBooleanEncodingType o.acnProperties.encodingPattern); 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 -> Some (funcBody e acnArgs nestingScope p), us) (fun atc -> true) soSparkAnnotations [] us @@ -823,7 +814,7 @@ let createAcnNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (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}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = "NULL"; rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - Some ({AcnFuncBodyResult.funcBody = ret; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnNullEncodingType (Some encPattern)); icdResult = Some icd}) + 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) = @@ -836,7 +827,7 @@ let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com 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); icdResult=None}) + Some ({AcnFuncBodyResult.funcBody = lm.acn.Null_declare pp; errCodes = []; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=Some pp; typeEncodingKind = Some (AcnNullEncodingType None); auxiliaries=[]; icdResult=None}) | _ -> None | Some encPattern -> let arrsBits, arrBytes, nBitsSize = @@ -854,8 +845,7 @@ let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - - Some ({AcnFuncBodyResult.funcBody = ret; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= lm.lg.acn.null_valIsUnReferenced; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnNullEncodingType (Some encPattern)); 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=[]; 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 @@ -942,18 +932,18 @@ let createStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let funcBodyContent, ns = match o.acnEncodingClass with | Acn_Enc_String_uPER _ -> - uperFunc.funcBody_e errCode nestingScope p |> Option.map(fun x -> x.funcBody, x.errCodes, x.localVariables), us // TODO: Placeholder (uper) ou bien? + uperFunc.funcBody_e errCode nestingScope p true |> Option.map(fun x -> x.funcBody, x.errCodes, x.localVariables, x.auxiliaries), us | Acn_Enc_String_uPER_Ascii _ -> match o.maxSize.uper = o.minSize.uper with - | true -> Some (Acn_String_Ascii_FixSize pp errCode.errCodeName ( o.maxSize.uper) codec, [errCode], []), us + | true -> Some (Acn_String_Ascii_FixSize pp errCode.errCodeName ( o.maxSize.uper) codec, [errCode], [], []), us | false -> let nSizeInBits = GetNumberOfBitsForNonNegativeInteger ( (o.maxSize.acn - o.minSize.acn)) - Some (Acn_String_Ascii_Internal_Field_Determinant pp errCode.errCodeName ( o.maxSize.acn) ( o.minSize.acn) nSizeInBits codec , [errCode], []), us + Some (Acn_String_Ascii_Internal_Field_Determinant pp errCode.errCodeName ( o.maxSize.acn) ( o.minSize.acn) nSizeInBits codec, [errCode], [], []), us | Acn_Enc_String_Ascii_Null_Terminated (_,nullChars) -> - Some (Acn_String_Ascii_Null_Terminated pp errCode.errCodeName ( o.maxSize.acn) nullChars codec, [errCode], []), us + Some (Acn_String_Ascii_Null_Terminated pp errCode.errCodeName ( o.maxSize.acn) nullChars codec, [errCode], [], []), us | Acn_Enc_String_Ascii_External_Field_Determinant _ -> let extField = getExternalField r deps t.id - Some(Acn_String_Ascii_External_Field_Determinant pp errCode.errCodeName ( o.maxSize.acn) extField codec, [errCode], []), us + Some(Acn_String_Ascii_External_Field_Determinant pp errCode.errCodeName ( o.maxSize.acn) extField codec, [errCode], [], []), us | Acn_Enc_String_CharIndex_External_Field_Determinant _ -> let extField = getExternalField r deps t.id let nBits = GetNumberOfBitsForNonNegativeInteger (BigInteger (o.uperCharSet.Length-1)) @@ -963,14 +953,14 @@ let createStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let arrAsciiCodes = o.uperCharSet |> Array.map(fun x -> BigInteger (System.Convert.ToInt32 x)) Acn_String_CharIndex_External_Field_Determinant pp errCode.errCodeName ( o.maxSize.acn) arrAsciiCodes (BigInteger o.uperCharSet.Length) extField td nBits codec | true -> Acn_IA5String_CharIndex_External_Field_Determinant pp errCode.errCodeName o.maxSize.acn extField td nBits (nestingScope.acnOuterMaxSize - nestingScope.acnOffset) codec - Some(encDecStatement, [errCode], []), us + Some(encDecStatement, [errCode], [], []), us match funcBodyContent with | None -> None, ns - | Some (funcBodyContent,errCodes, localVars) -> + | Some (funcBodyContent,errCodes, localVars, auxiliaries) -> let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVars; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnStringEncodingType o.acnEncodingClass); icdResult = Some icd} ), ns + 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 @@ -1018,12 +1008,12 @@ let createAcnStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF let nBits = GetNumberOfBitsForNonNegativeInteger (BigInteger (o.uperCharSet.Length-1)) let internalItem = match o.uperCharSet.Length = 128 with - | true -> InternalItem_string_no_alpha pp errCode.errCodeName i codec + | true -> InternalItem_string_no_alpha pp errCode.errCodeName i codec | false -> let nBits = GetNumberOfBitsForNonNegativeInteger (BigInteger (o.uperCharSet.Length-1)) let arrAsciiCodes = o.uperCharSet |> Array.map(fun x -> BigInteger (System.Convert.ToInt32 x)) 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 nSizeInBits = GetNumberOfBitsForNonNegativeInteger (o.maxSize.uper - o.minSize.uper) let sqfProofGen = { SequenceOfLikeProofGen.acnOuterMaxSize = nestingScope.acnOuterMaxSize uperOuterMaxSize = nestingScope.uperOuterMaxSize @@ -1036,27 +1026,26 @@ let createAcnStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF acnMaxSizeBits = o.acnEncodingClass.charSizeInBits typeKind = Some (AcnStringEncodingType o.acnEncodingClass) } - sel = pp + nestingScope = nestingScope + cs = p + encDec = Some internalItem + elemDecodeFn = None ixVariable = i } - let sqfProofGenRes = lm.lg.generateSequenceOfLikeProof ACN (SequenceOfLike.StrType o) sqfProofGen codec - let preSerde = sqfProofGenRes |> Option.map (fun r -> r.preSerde) - let postSerde = sqfProofGenRes |> Option.map (fun r -> r.postSerde) - let postInc = sqfProofGenRes |> Option.map (fun r -> r.postInc) - let invariant = sqfProofGenRes |> Option.map (fun r -> r.invariant) let introSnap = nestingScope.nestingLevel = 0I + let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries ACN (StrType o) sqfProofGen codec let funcBodyContent, localVariables = match o.minSize with | _ when o.maxSize.uper < 65536I && o.maxSize.uper=o.minSize.uper -> - str_FixedSize pp typeDefinitionName i internalItem o.minSize.uper nBits nBits 0I initExpr introSnap preSerde postSerde postInc invariant codec, charIndex@nStringLength + str_FixedSize pp typeDefinitionName i internalItem o.minSize.uper nBits nBits 0I initExpr introSnap callAux codec, charIndex@nStringLength | _ when o.maxSize.uper < 65536I && o.maxSize.uper<>o.minSize.uper -> - str_VarSize pp typeDefinitionName i internalItem o.minSize.uper o.maxSize.uper nSizeInBits nBits nBits 0I initExpr codec , charIndex@nStringLength + str_VarSize pp (p.arg.joined lm.lg) typeDefinitionName i internalItem o.minSize.uper o.maxSize.uper nSizeInBits nBits nBits 0I initExpr callAux codec, charIndex@nStringLength | _ -> - let funcBodyContent,localVariables = DAstUPer.handleFragmentation lm p codec errCode ii ( o.uperMaxSizeInBits) o.minSize.uper o.maxSize.uper internalItem nBits false true + let funcBodyContent,localVariables = DAstUPer.handleFragmentation lm p codec errCode ii o.uperMaxSizeInBits o.minSize.uper o.maxSize.uper internalItem nBits false true funcBodyContent,charIndex@localVariables - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = lv::localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnStringEncodingType o.acnEncodingClass)} + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = lv::localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnStringEncodingType o.acnEncodingClass); auxiliaries=auxiliaries} let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = @@ -1066,14 +1055,14 @@ let createAcnStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF match t.str.acnEncodingClass with | Acn_Enc_String_uPER_Ascii _ -> match t.str.maxSize.uper = t.str.minSize.uper with - | true -> Some (Acn_String_Ascii_FixSize pp errCode.errCodeName ( t.str.maxSize.uper) codec, [], []) + | true -> Some (Acn_String_Ascii_FixSize pp errCode.errCodeName ( t.str.maxSize.uper) codec, [], [], []) | false -> let nSizeInBits = GetNumberOfBitsForNonNegativeInteger ( (o.maxSize.acn - o.minSize.acn)) - Some (Acn_String_Ascii_Internal_Field_Determinant pp errCode.errCodeName ( t.str.maxSize.acn) ( t.str.minSize.acn) nSizeInBits codec , [], []) - | Acn_Enc_String_Ascii_Null_Terminated (_, nullChars) -> Some (Acn_String_Ascii_Null_Terminated pp errCode.errCodeName ( t.str.maxSize.acn) nullChars codec, [], []) + Some (Acn_String_Ascii_Internal_Field_Determinant pp errCode.errCodeName ( t.str.maxSize.acn) ( t.str.minSize.acn) nSizeInBits codec , [], [], []) + | Acn_Enc_String_Ascii_Null_Terminated (_, nullChars) -> Some (Acn_String_Ascii_Null_Terminated pp errCode.errCodeName ( t.str.maxSize.acn) nullChars codec, [], [], []) | Acn_Enc_String_Ascii_External_Field_Determinant _ -> let extField = getExternalField r deps typeId - Some(Acn_String_Ascii_External_Field_Determinant pp errCode.errCodeName ( t.str.maxSize.acn) extField codec, [], []) + Some(Acn_String_Ascii_External_Field_Determinant pp errCode.errCodeName ( t.str.maxSize.acn) extField codec, [], [], []) | Acn_Enc_String_CharIndex_External_Field_Determinant _ -> let extField = getExternalField r deps typeId let nBits = GetNumberOfBitsForNonNegativeInteger (BigInteger (t.str.uperCharSet.Length-1)) @@ -1083,18 +1072,17 @@ let createAcnStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF let arrAsciiCodes = t.str.uperCharSet |> Array.map(fun x -> BigInteger (System.Convert.ToInt32 x)) Acn_String_CharIndex_External_Field_Determinant pp errCode.errCodeName ( t.str.maxSize.acn) arrAsciiCodes (BigInteger t.str.uperCharSet.Length) extField td nBits codec | true -> Acn_IA5String_CharIndex_External_Field_Determinant pp errCode.errCodeName t.str.maxSize.acn extField td nBits (nestingScope.acnOuterMaxSize - nestingScope.acnOffset) codec - Some(encDecStatement, [], []) + Some(encDecStatement, [], [], []) | Acn_Enc_String_uPER _ -> let x = uper_funcBody errCode nestingScope p - Some(x.funcBody, x.errCodes, x.localVariables) + Some(x.funcBody, x.errCodes, x.localVariables, x.auxiliaries) match funcBodyContent with | None -> None - | Some (funcBodyContent,errCodes, lvs) -> + | Some (funcBodyContent,errCodes, lvs, auxiliaries) -> let icdFnc fieldName sPresent comments = [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType "IA5String"); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=None; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = "IA5String"; rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCode::errCodes |> List.distinct ; localVariables = lvs; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnStringEncodingType o.acnEncodingClass); icdResult = Some icd}) - + Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCode::errCodes |> List.distinct ; localVariables = lvs; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnStringEncodingType o.acnEncodingClass); auxiliaries=auxiliaries; icdResult = Some icd}) (funcBody errCode), ns @@ -1153,8 +1141,6 @@ let createOctetStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserte | _ -> [] Some(fncBody, [errCode],lv::lv2) - - match funcBodyContent with | None -> None | Some (funcBodyContent,errCodes, localVariables) -> @@ -1162,9 +1148,10 @@ let createOctetStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserte [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnOctetStringEncodingType o.acnEncodingClass); icdResult = Some icd}) + 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 + 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; let bitString_FixSize = lm.uper.bitString_FixSize @@ -1211,7 +1198,8 @@ let createBitStringFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}], [] let icd = {IcdArgAux.canBeEmbedded = true; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=[]; scope="type"; name= None} - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnBitStringEncodingType o.acnEncodingClass); icdResult = Some icd}) + 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 @@ -1220,7 +1208,7 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted let oct_sqf_external_field_fix_size = lm.acn.sqf_external_field_fix_size let external_field = lm.acn.sqf_external_field let fixedSize = lm.uper.seqOf_FixedSize - let varSize = lm.uper.seqOf_VarSize + let varSize = lm.acn.seqOf_VarSize let ii = t.id.SequenceOfLevel + 1 @@ -1278,9 +1266,8 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted match child.getAcnFunction codec with | None -> None, us | Some chFunc -> - let childNestingScope = {nestingScope with nestingLevel = nestingScope.nestingLevel + 1I} + 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 uperOuterMaxSize = nestingScope.uperOuterMaxSize @@ -1293,14 +1280,13 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted acnMaxSizeBits = child.acnMaxSizeInBits typeKind = internalItem |> Option.bind (fun i -> i.typeEncodingKind) } - sel = pp + nestingScope = nestingScope + cs = p + encDec = internalItem |> Option.map (fun ii -> ii.funcBody) + elemDecodeFn = None // TODO: elemDecodeFn ixVariable = i } - let sqfProofGenRes = lm.lg.generateSequenceOfLikeProof ACN (SqOf o) sqfProofGen codec - let preSerde = sqfProofGenRes |> Option.map (fun r -> r.preSerde) - let postSerde = sqfProofGenRes |> Option.map (fun r -> r.postSerde) - let postInc = sqfProofGenRes |> Option.map (fun r -> r.postInc) - let invariant = sqfProofGenRes |> Option.map (fun r -> r.invariant) + let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries ACN (SqOf o) sqfProofGen codec let ret = match o.acnEncodingClass with @@ -1325,17 +1311,17 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted match o.isFixedSize with | true -> None | false -> - let funcBody = varSize pp access td i "" o.minSize.acn o.maxSize.acn nSizeInBits child.acnMinSizeInBits nIntItemMaxSize 0I childInitExpr errCode.errCodeName absOffset remBits lvl ix offset introSnap preSerde postSerde postInc invariant codec - Some ({AcnFuncBodyResult.funcBody = funcBody; errCodes = [errCode]; localVariables = lv@nStringLength; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None; icdResult = Some icd}) + let funcBody = varSize pp access td i "" o.minSize.acn o.maxSize.acn nSizeInBits child.acnMinSizeInBits nIntItemMaxSize 0I childInitExpr errCode.errCodeName absOffset remBits lvl ix offset introSnap callAux codec + Some ({AcnFuncBodyResult.funcBody = funcBody; errCodes = [errCode]; localVariables = lv@nStringLength; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None; auxiliaries=auxiliaries; icdResult = Some icd}) | Some internalItem -> let childErrCodes = internalItem.errCodes let ret, localVariables = match o.isFixedSize with - | true -> fixedSize pp td i internalItem.funcBody o.minSize.acn child.acnMinSizeInBits nIntItemMaxSize 0I childInitExpr codec, nStringLength - | false -> varSize pp access td i internalItem.funcBody o.minSize.acn o.maxSize.acn nSizeInBits child.acnMinSizeInBits nIntItemMaxSize 0I childInitExpr errCode.errCodeName absOffset remBits lvl ix offset introSnap preSerde postSerde postInc invariant codec, nStringLength + | true -> fixedSize pp td i internalItem.funcBody o.minSize.acn child.acnMinSizeInBits nIntItemMaxSize 0I childInitExpr callAux codec, nStringLength + | false -> varSize pp access td i internalItem.funcBody o.minSize.acn o.maxSize.acn nSizeInBits child.acnMinSizeInBits nIntItemMaxSize 0I childInitExpr errCode.errCodeName absOffset remBits lvl ix offset introSnap callAux codec, nStringLength let typeEncodingKind = internalItem.typeEncodingKind |> Option.map (fun tpe -> TypeEncodingKind.SequenceOfEncodingType (tpe, o.acnEncodingClass)) - Some ({AcnFuncBodyResult.funcBody = ret; errCodes = errCode::childErrCodes; localVariables = lv@(internalItem.localVariables@localVariables); bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; icdResult = Some icd}) + Some ({AcnFuncBodyResult.funcBody = ret; errCodes = errCode::childErrCodes; localVariables = lv@(internalItem.localVariables@localVariables); bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; auxiliaries=internalItem.auxiliaries @ auxiliaries; icdResult = Some icd}) | SZ_EC_ExternalField _ -> match internalItem with @@ -1343,7 +1329,6 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted | Some internalItem -> let localVariables = internalItem.localVariables let childErrCodes = internalItem.errCodes - let internalItemBody = internalItem.funcBody let extField = getExternalField r deps t.id let tp = getExternalFieldType r deps t.id let unsigned = @@ -1351,19 +1336,14 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted | Some (AcnInsertedType.AcnInteger int) -> int.isUnsigned | Some (AcnInsertedType.AcnNullType _) -> true | _ -> false - let internalItemBody = - match codec, lm.lg.decodingKind with - | Decode, Copy -> - assert internalItem.resultExpr.IsSome - internalItemBody + "\n" + (lm.uper.update_array_item pp i internalItem.resultExpr.Value) - | _ -> internalItemBody let introSnap = nestingScope.nestingLevel = 0I let funcBodyContent = match o.isFixedSize with - | true -> oct_sqf_external_field_fix_size td pp access i internalItemBody (if o.minSize.acn=0I then None else Some o.minSize.acn) o.maxSize.acn extField unsigned nAlignSize errCode.errCodeName o.child.acnMinSizeInBits o.child.acnMaxSizeInBits childInitExpr introSnap preSerde postSerde postInc invariant codec - | false -> external_field td pp access i internalItemBody (if o.minSize.acn=0I then None else Some o.minSize.acn) o.maxSize.acn extField unsigned nAlignSize errCode.errCodeName o.child.acnMinSizeInBits o.child.acnMaxSizeInBits childInitExpr introSnap preSerde postSerde postInc invariant codec + | true -> oct_sqf_external_field_fix_size td pp access i internalItem.funcBody (if o.minSize.acn=0I then None else Some o.minSize.acn) o.maxSize.acn extField unsigned nAlignSize errCode.errCodeName o.child.acnMinSizeInBits o.child.acnMaxSizeInBits childInitExpr introSnap callAux codec + | false -> external_field td pp access i internalItem.funcBody (if o.minSize.acn=0I then None else Some o.minSize.acn) o.maxSize.acn extField unsigned nAlignSize errCode.errCodeName o.child.acnMinSizeInBits o.child.acnMaxSizeInBits childInitExpr introSnap callAux codec let typeEncodingKind = internalItem.typeEncodingKind |> Option.map (fun tpe -> TypeEncodingKind.SequenceOfEncodingType (tpe, o.acnEncodingClass)) - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCode::childErrCodes; localVariables = lv@localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; icdResult = Some icd}) + Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCode::childErrCodes; localVariables = lv@localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; auxiliaries=internalItem.auxiliaries @ auxiliaries; icdResult = Some icd}) + | SZ_EC_TerminationPattern bitPattern -> match internalItem with | None -> None @@ -1374,15 +1354,8 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted let byteArray = bitStringValueToByteArray bitPatten8.AsLoc let localVariables = internalItem.localVariables let childErrCodes = internalItem.errCodes - let internalItemBody = internalItem.funcBody - let noSizeMin = if o.minSize.acn=0I then None else Some ( o.minSize.acn) - let internalItemBody = - match codec, lm.lg.decodingKind with - | Decode, Copy -> - assert internalItem.resultExpr.IsSome - internalItemBody + "\n" + (lm.uper.update_array_item pp i internalItem.resultExpr.Value) - | _ -> internalItemBody - let funcBodyContent = oct_sqf_null_terminated pp access i internalItemBody noSizeMin o.maxSize.acn byteArray bitPattern.Value.Length.AsBigInt errCode.errCodeName o.child.acnMinSizeInBits o.child.acnMaxSizeInBits codec + let noSizeMin = if o.minSize.acn=0I then None else Some o.minSize.acn + let funcBodyContent = oct_sqf_null_terminated pp access i internalItem.funcBody noSizeMin o.maxSize.acn byteArray bitPattern.Value.Length.AsBigInt errCode.errCodeName o.child.acnMinSizeInBits o.child.acnMaxSizeInBits codec let lv2 = match codec, lm.lg.acn.checkBitPatternPresentResult with @@ -1390,10 +1363,9 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInserted | _ -> [] let typeEncodingKind = internalItem.typeEncodingKind |> Option.map (fun tpe -> TypeEncodingKind.SequenceOfEncodingType (tpe, o.acnEncodingClass)) - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCode::childErrCodes; localVariables = lv2@lv@localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=None; typeEncodingKind=typeEncodingKind; icdResult = Some icd}) + 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 let initExpr (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (t: Asn1AcnAst.AcnInsertedType): string = @@ -1465,7 +1437,7 @@ let rec handleSingleUpdateDependency (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.Acn let errCodes0, localVariables0, ns = match asn1TypeD.acnEncFunction with | Some f -> - let fncBdRes, ns = f.funcBody us [] (NestingScope.init asn1TypeD.acnMaxSizeInBits asn1TypeD.uperMaxSizeInBits) {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} + let fncBdRes, ns = f.funcBody us [] (NestingScope.init asn1TypeD.acnMaxSizeInBits asn1TypeD.uperMaxSizeInBits []) {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} match fncBdRes with | Some x -> x.errCodes, x.localVariables, ns | None -> [], [], us @@ -1523,7 +1495,7 @@ let rec handleSingleUpdateDependency (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.Acn let icdComments = [] Some ({AcnChildUpdateResult.updateAcnChildFnc = updateFunc; icdComments=icdComments; errCodes=[]; testCaseFnc=testCaseFnc; localVariables=[]}), us | AcnDepPresence (relPath, chc) -> - let icdComments = + let icdComments = let aaa = sprintf "Used as a presence determinant for %s " (chc.typeDef[C].asn1Name) [aaa] let updateFunc (child: AcnChild) (nestingScope: NestingScope) (vTarget : CallerScope) (pSrcRoot : CallerScope) = @@ -1671,7 +1643,7 @@ and getUpdateFunctionUsedInEncoding (r: Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.Ac let isAlwaysInit (d: AcnDependency): bool = match d.dependencyKind with | AcnDepRefTypeArgument p -> - // last item is the determinant, and the second-to-last is the field referencing the determinant + // Last item is the determinant, and the second-to-last is the field referencing the determinant not p.id.dropLast.lastItemIsOptional | AcnDepChoiceDeterminant (_, c, isOpt) -> not isOpt | _ -> true @@ -1713,21 +1685,7 @@ and getUpdateFunctionUsedInEncoding (r: Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.Ac let ret = Some(({AcnChildUpdateResult.updateAcnChildFnc = multiUpdateFunc; icdComments=icdComments; errCodes=errCode::restErrCodes ; testCaseFnc = testCaseFnc; localVariables = restLocalVariables})) ret, ns -type private AcnSequenceStatement = - | AcnPresenceStatement - | Asn1ChildEncodeStatement - | AcnChildUpdateStatement - | AcnChildEncodeStatement - -type private HandleChild_Aux = { - statementKind : AcnSequenceStatement - acnPresenceStatement : string option - localVariableList : LocalVariable list - errCodeList : ErrorCode list -} - type private SequenceChildStmt = { - acnStatement: AcnSequenceStatement body: string option lvs: LocalVariable list errCodes: ErrorCode list @@ -1745,6 +1703,7 @@ type private SequenceChildResult = { existVar: string option props: SequenceChildProps typeKindEncoding: TypeEncodingKind option + auxiliaries: string list icdComments : string list } with member this.joinedBodies (lm:LanguageMacros) (codec:CommonTypes.Codec): string option = @@ -1754,7 +1713,6 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi (* 1. all Acn inserted children are declared as local variables in the encoded and decode functions (declaration step) 2. all Acn inserted children must be initialized appropriately in the encoding phase - 3. *) // stg macros let sequence_presence_optChild = lm.acn.sequence_presence_optChild @@ -1959,8 +1917,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi [AcnInsertedChild(bitStreamPositionsLocalVar, td.extension_function_positions, ""); AcnInsertedChild(bsPosStart, bitStreamName, "")]@localVariables, Some fncCall, Some bitStreamPositionsLocalVar, Some initialBitStrmStatement | _ -> localVariables, None, None, None - - let handleChild (s: SequenceChildState) (child: SeqChildInfo): SequenceChildResult * SequenceChildState = + let handleChild (s: SequenceChildState) (childInfo: SeqChildInfo): SequenceChildResult * SequenceChildState = // This binding is suspect, isn't it let us = s.us let soSaveBitStrmPosStatement = None @@ -1971,9 +1928,10 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi uperRelativeOffset = s.uperAccBits uperOffset = nestingScope.uperOffset + s.uperAccBits acnRelativeOffset = s.acnAccBits - acnOffset = nestingScope.acnOffset + s.acnAccBits} + acnOffset = nestingScope.acnOffset + s.acnAccBits + parents = (p, t) :: nestingScope.parents} - match child with + match childInfo with | Asn1Child child -> let childTypeDef = child.Type.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules let childName = lm.lg.getAsn1ChildBackendName child @@ -1986,48 +1944,50 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi match chFunc with | Some chFunc -> chFunc.funcBodyAsSeqComp us [] childNestingScope childP childName | None -> None, us + //handle present-when acn property - let present_when_statements, existVar, ns2 = - let acnPresenceStatement, lvs, errCodes, existVar, ns1b = - match child.Optionality with - | Some (Asn1AcnAst.Optional opt) -> - match opt.acnPresentWhen with - | None -> - match codec with - | Encode -> - // We do not need the `exist` variable for encoding as we use the child `exist` bit - None, [], [], None, ns1 - | Decode -> - let existVar = ToC (child._c_name + "_exist") - let lv = FlagLocalVariable (existVar, None) - None, [lv], [], Some existVar, ns1 - | Some (PresenceWhenBool _) -> - match codec with - | Encode -> None, [], [], None, ns1 - | Decode -> - let getExternalField (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) asn1TypeIdWithDependency = - let filterDependency (d:AcnDependency) = - match d.dependencyKind with - | AcnDepPresenceBool -> true - | _ -> false - getExternalField0 r deps asn1TypeIdWithDependency filterDependency - let extField = getExternalField r deps child.Type.id - let body = sequence_presence_optChild_pres_bool (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName extField codec - Some body, [], [], Some extField, ns1 - | Some (PresenceWhenBoolExpression exp) -> - let _errCodeName = ToC ("ERR_ACN" + (codec.suffix.ToUpper()) + "_" + ((child.Type.id.AcnAbsPath |> Seq.skip 1 |> Seq.StrJoin("-")).Replace("#","elm")) + "_PRESENT_WHEN_EXP_FAILED") - let errCode, ns1a = getNextValidErrorCode ns1 _errCodeName None - let retExp = acnExpressionToBackendExpression o p exp - let existVar = - if codec = Decode then Some (ToC (child._c_name + "_exist")) - else None - let lv = existVar |> Option.toList |> List.map (fun v -> FlagLocalVariable (v, None)) - let body = sequence_presence_optChild_pres_acn_expression (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName retExp existVar errCode.errCodeName codec - Some body, lv, [errCode], existVar, ns1a - | _ -> None, [], [], None, ns1 - {acnStatement=AcnPresenceStatement; body=acnPresenceStatement; lvs=lvs; errCodes=errCodes; icdComments=[]}, existVar, ns1b - - let childEncDecStatement, childResultExpr, childTpeKind, ns3 = + let presentWhenStmts, presentWhenLvs, presentWhenErrs, existVar, ns2 = + match child.Optionality with + | Some (Asn1AcnAst.Optional opt) -> + match opt.acnPresentWhen with + | None -> + match codec with + | Encode -> + // We do not need the `exist` variable for encoding as we use the child `exist` bit + None, [], [], None, ns1 + | Decode -> + let existVar = ToC (child._c_name + "_exist") + let lv = FlagLocalVariable (existVar, None) + None, [lv], [], Some existVar, ns1 + | Some (PresenceWhenBool _) -> + match codec with + | Encode -> None, [], [], None, ns1 + | Decode -> + let getExternalField (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) asn1TypeIdWithDependency = + let filterDependency (d:AcnDependency) = + match d.dependencyKind with + | AcnDepPresenceBool -> true + | _ -> false + getExternalField0 r deps asn1TypeIdWithDependency filterDependency + let extField = getExternalField r deps child.Type.id + let body (p: CallerScope) (existVar: string option): string = + assert existVar.IsSome + sequence_presence_optChild_pres_bool (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName existVar.Value codec + Some body, [], [], Some extField, ns1 + | Some (PresenceWhenBoolExpression exp) -> + let _errCodeName = ToC ("ERR_ACN" + (codec.suffix.ToUpper()) + "_" + ((child.Type.id.AcnAbsPath |> Seq.skip 1 |> Seq.StrJoin("-")).Replace("#","elm")) + "_PRESENT_WHEN_EXP_FAILED") + let errCode, ns1a = getNextValidErrorCode ns1 _errCodeName None + let retExp = acnExpressionToBackendExpression o p exp + let existVar = + if codec = Decode then Some (ToC (child._c_name + "_exist")) + else None + let lv = existVar |> Option.toList |> List.map (fun v -> FlagLocalVariable (v, None)) + let body (p: CallerScope) (existVar: string option): string = + sequence_presence_optChild_pres_acn_expression (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName retExp existVar errCode.errCodeName codec + Some body, lv, [errCode], existVar, ns1a + | _ -> None, [], [], None, ns1 + + let childBody, childLvs, childErrs, childResultExpr, childTpeKind, auxiliaries, ns3 = match childContentResult with | None -> // Copy-decoding expects to have a result expression (even if unused), so we pick the initExpression @@ -2037,34 +1997,50 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi | _ -> None match child.Optionality with | Some Asn1AcnAst.AlwaysPresent -> - let childBody = Some(sequence_always_present_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName None childResultExpr soSaveBitStrmPosStatement codec) - Some {acnStatement=Asn1ChildEncodeStatement; body=childBody; lvs=[]; errCodes=[];icdComments=[]}, childResultExpr, None, ns2 - | _ -> None, childResultExpr, None, ns2 + let childBody (p: CallerScope) (existVar: string option): string = + sequence_always_present_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName None childResultExpr childTypeDef soSaveBitStrmPosStatement codec + Some childBody, [], [], childResultExpr, None, [], ns2 + | _ -> None, [], [], childResultExpr, None, [], ns2 | Some childContent -> - let childBody, chLocalVars = + let childBody (p: CallerScope) (existVar: string option): string = match child.Optionality with - | None -> Some (sequence_mandatory_child childName childContent.funcBody soSaveBitStrmPosStatement codec), childContent.localVariables - | Some Asn1AcnAst.AlwaysAbsent -> Some (sequence_always_absent_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName childContent.funcBody childTypeDef soSaveBitStrmPosStatement codec), [] - | Some Asn1AcnAst.AlwaysPresent -> Some (sequence_always_present_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName (Some childContent.funcBody) childContent.resultExpr soSaveBitStrmPosStatement codec), childContent.localVariables + | None -> + sequence_mandatory_child childName childContent.funcBody soSaveBitStrmPosStatement codec + | Some Asn1AcnAst.AlwaysAbsent -> + sequence_always_absent_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName childContent.funcBody childTypeDef soSaveBitStrmPosStatement codec + | Some Asn1AcnAst.AlwaysPresent -> + sequence_always_present_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childName (Some childContent.funcBody) childContent.resultExpr childTypeDef soSaveBitStrmPosStatement codec | Some (Asn1AcnAst.Optional opt) -> assert (codec = Encode || existVar.IsSome) let pp, _ = joinedOrAsIdentifier lm codec p match opt.defaultValue with | None -> - Some(sequence_optional_child pp (lm.lg.getAccess p.arg) childName childContent.funcBody existVar childContent.resultExpr childTypeDef soSaveBitStrmPosStatement codec), childContent.localVariables + sequence_optional_child pp (lm.lg.getAccess p.arg) childName childContent.funcBody existVar childContent.resultExpr childTypeDef soSaveBitStrmPosStatement codec | Some v -> let defInit= child.Type.initFunction.initByAsn1Value childP (mapValue v).kind - Some(sequence_default_child pp (lm.lg.getAccess p.arg) childName childContent.funcBody defInit existVar childContent.resultExpr childTypeDef soSaveBitStrmPosStatement codec), childContent.localVariables - let fff = childContent.localVariables - Some {acnStatement=Asn1ChildEncodeStatement; body=childBody; lvs=chLocalVars; errCodes=childContent.errCodes;icdComments=[]}, childContent.resultExpr, childContent.typeEncodingKind, ns2 - let stmts = [present_when_statements]@(childEncDecStatement |> Option.toList) - let icdComments = stmts |> List.collect(fun z -> z.icdComments) + sequence_default_child pp (lm.lg.getAccess p.arg) childName childContent.funcBody defInit existVar childContent.resultExpr childTypeDef soSaveBitStrmPosStatement codec + let lvs = + match child.Optionality with + | Some Asn1AcnAst.AlwaysAbsent -> [] + | _ -> childContent.localVariables + Some childBody, lvs, childContent.errCodes, childContent.resultExpr, childContent.typeEncodingKind, childContent.auxiliaries, ns2 + + let optAux, theCombinedBody = + if presentWhenStmts.IsNone && childBody.IsNone then [], None + else + 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 + 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 = {sel=Some (childSel.joined lm.lg); uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits; typeInfo=typeInfo} - let res = {stmts=stmts; resultExpr=childResultExpr; existVar=existVar; props=props; typeKindEncoding=tpeKind;icdComments=icdComments} + let 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 newAcc = {us=ns3; childIx=s.childIx + 1I; uperAccBits=s.uperAccBits + child.uperMaxSizeInBits; acnAccBits=s.acnAccBits + child.acnMaxSizeInBits} res, newAcc | AcnChild acnChild -> @@ -2079,36 +2055,38 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi match acnChild.funcUpdateStatement with | Some funcUpdateStatement -> Some (funcUpdateStatement.updateAcnChildFnc acnChild childNestingScope childP pRoot), funcUpdateStatement.localVariables, funcUpdateStatement.errCodes, funcUpdateStatement.icdComments | None -> None, [], [], [] - Some {acnStatement=AcnChildUpdateStatement; body=updateStatement; lvs=lvs; errCodes=errCodes; icdComments=icdComments}, us + Some {body=updateStatement; lvs=lvs; errCodes=errCodes; icdComments=icdComments}, us | Decode -> None, us //acn child encode/decode - let childEncDecStatement, childTpeKind, ns2 = + let childEncDecStatement, childTpeKind, auxiliaries, ns2 = let chFunc = acnChild.funcBody codec let childContentResult = chFunc [] childNestingScope childP match childContentResult with - | None -> None, None, ns1 + | None -> None, None, [], ns1 | Some childContent -> match codec with | Encode -> match acnChild.Type with | Asn1AcnAst.AcnNullType _ -> let childBody = Some (sequence_mandatory_child acnChild.c_name childContent.funcBody soSaveBitStrmPosStatement codec) - Some {acnStatement=AcnChildEncodeStatement; body=childBody; lvs=childContent.localVariables; errCodes=childContent.errCodes;icdComments=[]}, childContent.typeEncodingKind, ns1 + Some {body=childBody; lvs=childContent.localVariables; errCodes=childContent.errCodes;icdComments=[]}, childContent.typeEncodingKind, childContent.auxiliaries, ns1 + | _ -> let _errCodeName = ToC ("ERR_ACN" + (codec.suffix.ToUpper()) + "_" + ((acnChild.id.AcnAbsPath |> Seq.skip 1 |> Seq.StrJoin("-")).Replace("#","elm")) + "_UNINITIALIZED") let errCode, ns1a = getNextValidErrorCode ns1 _errCodeName None let childBody = Some (sequence_acn_child acnChild.c_name childContent.funcBody errCode.errCodeName soSaveBitStrmPosStatement codec) - Some {acnStatement=AcnChildEncodeStatement; body=childBody; lvs=childContent.localVariables; errCodes=errCode::childContent.errCodes;icdComments=[]}, childContent.typeEncodingKind, ns1a + Some {body=childBody; lvs=childContent.localVariables; errCodes=errCode::childContent.errCodes; icdComments=[]}, childContent.typeEncodingKind, childContent.auxiliaries, ns1a | Decode -> let childBody = Some (sequence_mandatory_child acnChild.c_name childContent.funcBody soSaveBitStrmPosStatement codec) - Some {acnStatement=AcnChildEncodeStatement; body=childBody; lvs=childContent.localVariables; errCodes=childContent.errCodes;icdComments=[]}, childContent.typeEncodingKind, ns1 + Some {body=childBody; lvs=childContent.localVariables; errCodes=childContent.errCodes; icdComments=[]}, childContent.typeEncodingKind, childContent.auxiliaries, ns1 + 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=child.acnMaxSizeInBits; typeKind=childTpeKind} - let props = {sel=Some (childP.arg.joined lm.lg); uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits; typeInfo=typeInfo} - let res = {stmts=stmts; resultExpr=None; existVar=None; props=props; typeKindEncoding=childTpeKind; icdComments=icdComments} + let 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 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. @@ -2123,7 +2101,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi | Some (Optional opt) -> if opt.acnPresentWhen.IsNone then 1I else 0I | _ -> 0I ) - let childrenStatements00, scs = children |> foldMap handleChild {us=us; childIx=nbPresenceBits; uperAccBits=nbPresenceBits; acnAccBits=nbPresenceBits} + let (childrenStatements00: SequenceChildResult list), scs = children |> foldMap handleChild {us=us; childIx=nbPresenceBits; uperAccBits=nbPresenceBits; acnAccBits=nbPresenceBits} let ns = scs.us let childrenStatements0 = childrenStatements00 |> List.collect (fun xs -> xs.stmts) @@ -2133,11 +2111,33 @@ 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 _ -> - {sel=None; uperMaxOffset = bigint i; acnMaxOffset = bigint i; - typeInfo = {uperMaxSizeBits = 1I; acnMaxSizeBits = 1I; typeKind = Some (AcnBooleanEncodingType None)};}) + { + 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) - {acnOuterMaxSize = nestingScope.acnOuterMaxSize; uperOuterMaxSize = nestingScope.uperOuterMaxSize; + {t = t; 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; @@ -2153,7 +2153,8 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let childrenResultExpr = childrenStatements00 |> List.choose(fun res -> res.resultExpr) let childrenErrCodes = childrenStatements0 |> List.collect(fun s -> s.errCodes) let childrenTypeKindEncoding = childrenStatements00 |> List.map (fun s -> s.typeKindEncoding) - + let childrenAuxiliaries = childrenStatements00 |> List.collect (fun s -> s.auxiliaries) + let resultExpr, seqBuild= match codec, lm.lg.decodingKind with | Decode, Copy -> @@ -2167,10 +2168,11 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let existTd = (lm.lg.getSequenceTypeDefinition o.typeDef).exist [lm.init.initSequenceExpr existTd childrenExistVar []] let resultExpr = p.arg.asIdentifier - Some resultExpr, [lm.uper.sequence_build resultExpr (typeDefinition.longTypedefName2 lm.lg.hasModules) (existSeq@childrenResultExpr)] + 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 seqContent = (saveInitialBitStrmStatements@childrenStatements@(post_encoding_function |> Option.toList)@seqBuild@proof) |> nestChildItems lm codec - let seqContent = (saveInitialBitStrmStatements@childrenStatements@(post_encoding_function |> Option.toList)@seqBuild) |> nestChildItems lm codec match existsAcnChildWithNoUpdates with | [] -> match seqContent with @@ -2181,9 +2183,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); 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; 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); 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; icdResult = Some icd}), ns | errChild::_ -> let determinantUsage = @@ -2236,7 +2238,6 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel | true -> acnChildren@alwaysAbsentChildren //in Spark, we have to cover all cases even the ones that are always absent due to SPARK strictness - let nMin = 0I let nMax = BigInteger(Seq.length acnChildren) - 1I //let nBits = (GetNumberOfBitsForNonNegativeInteger (nMax-nMin)) let nIndexSizeInBits = (GetNumberOfBitsForNonNegativeInteger (BigInteger (acnChildren.Length - 1))) @@ -2307,7 +2308,7 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel | true -> childIcdTas.createRowsFunc c.Name.Value optionality childComments | false -> let sType = TypeHash childIcdTas.hash - let icdRow = [{IcdRow.fieldName = c.Name.Value; comments = comments; sPresent=optionality;sType=sType; sConstraint=None; minLengthInBits = c.chType.acnMinSizeInBits; maxLengthInBits=c.chType.acnMaxSizeInBits;sUnits=None; rowType = IcdRowType.LengthDeterminantRow; idxOffset = None}] + let icdRow = [{IcdRow.fieldName = c.Name.Value; comments = comments; sPresent=optionality;sType=sType; sConstraint=None; minLengthInBits = c.chType.acnMinSizeInBits; maxLengthInBits=c.chType.acnMaxSizeInBits;sUnits=None; rowType = IcdRowType.LengthDeterminantRow; idxOffset = None}] let compChild = [childIcdTas] icdRow, compChild |None -> [],[]) |> List.unzip @@ -2326,7 +2327,12 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let handleChild (us:State) (idx:int) (child:ChChildInfo) = let chFunc = child.chType.getAcnFunction codec let sChildInitExpr = child.chType.initFunction.initExpression - let childNestingScope = {nestingScope with nestingLevel = nestingScope.nestingLevel + 1I; uperSiblingMaxSize = Some uperSiblingMaxSize; acnSiblingMaxSize = Some acnSiblingMaxSize} + let childNestingScope = + {nestingScope with + nestingLevel = nestingScope.nestingLevel + 1I + uperSiblingMaxSize = Some uperSiblingMaxSize + acnSiblingMaxSize = Some acnSiblingMaxSize + parents = (p, t) :: nestingScope.parents} let childContentResult, ns1 = match chFunc with | Some chFunc -> @@ -2337,11 +2343,11 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel chFunc.funcBody us [] childNestingScope childP | None -> None, us - let childContent_funcBody, childContent_localVariables, childContent_errCodes = + let childContent_funcBody, childContent_localVariables, childContent_errCodes, auxiliaries = match childContentResult with | None -> match codec with - | Encode -> lm.lg.emptyStatement, [], [] + | Encode -> lm.lg.emptyStatement, [], [], [] | Decode -> let childp = match lm.lg.acn.choice_requires_tmp_decoding with @@ -2353,11 +2359,11 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel | Sequence _ -> lm.lg.decodeEmptySeq (childp.arg.joined lm.lg) | _ -> None match decStatement with - | None -> lm.lg.emptyStatement,[], [] + | None -> lm.lg.emptyStatement,[], [], [] | Some ret -> - ret ,[],[] + ret ,[],[],[] - | Some childContent -> childContent.funcBody, childContent.localVariables, childContent.errCodes + | Some childContent -> childContent.funcBody, childContent.localVariables, childContent.errCodes, childContent.auxiliaries let childBody = let sChildName = (lm.lg.getAsn1ChChildBackendName child) @@ -2410,14 +2416,15 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let conds = child.acnPresentWhenConditions |>List.map handPresenceCond let pp, _ = joinedOrAsIdentifier lm codec p Some (choiceChild_preWhen pp (lm.lg.getAccess p.arg) (lm.lg.presentWhenName (Some defOrRef) child) childContent_funcBody conds (idx=0) sChildName sChildTypeDef sChoiceTypeName sChildInitExpr codec) - [(childBody, childContent_localVariables, childContent_errCodes, childContentResult |> Option.bind (fun ch -> ch.typeEncodingKind))], ns1 + [(childBody, childContent_localVariables, childContent_errCodes, childContentResult |> Option.bind (fun ch -> ch.typeEncodingKind), auxiliaries)], ns1 let childrenStatements00, ns = children |> List.mapi (fun i x -> i,x) |> foldMap (fun us (i,x) -> handleChild us i x) us let childrenStatements0 = childrenStatements00 |> List.collect id - let childrenStatements = childrenStatements0 |> List.choose(fun (s,_,_,_) -> s) - let childrenLocalvars = childrenStatements0 |> List.collect(fun (_,s,_,_) -> s) - let childrenErrCodes = childrenStatements0 |> List.collect(fun (_,_,s,_) -> s) - let childrenTypeKindEncoding = childrenStatements0 |> List.map(fun (_,_,_,s) -> s) + let childrenStatements = childrenStatements0 |> List.choose(fun (s,_,_,_,_) -> s) + let childrenLocalvars = childrenStatements0 |> List.collect(fun (_,s,_,_,_) -> s) + let childrenErrCodes = childrenStatements0 |> List.collect(fun (_,_,s,_,_) -> s) + let childrenTypeKindEncoding = childrenStatements0 |> List.map(fun (_,_,_,s, _) -> s) + let childrenAuxiliaries = childrenStatements0 |> List.collect(fun (_,_,_,_,a) -> a) let choiceContent, resultExpr = let pp, resultExpr = joinedOrAsIdentifier lm codec p @@ -2429,7 +2436,8 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let extField = getExternalField r deps t.id choice_Enum pp access childrenStatements extField errCode.errCodeName codec, resultExpr | CEC_presWhen -> choice_preWhen pp access childrenStatements errCode.errCodeName codec, resultExpr - Some ({AcnFuncBodyResult.funcBody = choiceContent; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (ChoiceEncodingType childrenTypeKindEncoding); icdResult = Some icd}), ns + 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 soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) @@ -2440,7 +2448,7 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel 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) = let baseTypeDefinitionName, baseFncName = getBaseFuncName lm typeDefinition o t.id "_ACN" codec - + let td = lm.lg.getTypeDefinition t.FT_TypeDefinition let getNewSType (r:IcdRow) = let newType = @@ -2467,7 +2475,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF | None -> let icdFnc fieldName sPresent comments = [],[] icdFnc, [], name - + | Some encOptions -> let lengthDetRow = match encOptions.acnEncodingClass with @@ -2479,7 +2487,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF match baseType.icdTas with | Some baseTypeIcdTas -> let icdFnc fieldName sPresent comments = - let rows0, compChildren = baseTypeIcdTas.createRowsFunc fieldName sPresent comments + let rows0, compChildren = baseTypeIcdTas.createRowsFunc fieldName sPresent comments let rows = rows0 |> List.map getNewSType lengthDetRow@rows |> List.mapi(fun i r -> {r with idxOffset = Some (i+1)}), compChildren icdFnc, ("OCTET STING CONTAINING BY"::baseTypeIcdTas.comments), Some (t.id.AsString.RDD + "_OCT_STR" ) @@ -2488,7 +2496,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF icdFnc, [], None - let icd = + let icd = match baseType.icdTas with | Some baseTypeIcdTas -> Some {IcdArgAux.canBeEmbedded = baseTypeIcdTas.canBeEmbedded; baseAsn1Kind = (getASN1Name t); rowsFunc = icdFnc; commentsForTas=extraComment; scope="REFTYPE"; name=name} @@ -2523,7 +2531,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF toc, Some toc | _ -> str, None let funcBodyContent = callBaseTypeFunc lm pp baseFncName codec - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ReferenceEncodingType baseTypeDefinitionName); icdResult = icd}), us + Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ReferenceEncodingType baseTypeDefinitionName); auxiliaries=[]; icdResult = icd}), us let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) @@ -2593,7 +2601,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF let fncBody = bit_string_containing_func pp baseFncName sReqBytesForUperEncoding sReqBitForUperEncoding nBits encOptions.minSize.acn encOptions.maxSize.acn false codec fncBody, [errCode],[] | SZ_EC_TerminationPattern nullVal , _ -> raise(SemanticError (loc, "Invalid type for parameter4")) - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ReferenceEncodingType baseTypeDefinitionName); icdResult = icd}) + 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 diff --git a/BackendAst/DAstConstruction.fs b/BackendAst/DAstConstruction.fs index 5e003c813..f57bea338 100644 --- a/BackendAst/DAstConstruction.fs +++ b/BackendAst/DAstConstruction.fs @@ -81,18 +81,26 @@ let private createAcnChild (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps: | Asn1AcnAst.AcnReferenceToIA5String s -> lm.lg.initializeString (int (s.str.maxSize.acn + 1I)) + let rec dealiasDeps (dep: Asn1AcnAst.AcnDependency): Asn1AcnAst.AcnDependency = + match dep.dependencyKind with + | Asn1AcnAst.AcnDepRefTypeArgument param -> + let dealiased = dealiasDeps (deps.acnDependencies |> List.find (fun dep -> dep.determinant.id = param.id)) + {dep with dependencyKind = dealiased.dependencyKind} + | _ -> dep + + let dealiasedDeps = deps.acnDependencies |> List.filter(fun d -> d.determinant.id = ch.id) |> List.map dealiasDeps let ret = { - - AcnChild.Name = ch.Name - id = ch.id - c_name = c_name - Type = ch.Type + AcnChild.Name = ch.Name + id = ch.id + c_name = c_name + Type = ch.Type typeDefinitionBodyWithinSeq = tdBodyWithinSeq - funcBody = DAstACN.handleAlignmentForAcnTypes r lm acnAlignment newFuncBody - funcUpdateStatement = funcUpdateStatement - Comments = ch.Comments - initExpression = initExpression + funcBody = DAstACN.handleAlignmentForAcnTypes r lm acnAlignment newFuncBody + funcUpdateStatement = funcUpdateStatement + Comments = ch.Comments + deps = { acnDependencies = dealiasedDeps } + initExpression = initExpression } AcnChild ret, ns3 @@ -556,7 +564,7 @@ let private createTimeType (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1Ac let private createSequenceOf (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.SequenceOf) (childType:Asn1Type, us:State) = let newPrms, us0 = t.acnParameters |> foldMap(fun ns p -> mapAcnParameter r deps lm m t p ns) us - let defOrRef = DAstTypeDefinition.createSequenceOf_u r lm t o childType.typeDefinitionOrReference us0 + let defOrRef = DAstTypeDefinition.createSequenceOf_u r lm t o childType us0 //let typeDefinition = DAstTypeDefinition.createSequenceOf r l t o childType.typeDefinition us0 let equalFunction = DAstEqual.createSequenceOfEqualFunction r lm t o defOrRef childType let initFunction = DAstInitialize.createSequenceOfInitFunc r lm t o defOrRef childType @@ -607,9 +615,9 @@ let private createAsn1Child (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (m:Asn1A _ada_name = ch._ada_name Type = newChildType Optionality = ch.Optionality + // acnArgs = ch.acnArgs Comments = ch.Comments |> Seq.toArray isEqualBodyStats = DAstEqual.isEqualBodySequenceChild lm ch newChildType - //isValidBodyStats = DAstValidate.isValidSequenceChild l ch newChildType } Asn1Child ret, us diff --git a/BackendAst/DAstInitialize.fs b/BackendAst/DAstInitialize.fs index 65f7d0922..7b371c7f1 100644 --- a/BackendAst/DAstInitialize.fs +++ b/BackendAst/DAstInitialize.fs @@ -170,8 +170,8 @@ let getFuncName2 (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (typeDefinition:Typ getFuncNameGeneric typeDefinition (lm.init.methodNameSuffix()) -let createInitFunctionCommon (r: Asn1AcnAst.AstRoot) (lm: LanguageMacros) (o: Asn1AcnAst.Asn1Type) - (typeDefinition:TypeDefinitionOrReference) initByAsn1Value (initTasFunction: CallerScope -> InitFunctionResult) +let createInitFunctionCommon (r: Asn1AcnAst.AstRoot) (lm: LanguageMacros) (o: Asn1AcnAst.Asn1Type) + (typeDefinition:TypeDefinitionOrReference) initByAsn1Value (initTasFunction: CallerScope -> InitFunctionResult) automaticTestCases (initExpression: string) (initExpressionGlobal: string) (nonEmbeddedChildrenFuncs: InitFunction list) (user_aux_functions: (string*string) list) (funcDefAnnots: string list) = let funcName = getFuncName2 r lm typeDefinition @@ -222,23 +222,25 @@ let createIntegerInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn let initInteger = lm.init.initInteger let funcBody (p:CallerScope) (v:Asn1ValueKind) = + let resVar = p.arg.asIdentifier let vl = match v.ActualValue with | IntegerValue iv -> iv | _ -> raise(BugErrorException "UnexpectedValue") - initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString vl o.intClass) p.arg.isOptional + initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString vl o.intClass) p.arg.isOptional resVar let integerVals = EncodeDecodeTestCase.IntegerAutomaticTestCaseValues r t o let allCons = DastValidate2.getIntSimplifiedConstraints r o.isUnsigned o.AllCons let isZeroAllowed = isValidValueRanged allCons 0I - let tasInitFunc (p:CallerScope) = + let tasInitFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier match isZeroAllowed with | false -> match integerVals with - |x::_ -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString x o.intClass) p.arg.isOptional; localVariables=[]} - | [] -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString 0I o.intClass) p.arg.isOptional; localVariables=[]} - | true -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString 0I o.intClass) p.arg.isOptional; localVariables=[]} + |x::_ -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString x o.intClass) p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} + | [] -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString 0I o.intClass) p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} + | true -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString 0I o.intClass) p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} let constantInitExpression = match isZeroAllowed with | false -> @@ -251,8 +253,9 @@ let createIntegerInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn let testCaseFuncs = integerVals |> List.map (fun vl -> - let initTestCaseFunc = - (fun (p:CallerScope) -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValueUnchecked p.arg PartialAccess) (lm.lg.intValueToString vl o.intClass) p.arg.isOptional; localVariables=[]} ) + let initTestCaseFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = initInteger (lm.lg.getValueUnchecked p.arg PartialAccess) (lm.lg.intValueToString vl o.intClass) p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] } ) createInitFunctionCommon r lm t typeDefinition funcBody tasInitFunc testCaseFuncs constantInitExpression constantInitExpression [] [] [] @@ -260,26 +263,30 @@ let createIntegerInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn let createRealInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.Real) (typeDefinition:TypeDefinitionOrReference) = let initReal = lm.init.initReal let funcBody (p:CallerScope) (v:Asn1ValueKind) = + let resVar = p.arg.asIdentifier let vl = match v.ActualValue with | RealValue iv -> iv | _ -> raise(BugErrorException "UnexpectedValue") - initReal (lm.lg.getValue p.arg) vl p.arg.isOptional + initReal (lm.lg.getValue p.arg) vl p.arg.isOptional resVar let realVals = EncodeDecodeTestCase.RealAutomaticTestCaseValues r t o let testCaseFuncs = realVals |> List.map (fun vl -> - let initTestCaseFunc = (fun (p:CallerScope) -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) vl p.arg.isOptional; localVariables=[]}) + let initTestCaseFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) vl p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] } ) let isZeroAllowed = isValidValueRanged o.AllCons 0.0 let tasInitFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier match isZeroAllowed with | false -> match realVals with - | x::_ -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) x p.arg.isOptional; localVariables=[]} - | [] -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) 0.0 p.arg.isOptional; localVariables=[]} - | true -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) 0.0 p.arg.isOptional; localVariables=[]} + | x::_ -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) x p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} + | [] -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) 0.0 p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} + | true -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) 0.0 p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} let constantInitExpression = match isZeroAllowed with @@ -312,13 +319,14 @@ let createIA5StringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A let funcBody (p:CallerScope) (v:Asn1ValueKind) = + let resVar = p.arg.asIdentifier let vl = match v.ActualValue with | StringValue iv -> iv | _ -> raise(BugErrorException "UnexpectedValue") let tlLit = DAstVariables.convertStringValue2TargetLangStringLiteral lm (int o.maxSize.uper) vl - initIA5String (lm.lg.getValue p.arg) tlLit p.arg.isOptional + initIA5String (lm.lg.getValue p.arg) tlLit p.arg.isOptional resVar let ii = t.id.SequenceOfLevel + 1 let i = sprintf "i%d" ii @@ -327,9 +335,10 @@ let createIA5StringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A let testCaseFuncs = let seqOfCase (nSize:BigInteger) = let initTestCaseFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier let td = strTypeDef.longTypedefName2 (lm.lg.hasModules) (ToC p.modName) - let funcBody = initTestCaseIA5String (p.arg.joinedUnchecked lm.lg FullAccess) (lm.lg.getAccess p.arg) (nSize) ((o.maxSize.uper+1I)) i td bAlpha arrAsciiCodes (BigInteger arrAsciiCodes.Length) false - {InitFunctionResult.funcBody = funcBody; localVariables=[SequenceOfIndex (ii, None)]} + let funcBody = initTestCaseIA5String (p.arg.joinedUnchecked lm.lg FullAccess) (lm.lg.getAccess p.arg) (nSize) ((o.maxSize.uper+1I)) i td bAlpha arrAsciiCodes (BigInteger arrAsciiCodes.Length) false resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables=[SequenceOfIndex (ii, None)]} {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = Map.ofList [(t.id, TcvSizeableTypeValue nSize)] } seq { match o.minSize.uper = o.maxSize.uper with @@ -343,10 +352,12 @@ let createIA5StringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A | false -> () } |> Seq.toList let zero (p:CallerScope) = + let resVar = p.arg.asIdentifier let td = strTypeDef.longTypedefName2 (lm.lg.hasModules) (ToC p.modName) - let funcBody = initTestCaseIA5String (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) ( (o.maxSize.uper+1I)) ( (o.maxSize.uper+1I)) i td bAlpha arrAsciiCodes (BigInteger arrAsciiCodes.Length) true + let funcBody = initTestCaseIA5String (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) ( (o.maxSize.uper+1I)) ( (o.maxSize.uper+1I)) i td bAlpha arrAsciiCodes (BigInteger arrAsciiCodes.Length) true resVar let lvars = lm.lg.init.zeroIA5String_localVars ii - {InitFunctionResult.funcBody = funcBody; localVariables=lvars} + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables=lvars} let constantInitExpression = lm.lg.initializeString (int o.maxSize.uper) createInitFunctionCommon r lm t typeDefinition funcBody zero testCaseFuncs constantInitExpression constantInitExpression [] [] [] @@ -385,8 +396,9 @@ let createOctetStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn let i = sprintf "i%d" ii let seqOfCase (nSize:BigInteger) = let initTestCaseFunc (p:CallerScope) = - let funcBody = initTestCaseOctetString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName nSize i (o.minSize.uper = o.maxSize.uper) false o.minSize.uper (nSize = 0I) - {InitFunctionResult.funcBody = funcBody; localVariables=[SequenceOfIndex (ii, None)]} + let resVar = p.arg.asIdentifier + let funcBody = initTestCaseOctetString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName nSize i (o.minSize.uper = o.maxSize.uper) false o.minSize.uper (nSize = 0I) resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables=[SequenceOfIndex (ii, None)]} {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = Map.ofList [(t.id, TcvSizeableTypeValue nSize)] } let testCaseFuncs = seq { @@ -401,6 +413,7 @@ let createOctetStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn | false -> () } |> Seq.toList let zero (p:CallerScope) = + let resVar = p.arg.asIdentifier let isFixedSize = match t.getBaseType r with | None -> o.isFixedSize @@ -408,9 +421,9 @@ let createOctetStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn match bs.Kind with | Asn1AcnAst.OctetString bo -> bo.isFixedSize | _ -> raise(BugErrorException "UnexpectedType") - let funcBody = initTestCaseOctetString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName o.maxSize.uper i (isFixedSize) true o.minSize.uper (o.maxSize.uper = 0I) + let funcBody = initTestCaseOctetString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName o.maxSize.uper i (isFixedSize) true o.minSize.uper (o.maxSize.uper = 0I) resVar let lvars = lm.lg.init.zeroIA5String_localVars ii - {InitFunctionResult.funcBody = funcBody; localVariables=lvars} + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables=lvars} testCaseFuncs, zero | _ -> @@ -418,8 +431,9 @@ let createOctetStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn anonyms |> List.map(fun (compLit) -> let initTestCaseFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier let ret = sprintf "%s%s%s;" (lm.lg.getValue p.arg) lm.lg.AssignOperator compLit - {InitFunctionResult.funcBody = ret; localVariables=[]} + {InitFunctionResult.funcBody = ret; resultVar = resVar; localVariables=[]} {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] }) ret, ret.Head.initTestCaseFunc @@ -432,9 +446,16 @@ let createOctetStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn let createNullTypeInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.NullType) (typeDefinition:TypeDefinitionOrReference) = let initNull = lm.init.initNull - let funcBody (p:CallerScope) v = initNull (lm.lg.getValue p.arg) p.arg.isOptional + let funcBody (p:CallerScope) v = + let resVar = p.arg.asIdentifier + initNull (lm.lg.getValue p.arg) p.arg.isOptional resVar let constantInitExpression = "0" - let testCaseFuncs: AutomaticTestCase list = [{AutomaticTestCase.initTestCaseFunc = (fun p -> {InitFunctionResult.funcBody = initNull (lm.lg.getValueUnchecked p.arg PartialAccess) p.arg.isOptional; localVariables=[]}); testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)]} ] + let testCaseFuncs: AutomaticTestCase list = + [{AutomaticTestCase.initTestCaseFunc = + (fun p -> + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = initNull (lm.lg.getValueUnchecked p.arg PartialAccess) p.arg.isOptional resVar; resultVar = resVar; localVariables=[]}); + testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)]}] createInitFunctionCommon r lm t typeDefinition funcBody testCaseFuncs.Head.initTestCaseFunc testCaseFuncs constantInitExpression constantInitExpression [] [] [] let createBitStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.BitString ) (typeDefinition:TypeDefinitionOrReference) (isValidFunction:IsValidFunction option)= @@ -468,9 +489,10 @@ let createBitStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Ac let i = sprintf "i%d" ii let seqOfCase (nSize:BigInteger) = let initTestCaseFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier let nSizeCeiled = if nSize % 8I = 0I then nSize else (nSize + (8I - nSize % 8I)) - let funcBody = initTestCaseBitString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName nSize (nSizeCeiled) i (o.minSize.uper = o.maxSize.uper) false o.minSize.uper p.arg.isOptional - {InitFunctionResult.funcBody = funcBody; localVariables=[SequenceOfIndex (ii, None)]} + let funcBody = initTestCaseBitString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName nSize (nSizeCeiled) i (o.minSize.uper = o.maxSize.uper) false o.minSize.uper p.arg.isOptional resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables=[SequenceOfIndex (ii, None)]} {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = Map.ofList [(t.id, TcvSizeableTypeValue nSize)] } let testCaseFuncs = @@ -486,6 +508,7 @@ let createBitStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Ac | false -> () } |> Seq.toList let zero (p:CallerScope) = + let resVar = p.arg.asIdentifier let nSize = o.maxSize.uper let nSizeCeiled = if nSize % 8I = 0I then nSize else (nSize + (8I - nSize % 8I)) let isFixedSize = @@ -496,17 +519,18 @@ let createBitStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Ac | Asn1AcnAst.BitString bo -> bo.isFixedSize | _ -> raise(BugErrorException "UnexpectedType") - let funcBody = initTestCaseBitString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName nSize (nSizeCeiled) i (isFixedSize) true o.minSize.uper p.arg.isOptional + let funcBody = initTestCaseBitString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName nSize (nSizeCeiled) i (isFixedSize) true o.minSize.uper p.arg.isOptional resVar let lvars = lm.lg.init.zeroIA5String_localVars ii - {InitFunctionResult.funcBody = funcBody; localVariables=lvars} + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables=lvars} testCaseFuncs, zero | _ -> let ret = anonyms |> List.map(fun compLit -> let retFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier let ret = sprintf "%s%s%s;" (lm.lg.getValue p.arg) lm.lg.AssignOperator compLit - {InitFunctionResult.funcBody = ret; localVariables=[]} + {InitFunctionResult.funcBody = ret; resultVar = resVar; localVariables=[]} {AutomaticTestCase.initTestCaseFunc = retFunc; testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] }) ret, ret.Head.initTestCaseFunc @@ -537,23 +561,26 @@ let createBitStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Ac let createBooleanInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.Boolean ) (typeDefinition:TypeDefinitionOrReference) = let initBoolean = lm.init.initBoolean let funcBody (p:CallerScope) (v:Asn1ValueKind) = + let resVar = p.arg.asIdentifier let vl = match v.ActualValue with | BooleanValue iv -> iv | _ -> raise(BugErrorException "UnexpectedValue") - initBoolean (lm.lg.getValue p.arg) vl p.arg.isOptional + initBoolean (lm.lg.getValue p.arg) vl p.arg.isOptional resVar let initTestCaseFunc (vl: bool) (p: CallerScope) = - {InitFunctionResult.funcBody = initBoolean (lm.lg.getValueUnchecked p.arg PartialAccess) vl p.arg.isOptional; localVariables = []} + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = initBoolean (lm.lg.getValueUnchecked p.arg PartialAccess) vl p.arg.isOptional resVar; resultVar = resVar; localVariables = []} let testCaseFuncs = EncodeDecodeTestCase.BooleanAutomaticTestCaseValues r t o |> List.map (fun vl -> {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc vl; testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] }) let tasInitFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier match isValidValueGeneric o.AllCons (=) false with - | true -> {InitFunctionResult.funcBody = initBoolean (lm.lg.getValue p.arg) false p.arg.isOptional; localVariables = []} - | false -> {InitFunctionResult.funcBody = initBoolean (lm.lg.getValue p.arg) true p.arg.isOptional; localVariables = []} + | true -> {InitFunctionResult.funcBody = initBoolean (lm.lg.getValue p.arg) false p.arg.isOptional resVar; resultVar = resVar; localVariables = []} + | false -> {InitFunctionResult.funcBody = initBoolean (lm.lg.getValue p.arg) true p.arg.isOptional resVar; resultVar = resVar; localVariables = []} let constantInitExpression = lm.lg.FalseLiteral createInitFunctionCommon r lm t typeDefinition funcBody tasInitFunc testCaseFuncs constantInitExpression constantInitExpression [] [] [] @@ -573,11 +600,13 @@ let createObjectIdentifierInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t EncodeDecodeTestCase.ObjectIdentifierAutomaticTestCaseValues r t o |> List.map (fun vl -> {AutomaticTestCase.initTestCaseFunc = (fun (p:CallerScope) -> + let resVar = p.arg.asIdentifier let arrsBytes = vl |> List.mapi(fun i b -> initObjectIdentifier_valid (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) ((i+lm.lg.ArrayStartIndex).ToString()) b) - {InitFunctionResult.funcBody = initObjectIdentifier (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (BigInteger vl.Length) arrsBytes; localVariables = []}); testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] }) + {InitFunctionResult.funcBody = initObjectIdentifier (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (BigInteger vl.Length) arrsBytes; resultVar = resVar; localVariables = []}); testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] }) - let tasInitFunc (p:CallerScope) = - {InitFunctionResult.funcBody = initObjectIdentifier (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) 0I []; localVariables = []} + let tasInitFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = initObjectIdentifier (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) 0I []; resultVar = resVar; localVariables = []} let constantInitExpression = lm.init.initObjectIdentifierAsExpr () createInitFunctionCommon r lm t typeDefinition funcBody tasInitFunc testCaseFuncs constantInitExpression constantInitExpression [] [] [] @@ -611,10 +640,12 @@ let createTimeTypeInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Ac atvs |> List.map (fun vl -> {AutomaticTestCase.initTestCaseFunc = (fun (p:CallerScope) -> - {InitFunctionResult.funcBody = initByValue p vl; localVariables = []}); testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] }) + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = initByValue p vl; resultVar = resVar; localVariables = []}); testCaseTypeIDsMap = Map.ofList [(t.id, TcvAnyValue)] }) - let tasInitFunc (p:CallerScope) = - {InitFunctionResult.funcBody = initByValue p atvs.Head; localVariables = []} + let tasInitFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = initByValue p atvs.Head; resultVar = resVar; localVariables = []} let constantInitExpression = match o.timeClass with |Asn1LocalTime _-> lm.init.init_Asn1LocalTimeExpr () @@ -633,20 +664,24 @@ let mergeMaps (m1:Map<'key,'value>) (m2:Map<'key,'value>) = let createEnumeratedInitFunc (r: Asn1AcnAst.AstRoot) (lm: LanguageMacros) (t: Asn1AcnAst.Asn1Type) (o: Asn1AcnAst.Enumerated) (typeDefinition: TypeDefinitionOrReference) iv = let initEnumerated = lm.init.initEnumerated + let tdName = typeDefinition.longTypedefName2 lm.lg.hasModules let funcBody (p:CallerScope) (v:Asn1ValueKind) = + let resVar = p.arg.asIdentifier let vl = match v.ActualValue with | EnumValue iv -> o.items |> Seq.find(fun x -> x.Name.Value = iv) | _ -> raise(BugErrorException "UnexpectedValue") - initEnumerated (lm.lg.getValue p.arg) (lm.lg.getNamedItemBackendName (Some typeDefinition) vl) p.arg.isOptional + initEnumerated (lm.lg.getValue p.arg) (lm.lg.getNamedItemBackendName (Some typeDefinition) vl) tdName p.arg.isOptional resVar let testCaseFuncs = EncodeDecodeTestCase.EnumeratedAutomaticTestCaseValues2 r t o |> List.map (fun vl -> { - AutomaticTestCase.initTestCaseFunc = (fun (p:CallerScope) -> {InitFunctionResult.funcBody = initEnumerated (lm.lg.getValue p.arg) (lm.lg.getNamedItemBackendName (Some typeDefinition) vl) p.arg.isOptional; localVariables=[]}); - testCaseTypeIDsMap = Map.ofList [(t.id, (TcvEnumeratedValue vl.Name.Value))] - + AutomaticTestCase.initTestCaseFunc = + (fun (p:CallerScope) -> + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = initEnumerated (lm.lg.getValue p.arg) (lm.lg.getNamedItemBackendName (Some typeDefinition) vl) tdName p.arg.isOptional resVar; resultVar = resVar; localVariables=[]}); + testCaseTypeIDsMap = Map.ofList [(t.id, (TcvEnumeratedValue vl.Name.Value))] }) let constantInitExpression = lm.lg.getNamedItemBackendName (Some typeDefinition) o.items.Head createInitFunctionCommon r lm t typeDefinition funcBody testCaseFuncs.Head.initTestCaseFunc testCaseFuncs constantInitExpression constantInitExpression [] [] [] @@ -687,7 +722,7 @@ let createSequenceOfInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A match o.isFixedSize with | true -> initFixedSequenceOf vl | false -> initVarSizeSequenceOf (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (BigInteger vl.Length) vl - + let tdName = typeDefinition.longTypedefName2 lm.lg.hasModules let ii = t.id.SequenceOfLevel + 1 let i = sprintf "i%d" (t.id.SequenceOfLevel + 1) let testCaseFuncs = @@ -695,26 +730,34 @@ let createSequenceOfInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A match childTestCases with | [] -> let initTestCaseFunc (p:CallerScope) = - {InitFunctionResult.funcBody = ""; localVariables = []} + let resVar = p.arg.asIdentifier + {InitFunctionResult.funcBody = ""; resultVar = resVar; localVariables = []} {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = Map.ofList [(t.id, TcvSizeableTypeValue nSize)] } | atc::[] -> let initTestCaseFunc (p:CallerScope) = - let childCase = atc.initTestCaseFunc ({p with arg = lm.lg.getArrayItem p.arg i childType.isIA5String}) - let funcBody = initTestCaseSizeSequenceOf (p.arg.joinedUnchecked lm.lg FullAccess) (lm.lg.getAccess p.arg) None nSize (o.minSize.uper = o.maxSize.uper) [childCase.funcBody] false i - {InitFunctionResult.funcBody = funcBody; localVariables= (SequenceOfIndex (ii, None))::childCase.localVariables } + let resVar = p.arg.asIdentifier + let chp = {p with arg = lm.lg.getArrayItem p.arg i childType.isIA5String} + let childCase = atc.initTestCaseFunc chp + let childBody = + if lm.lg.decodingKind = Copy then childCase.funcBody + "\n" + chp.arg.asIdentifier + else childCase.funcBody + let funcBody = initTestCaseSizeSequenceOf (p.arg.joinedUnchecked lm.lg FullAccess) (lm.lg.getAccess p.arg) tdName None nSize (o.minSize.uper = o.maxSize.uper) [childBody] false i resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables= (SequenceOfIndex (ii, None))::childCase.localVariables } let combinedTestCase = atc.testCaseTypeIDsMap.Add(t.id, TcvSizeableTypeValue nSize) {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = combinedTestCase } | _ -> let initTestCaseFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier let arrsInnerItems, childLocalVars = childTestCases |> List.mapi(fun idx atc -> - let sChildItem = atc.initTestCaseFunc ({p with arg = lm.lg.getArrayItem p.arg i childType.isIA5String}) - let funcBody = initTestCaseSizeSequenceOf_innerItem (idx=0) (idx = childTestCases.Length-1) idx.AsBigInt sChildItem.funcBody i (BigInteger childTestCases.Length) + let chp = {p with arg = lm.lg.getArrayItem p.arg i childType.isIA5String} + let sChildItem = atc.initTestCaseFunc chp + let funcBody = initTestCaseSizeSequenceOf_innerItem (idx=0) (idx = childTestCases.Length-1) idx.AsBigInt sChildItem.funcBody i (BigInteger childTestCases.Length) chp.arg.asIdentifier (funcBody, (SequenceOfIndex (ii, None))::sChildItem.localVariables)) |> List.unzip - let funcBody = initTestCaseSizeSequenceOf (p.arg.joinedUnchecked lm.lg FullAccess) (lm.lg.getAccess p.arg) None nSize (o.minSize.uper = o.maxSize.uper) arrsInnerItems true i - {InitFunctionResult.funcBody = funcBody; localVariables= (SequenceOfIndex (ii, None))::(childLocalVars |> List.collect id)} + let funcBody = initTestCaseSizeSequenceOf (p.arg.joinedUnchecked lm.lg FullAccess) (lm.lg.getAccess p.arg) tdName None nSize (o.minSize.uper = o.maxSize.uper) arrsInnerItems true i resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables= (SequenceOfIndex (ii, None))::(childLocalVars |> List.collect id)} let combinedTestCase = let thisCase = Map.ofList [(t.id, TcvSizeableTypeValue nSize)] childTestCases |> List.fold(fun (newMap:Map) atc -> mergeMaps newMap atc.testCaseTypeIDsMap) thisCase @@ -755,6 +798,7 @@ let createSequenceOfInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A let initTasFunction, nonEmbeddedChildrenFuncs = let initTasFunction (p:CallerScope) = + let resVar = p.arg.asIdentifier let initCountValue = Some o.minSize.uper let chp = {p with arg = lm.lg.getArrayItem p.arg i childType.isIA5String} let childInitRes_funcBody, childInitRes_localVariables = @@ -772,8 +816,8 @@ let createSequenceOfInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A | Asn1AcnAst.SequenceOf bo -> bo.isFixedSize | _ -> raise(BugErrorException "UnexpectedType") - let funcBody = initTestCaseSizeSequenceOf (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) initCountValue o.maxSize.uper (isFixedSize) [childInitRes_funcBody] false i - {InitFunctionResult.funcBody = funcBody; localVariables= (SequenceOfIndex (ii, None))::childInitRes_localVariables } + let funcBody = initTestCaseSizeSequenceOf (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) tdName initCountValue o.maxSize.uper (isFixedSize) [childInitRes_funcBody] false i resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables= (SequenceOfIndex (ii, None))::childInitRes_localVariables } let nonEmbeddedChildrenFuncs = match childType.initFunction.initProcedure with | None -> [] @@ -801,7 +845,6 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn let initChildWithInitFunc = lm.init.initChildWithInitFunc let initSequence_emptySeq = lm.init.initSequence_emptySeq let initByAsn1ValueFnc (p:CallerScope) (v:Asn1ValueKind) = - let childrenRet = match v.ActualValue with | SeqValue iv -> @@ -830,21 +873,22 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn List.choose(fun c -> match c with Asn1Child x -> Some x | _ -> None) |> List.filter(fun z -> match z.Type.Kind with - | NullType _ -> match z.Optionality with Some Asn1AcnAst.AlwaysPresent -> true | _ -> false + | NullType _ -> match z.Optionality with Some Asn1AcnAst.AlwaysPresent -> true | _ -> lm.lg.decodingKind = Copy // These backends expect the nulltype to be declared in any case | _ -> true) |> - List.filter(fun z -> match z.Optionality with Some Asn1AcnAst.AlwaysAbsent -> false | _ -> true) + List.filter(fun z -> match z.Optionality with Some Asn1AcnAst.AlwaysAbsent -> lm.lg.decodingKind = Copy | _ -> true) - let handleChild (ch:Asn1Child) = - let len = ch.Type.initFunction.automaticTestCases.Length + let handleChild (ch:Asn1Child) = + let childTypeDef = ch.Type.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules ch.Type.initFunction.automaticTestCases |> List.collect(fun atc -> let presentFunc = let initTestCaseFunc (p:CallerScope) = let newArg = lm.lg.getSeqChild p.arg (lm.lg.getAsn1ChildBackendName ch) ch.Type.isIA5String ch.Optionality.IsSome let chP = {p with arg = newArg} + let resVar = chP.arg.asIdentifier let chContent = atc.initTestCaseFunc chP let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent.funcBody ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; localVariables = chContent.localVariables } + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = chContent.localVariables } let combinedTestCase: Map = match atc.testCaseTypeIDsMap.ContainsKey ch.Type.id with | true -> atc.testCaseTypeIDsMap @@ -852,8 +896,10 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = combinedTestCase } let nonPresenceFunc = let initTestCaseFunc (p:CallerScope) = - let funcBody = initTestCase_sequence_child_opt (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) - {InitFunctionResult.funcBody = funcBody; localVariables = [] } + let newArg = lm.lg.getSeqChild p.arg (lm.lg.getAsn1ChildBackendName ch) ch.Type.isIA5String ch.Optionality.IsSome + let resVar = newArg.asIdentifier + let funcBody = initTestCase_sequence_child_opt (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) childTypeDef resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] } {AutomaticTestCase.initTestCaseFunc = initTestCaseFunc; testCaseTypeIDsMap = Map.empty } match ch.Optionality with | None -> [presentFunc] @@ -861,7 +907,7 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn | Some (Asn1AcnAst.AlwaysAbsent) -> [nonPresenceFunc] | Some (Asn1AcnAst.AlwaysPresent) -> [presentFunc] ) - let generateCases (children : Asn1Child list) : AutomaticTestCase list= + let generateCases (children : Asn1Child list): AutomaticTestCase list= let childrenATCs = children |> List.map(fun c -> @@ -876,34 +922,38 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn [0 .. mxAtcs - 1] |> List.map(fun seqTestCaseIndex -> let children_ith_testCase = - childrenATCs |> + childrenATCs |> List.map(fun (c,childCases,ln) -> childCases.[seqTestCaseIndex % ln]) - match children_ith_testCase with - | [] -> raise(BugErrorException "") - | c1::[] -> c1 - | c1::cs -> - cs |> List.fold(fun (st:AutomaticTestCase) (cur:AutomaticTestCase) -> - let combineFnc (p:CallerScope) = - let partA = st.initTestCaseFunc p - let partB = cur.initTestCaseFunc p - let funcBody = [partA.funcBody; partB.funcBody] |> Seq.StrJoin "\n" - {InitFunctionResult.funcBody = funcBody; localVariables = partA.localVariables@partB.localVariables } - let combinedTestCases = mergeMaps st.testCaseTypeIDsMap cur.testCaseTypeIDsMap - {AutomaticTestCase.initTestCaseFunc = combineFnc; testCaseTypeIDsMap = combinedTestCases } ) c1 ) + + let testCaseFunc (p: CallerScope): InitFunctionResult = + let resVar = p.arg.asIdentifier + let children = children_ith_testCase |> List.map (fun atc -> atc.initTestCaseFunc p) + let joinedBodies = children |> List.map (fun c -> c.funcBody) |> Seq.StrJoin "\n" + let bodyRes = + if lm.lg.decodingKind = Copy then + let seqBuild = lm.uper.sequence_build resVar (typeDefinition.longTypedefName2 lm.lg.hasModules) p.arg.isOptional (children |> List.map (fun ch -> ch.resultVar)) + joinedBodies + "\n" + seqBuild + else joinedBodies + {funcBody = bodyRes; resultVar = resVar; localVariables = children |> List.collect (fun c -> c.localVariables)} + + let combinedTestCases = children_ith_testCase |> List.fold (fun map atc -> mergeMaps map atc.testCaseTypeIDsMap) Map.empty + {AutomaticTestCase.initTestCaseFunc = testCaseFunc; testCaseTypeIDsMap = combinedTestCases}) testCases match r.args.generateAutomaticTestCases with - | true -> generateCases asn1Children - | false -> [] + | true -> generateCases asn1Children + | false -> [] let initTasFunction, nonEmbeddedChildrenFuncs = - let handleChild (p:CallerScope) (ch:Asn1Child) : (InitFunctionResult*InitFunction option) = + let handleChild (p:CallerScope) (ch:Asn1Child): (InitFunctionResult*InitFunction option) = + let childTypeDef = ch.Type.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules + let chP = {p with arg = lm.lg.getSeqChild p.arg (lm.lg.getAsn1ChildBackendName ch) ch.Type.isIA5String ch.Optionality.IsSome} + let resVar = chP.arg.asIdentifier let nonEmbeddedChildrenFunc = match lm.lg.initMethod with | Procedure when r.args.generateConstInitGlobals -> None | _ -> Some ch.Type.initFunction let presentFunc (defaultValue : Asn1AcnAst.Asn1Value option) = - let chP = {p with arg = lm.lg.getSeqChild p.arg (lm.lg.getAsn1ChildBackendName ch) ch.Type.isIA5String ch.Optionality.IsSome} match defaultValue with | None -> match ch.Type.initFunction.initProcedure with @@ -913,27 +963,26 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn let fncName = (ch.Type.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules) + (lm.init.methodNameSuffix()) let chContent = initChildWithInitFunc (lm.lg.getPointer chP.arg) (fncName) let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; localVariables = [] }, nonEmbeddedChildrenFunc + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] }, nonEmbeddedChildrenFunc | _ -> let fnc = ch.Type.initFunction.initTas let chContent = fnc chP let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent.funcBody ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; localVariables = chContent.localVariables }, None + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = chContent.localVariables }, None | Some initProc -> let chContent = initChildWithInitFunc (lm.lg.getPointer chP.arg) (initProc.funcName) let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; localVariables = [] }, nonEmbeddedChildrenFunc + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] }, nonEmbeddedChildrenFunc | Some dv -> let fnc = ch.Type.initFunction.initByAsn1Value let chContent = fnc chP (mapValue dv).kind let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; localVariables = [] }, nonEmbeddedChildrenFunc - + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] }, nonEmbeddedChildrenFunc let nonPresenceFunc () = - let funcBody = initTestCase_sequence_child_opt (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) - {InitFunctionResult.funcBody = funcBody; localVariables = [] }, None + let funcBody = initTestCase_sequence_child_opt (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) childTypeDef resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] }, None match ch.Optionality with | None -> presentFunc None | Some (Asn1AcnAst.Optional opt) -> presentFunc opt.defaultValue @@ -941,17 +990,18 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn | Some (Asn1AcnAst.AlwaysPresent) -> presentFunc None let asn1Children = children |> List.choose(fun c -> match c with Asn1Child x -> Some x | _ -> None) let initTasFunction (p:CallerScope) = + let resVar = p.arg.asIdentifier match asn1Children with | [] -> let initEmptySeq = initSequence_emptySeq (p.arg.joined lm.lg) - {InitFunctionResult.funcBody = initEmptySeq; localVariables = []} + {InitFunctionResult.funcBody = initEmptySeq; resultVar = resVar; localVariables = []} | _ -> asn1Children |> List.fold(fun (cr) ch -> let chResult, _ = handleChild p ch let newFuncBody = cr.funcBody + "\n" + chResult.funcBody - {InitFunctionResult.funcBody = newFuncBody; localVariables = cr.localVariables@chResult.localVariables} - ) {InitFunctionResult.funcBody = ""; localVariables = []} + {InitFunctionResult.funcBody = newFuncBody; resultVar = resVar; localVariables = cr.localVariables@chResult.localVariables} + ) {InitFunctionResult.funcBody = ""; resultVar = resVar; localVariables = []} let dummyScope = {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} let nonEmbeddedChildrenFuncs = asn1Children |> List.choose(fun ch -> handleChild dummyScope ch |> snd) initTasFunction, nonEmbeddedChildrenFuncs @@ -1033,6 +1083,7 @@ let createChoiceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAs List.map(fun atc -> let fnc = atc.initTestCaseFunc let presentFunc (p:CallerScope) = + let resVar = p.arg.asIdentifier let childContent_funcBody, childContent_localVariables = let childContent = match ST.lang with @@ -1051,8 +1102,8 @@ let createChoiceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAs | ProgrammingLanguage.Scala -> sChildTypeDef + (lm.init.methodNameSuffix()) + "()" | _ -> (extractDefaultInitValue ch.chType.Kind) - let funcBody = initTestCase_choice_child (p.arg.joinedUnchecked lm.lg PartialAccess) (lm.lg.getAccess p.arg) childContent_funcBody (sChildID p) sChildName sChildTypeDef typeDefinitionName sChildTempVarName sChildTempDefaultInit p.arg.isOptional - {InitFunctionResult.funcBody = funcBody; localVariables = childContent_localVariables} + let funcBody = initTestCase_choice_child (p.arg.joinedUnchecked lm.lg PartialAccess) (lm.lg.getAccess p.arg) childContent_funcBody (sChildID p) sChildName sChildTypeDef typeDefinitionName sChildTempVarName sChildTempDefaultInit p.arg.isOptional resVar + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = childContent_localVariables} let combinedTestCase = match atc.testCaseTypeIDsMap.ContainsKey ch.chType.id with | true -> atc.testCaseTypeIDsMap @@ -1063,7 +1114,8 @@ let createChoiceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAs | true -> children |> //if some alternatives have restricted to always ABSENT (via WITH COMPONENTS constraint) then do not produce a test case for them. - List.filter (fun c -> c.Optionality.IsNone || c.Optionality = (Some Asn1AcnAst.Asn1ChoiceOptionality.ChoiceAlwaysPresent)) |> + // except for backend with COPY semantics since they expect the result to be declared + List.filter (fun c -> c.Optionality.IsNone || c.Optionality = (Some Asn1AcnAst.Asn1ChoiceOptionality.ChoiceAlwaysPresent) || lm.lg.decodingKind = Copy) |> List.collect handleChild | false -> [] @@ -1074,6 +1126,7 @@ let createChoiceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAs let sChildTypeDef = ch.chType.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules let sChildTempVarName = (ToC ch.chType.id.AsString) + "_tmp" let chp = {p with arg = lm.lg.getChChild p.arg (match ST.lang with | ProgrammingLanguage.Scala -> sChildTempVarName | _ -> sChildName) ch.chType.isIA5String} + let resVar = p.arg.asIdentifier // TODO: resVar ok? let sChildID = (lm.lg.presentWhenName (Some typeDefinition) ch) let childContent_funcBody, childContent_localVariables = match ch.chType.initFunction.initProcedure with @@ -1095,10 +1148,10 @@ let createChoiceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAs | true -> initChildWithInitFunc (sChildName + "_tmp") initProc.funcName, [] let funcBody = initChoice (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) childContent_funcBody sChildID sChildName sChildTypeDef typeDefinitionName sChildTempVarName (extractDefaultInitValue ch.chType.Kind) lm.lg.init.choiceComponentTempInit - {InitFunctionResult.funcBody = funcBody; localVariables = childContent_localVariables} + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = childContent_localVariables} match children with | x::_ -> handleChild x - | _ -> {InitFunctionResult.funcBody = ""; localVariables = []} + | _ -> {InitFunctionResult.funcBody = ""; resultVar = p.arg.asIdentifier; localVariables = []} let nonEmbeddedChildrenFuncs = children |> List.choose(fun ch -> @@ -1160,8 +1213,9 @@ let createReferenceType (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst let constantInitExpression = baseFncName + lm.lg.init.initMethSuffix baseType.Kind let constantInitExpressionGlobal = baseGlobalName let initTasFunction (p:CallerScope) = + let resVar = p.arg.asIdentifier let funcBody = initChildWithInitFunc (lm.lg.getPointer p.arg) baseFncName - {InitFunctionResult.funcBody = funcBody; localVariables = []} - createInitFunctionCommon r lm t typeDefinition bs.initByAsn1Value initTasFunction bs.automaticTestCases constantInitExpression constantInitExpressionGlobal nonEmbeddedChildrenFuncs [] [] + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = []} + createInitFunctionCommon r lm t typeDefinition bs.initByAsn1Value initTasFunction bs.automaticTestCases constantInitExpression constantInitExpressionGlobal nonEmbeddedChildrenFuncs [] [] | false -> createInitFunctionCommon r lm t typeDefinition bs.initByAsn1Value bs.initTas bs.automaticTestCases bs.initExpression bs.initExpressionGlobal bs.nonEmbeddedChildrenFuncs [] [] diff --git a/BackendAst/DAstTypeDefinition.fs b/BackendAst/DAstTypeDefinition.fs index 875a80fb9..f7e8c4cdc 100644 --- a/BackendAst/DAstTypeDefinition.fs +++ b/BackendAst/DAstTypeDefinition.fs @@ -177,7 +177,7 @@ let createString (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1T let td = lm.lg.getStrTypeDefinition o.typeDef match td.kind with | NonPrimitiveNewTypeDefinition -> - let completeDefinition = define_new_ia5string td (o.minSize.uper) (o.maxSize.uper) ((o.maxSize.uper + 1I)) arrnAlphaChars + let completeDefinition = define_new_ia5string td o.minSize.uper o.maxSize.uper (o.maxSize.uper + 1I) arrnAlphaChars Some completeDefinition | NonPrimitiveNewSubTypeDefinition subDef -> let otherProgramUnit = if td.programUnit = subDef.programUnit then None else (Some subDef.programUnit) @@ -190,10 +190,11 @@ let createOctetString (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst. let define_new_octet_string = lm.typeDef.Define_new_octet_string let define_subType_octet_string = lm.typeDef.Define_subType_octet_string match td.kind with - | NonPrimitiveNewTypeDefinition -> - let completeDefinition = define_new_octet_string td (o.minSize.uper) (o.maxSize.uper) (o.minSize.uper = o.maxSize.uper) + | NonPrimitiveNewTypeDefinition -> + let invariants = lm.lg.generateOctetStringInvariants t o + let completeDefinition = define_new_octet_string td o.minSize.uper o.maxSize.uper (o.minSize.uper = o.maxSize.uper) invariants Some completeDefinition - | NonPrimitiveNewSubTypeDefinition subDef -> + | NonPrimitiveNewSubTypeDefinition subDef -> let otherProgramUnit = if td.programUnit = subDef.programUnit then None else (Some subDef.programUnit) let completeDefinition = define_subType_octet_string td subDef otherProgramUnit (o.minSize.uper = o.maxSize.uper) Some completeDefinition @@ -220,7 +221,8 @@ let createBitString (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.As let sComment = sprintf "(1 << %A)" nb.resolvedValue define_named_bit td (ToC (nb.Name.Value.ToUpper())) hexValue sComment ) - let completeDefinition = define_new_bit_string td (o.minSize.uper) (o.maxSize.uper) (o.minSize.uper = o.maxSize.uper) (BigInteger o.MaxOctets) nblist + let invariants = lm.lg.generateBitStringInvariants t o + let completeDefinition = define_new_bit_string td o.minSize.uper o.maxSize.uper (o.minSize.uper = o.maxSize.uper) (BigInteger o.MaxOctets) nblist invariants Some completeDefinition | NonPrimitiveNewSubTypeDefinition subDef -> let otherProgramUnit = if td.programUnit = subDef.programUnit then None else (Some subDef.programUnit) @@ -248,7 +250,7 @@ let createEnumerated (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.A match td.kind with | NonPrimitiveNewTypeDefinition -> let completeDefinition = define_new_enumerated td arrsEnumNames arrsEnumNamesAndValues nIndexMax macros - let privateDefinition = + let privateDefinition = match r.args.isEnumEfficientEnabled o.items.Length with | false -> None | true -> @@ -261,7 +263,7 @@ let createEnumerated (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.A | NonPrimitiveNewSubTypeDefinition subDef -> let otherProgramUnit = if td.programUnit = subDef.programUnit then None else (Some subDef.programUnit) let completeDefinition = define_subType_enumerated td subDef otherProgramUnit - let privateDefinition = + let privateDefinition = match r.args.isEnumEfficientEnabled o.items.Length with | false -> None | true -> @@ -278,32 +280,34 @@ let internal getChildDefinition (childDefinition:TypeDefinitionOrReference) = | ReferenceToExistingDefinition ref -> None -let createSequenceOf (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.SequenceOf) (childDefinition:TypeDefinitionOrReference) (us:State) = +let createSequenceOf (r: Asn1AcnAst.AstRoot) (lm: LanguageMacros) (t: Asn1AcnAst.Asn1Type) (o: Asn1AcnAst.SequenceOf) (childType: DAst.Asn1Type) (us: State) = let define_new_sequence_of = lm.typeDef.Define_new_sequence_of let define_subType_sequence_of = lm.typeDef.Define_subType_sequence_of let td = lm.lg.getSizeableTypeDefinition o.typeDef match td.kind with - | NonPrimitiveNewTypeDefinition -> - let completeDefinition = define_new_sequence_of td (o.minSize.uper) (o.maxSize.uper) (o.minSize.uper = o.maxSize.uper) (childDefinition.longTypedefName2 lm.lg.hasModules) (getChildDefinition childDefinition) - let privateDefinition = - match childDefinition with + | NonPrimitiveNewTypeDefinition -> + let invariants = lm.lg.generateSequenceOfInvariants t o childType.Kind + let sizeClsDefinitions, sizeObjDefinitions = lm.lg.generateSequenceOfSizeDefinitions t o childType + let completeDefinition = define_new_sequence_of td o.minSize.uper o.maxSize.uper (o.minSize.uper = o.maxSize.uper) (childType.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules) (getChildDefinition childType.typeDefinitionOrReference) sizeClsDefinitions sizeObjDefinitions invariants + let privateDefinition = + match childType.typeDefinitionOrReference with | TypeDefinition td -> td.privateTypeDefinition | ReferenceToExistingDefinition ref -> None Some (completeDefinition, privateDefinition) - | NonPrimitiveNewSubTypeDefinition subDef -> + | NonPrimitiveNewSubTypeDefinition subDef -> let otherProgramUnit = if td.programUnit = subDef.programUnit then None else (Some subDef.programUnit) - let completeDefinition = define_subType_sequence_of td subDef otherProgramUnit (o.minSize.uper = o.maxSize.uper) (getChildDefinition childDefinition) - let privateDefinition = - match childDefinition with + let completeDefinition = define_subType_sequence_of td subDef otherProgramUnit (o.minSize.uper = o.maxSize.uper) (getChildDefinition childType.typeDefinitionOrReference) + let privateDefinition = + match childType.typeDefinitionOrReference with | TypeDefinition td -> td.privateTypeDefinition | ReferenceToExistingDefinition ref -> None Some (completeDefinition, privateDefinition) - | NonPrimitiveReference2OtherType -> None + | NonPrimitiveReference2OtherType -> None -let createSequence (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Sequence) (allchildren:SeqChildInfo list) (us:State) = +let createSequence (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Sequence) (allchildren: SeqChildInfo list) (us:State) = let define_new_sequence = lm.typeDef.Define_new_sequence let define_new_sequence_child = lm.typeDef.Define_new_sequence_child let define_new_sequence_child_bit = lm.typeDef.Define_new_sequence_child_bit @@ -336,48 +340,49 @@ let createSequence (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1 | false -> children |> List.map (fun o -> define_new_sequence_child (lm.lg.getAsn1ChildBackendName o) (o.Type.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules) o.Optionality.IsSome) let childrenPrivatePart = - children |> + children |> List.choose (fun o -> match o.Type.typeDefinitionOrReference with | TypeDefinition td -> td.privateTypeDefinition | ReferenceToExistingDefinition ref -> None) - let arrsOptionalChildren = optionalChildren |> List.map(fun c -> define_new_sequence_child_bit (lm.lg.getAsn1ChildBackendName c)) - match td.kind with - | NonPrimitiveNewTypeDefinition -> - let completeDefinition = define_new_sequence td arrsChildren arrsOptionalChildren childrenCompleteDefinitions arrsNullFieldsSavePos - let privateDef = + | NonPrimitiveNewTypeDefinition -> + let invariants = lm.lg.generateSequenceInvariants t o allchildren + let sizeDefinitions = lm.lg.generateSequenceSizeDefinitions t o allchildren + let completeDefinition = define_new_sequence td arrsChildren arrsOptionalChildren childrenCompleteDefinitions arrsNullFieldsSavePos sizeDefinitions invariants + let privateDef = match childrenPrivatePart with | [] -> None | _ -> Some (childrenPrivatePart |> Seq.StrJoin "\n") Some (completeDefinition, privateDef) - | NonPrimitiveNewSubTypeDefinition subDef -> + | NonPrimitiveNewSubTypeDefinition subDef -> let otherProgramUnit = if td.programUnit = subDef.programUnit then None else (Some subDef.programUnit) - let completeDefinition = define_subType_sequence td subDef otherProgramUnit arrsOptionalChildren + let extraDefs = lm.lg.generateSequenceSubtypeDefinitions subDef.typeName t o children + let completeDefinition = define_subType_sequence td subDef otherProgramUnit arrsOptionalChildren extraDefs Some (completeDefinition, None) - | NonPrimitiveReference2OtherType -> None + | NonPrimitiveReference2OtherType -> None -let createChoice (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Choice) (children:ChChildInfo list) (us:State) = +let createChoice (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Choice) (children:ChChildInfo list) (us:State) = let define_new_choice = lm.typeDef.Define_new_choice let define_new_choice_child = lm.typeDef.Define_new_choice_child let define_subType_choice = lm.typeDef.Define_subType_choice let td = lm.lg.getChoiceTypeDefinition o.typeDef - let childldrenCompleteDefinitions = children |> List.choose (fun c -> getChildDefinition c.chType.typeDefinitionOrReference) + let childrenCompleteDefinitions = children |> List.choose (fun c -> getChildDefinition c.chType.typeDefinitionOrReference) let arrsPresent = children |> List.map(fun c -> lm.lg.presentWhenName None c) - let arrsChildren = children |> List.map (fun o -> define_new_choice_child (lm.lg.getAsn1ChChildBackendName o) (o.chType.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules) (lm.lg.presentWhenName None o)) + let arrsChildren = children |> List.map (fun o -> define_new_choice_child (lm.lg.getAsn1ChChildBackendName o) (o.chType.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules) (lm.lg.presentWhenName None o)) let arrsCombined = List.map2 (fun x y -> x + "(" + y + ")") arrsPresent arrsChildren let nIndexMax = BigInteger ((Seq.length children)-1) let privatePart = - let childPrivateParts = children |> + let childPrivateParts = children |> List.choose(fun o -> match o.chType.typeDefinitionOrReference with | TypeDefinition td -> td.privateTypeDefinition @@ -388,14 +393,15 @@ let createChoice (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Ty match td.kind with - | NonPrimitiveNewTypeDefinition -> - let completeDefinition = define_new_choice td (lm.lg.choiceIDForNone us.typeIdsSet t.id) (lm.lg.presentWhenName None children.Head) arrsChildren arrsPresent arrsCombined nIndexMax childldrenCompleteDefinitions + | NonPrimitiveNewTypeDefinition -> + let sizeDefinitions = lm.lg.generateChoiceSizeDefinitions t o children + let completeDefinition = define_new_choice td (lm.lg.choiceIDForNone us.typeIdsSet t.id) (lm.lg.presentWhenName None children.Head) arrsChildren arrsPresent arrsCombined nIndexMax childrenCompleteDefinitions sizeDefinitions Some (completeDefinition, privatePart) - | NonPrimitiveNewSubTypeDefinition subDef -> + | NonPrimitiveNewSubTypeDefinition subDef -> let otherProgramUnit = if td.programUnit = subDef.programUnit then None else (Some subDef.programUnit) let completeDefinition = define_subType_choice td subDef otherProgramUnit Some (completeDefinition, None) - | NonPrimitiveReference2OtherType -> None + | NonPrimitiveReference2OtherType -> None //////////////////////////////// @@ -536,7 +542,7 @@ let createString_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn let createEnumerated_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (us:State) = - let (aaa, priv) = + let (aaa, priv) = match createEnumerated r lm t o us with | Some (a, b) -> Some a, b | None -> None, None @@ -552,9 +558,9 @@ let createEnumerated_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst ReferenceToExistingDefinition {ReferenceToExistingDefinition.programUnit = (if td.programUnit = programUnit then None else Some td.programUnit); typedefName= td.typeName; definedInRtl = false} -let createSequenceOf_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.SequenceOf) (childDefinition:TypeDefinitionOrReference) (us:State) = - let aaa, privateDef = - match createSequenceOf r lm t o childDefinition us with +let createSequenceOf_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.SequenceOf) (childType: DAst.Asn1Type) (us:State) = + let aaa, privateDef = + match createSequenceOf r lm t o childType us with | Some (a, b) -> Some a, b | None -> None, None let programUnit = ToC t.id.ModName @@ -570,7 +576,7 @@ let createSequenceOf_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst let createSequence_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Sequence) (children:SeqChildInfo list) (us:State) = - let aaa, private_part = + let aaa, private_part = match createSequence r lm t o children us with | Some (a, b) -> Some a, b | None -> None, None @@ -586,7 +592,7 @@ let createSequence_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.A ReferenceToExistingDefinition {ReferenceToExistingDefinition.programUnit = (if td.programUnit = programUnit then None else Some td.programUnit); typedefName= td.typeName; definedInRtl = false} let createChoice_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Choice) (children:ChChildInfo list) (us:State) = - let aaa, private_part = + let aaa, private_part = match createChoice r lm t o children us with | Some (a, b) -> Some a, b | None -> None, None @@ -606,5 +612,3 @@ let createReferenceType_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnA match o.encodingOptions with | None -> baseType.typeDefinitionOrReference | Some _ -> baseType.typeDefinitionOrReference - - diff --git a/BackendAst/DAstUPer.fs b/BackendAst/DAstUPer.fs index 7a333e4e6..673738438 100644 --- a/BackendAst/DAstUPer.fs +++ b/BackendAst/DAstUPer.fs @@ -69,7 +69,7 @@ let internal createUperFunction (r:Asn1AcnAst.AstRoot) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) - (funcBody_e: ErrorCode -> NestingScope -> CallerScope -> UPERFuncBodyResult option) + (funcBody_e: ErrorCode -> NestingScope -> CallerScope -> bool -> UPERFuncBodyResult option) soSparkAnnotations (funcDefAnnots: string list) (us:State) = @@ -88,25 +88,25 @@ let internal createUperFunction (r:Asn1AcnAst.AstRoot) let sStar = lm.lg.getStar p.arg let isValidFuncName = match isValidFunc with None -> None | Some f -> f.funcName let sInitialExp = "" - let func, funcDef = + let func, funcDef, auxiliaries = match funcName with - | None -> None, None + | None -> None, None, [] | Some funcName -> - let content = funcBody (NestingScope.init t.acnMaxSizeInBits t.uperMaxSizeInBits) p - let bodyResult_funcBody, errCodes, bodyResult_localVariables, bBsIsUnreferenced, bVarNameIsUnreferenced = + let content = funcBody (NestingScope.init t.acnMaxSizeInBits t.uperMaxSizeInBits []) p false + let bodyResult_funcBody, errCodes, bodyResult_localVariables, bBsIsUnreferenced, bVarNameIsUnreferenced, auxiliaries = match content with | None -> let emptyStatement = lm.lg.emptyStatement - emptyStatement, [], [], true, isValidFuncName.IsNone - | Some bodyResult -> bodyResult.funcBody, bodyResult.errCodes, bodyResult.localVariables, bodyResult.bBsIsUnReferenced, bodyResult.bValIsUnReferenced + 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 + let precondAnnots = lm.lg.generatePrecond UPER t codec let postcondAnnots = lm.lg.generatePostcond 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)) let funcDef = Some(EmitTypeAssignment_def varName sStar funcName (lm.lg.getLongTypedefName typeDefinition) errCodStr (t.uperMaxSizeInBits = 0I) (BigInteger (ceil ((double t.uperMaxSizeInBits)/8.0))) ( t.uperMaxSizeInBits) soSparkAnnotations (t.uperMaxSizeInBits = 0I) codec) - func, funcDef + func, funcDef, auxiliaries let ret = @@ -116,6 +116,7 @@ let internal createUperFunction (r:Asn1AcnAst.AstRoot) funcDef = funcDef funcBody = funcBody funcBody_e = funcBody_e + auxiliaries = auxiliaries } ret, ns @@ -159,8 +160,8 @@ let getIntfuncBodyByCons (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Commo let IntFullyConstraint = lm.uper.IntFullyConstraint let IntSemiConstraintPos = lm.uper.IntSemiConstraintPos let IntSemiConstraint = lm.uper.IntSemiConstraint - let IntUnconstrained = lm.uper.IntUnconstrained - let IntUnconstrainedMax = lm.uper.IntUnconstrainedMax + let IntUnconstrained = lm.uper.IntUnconstrained + let IntUnconstrainedMax = lm.uper.IntUnconstrainedMax let IntRootExt = lm.uper.IntRootExt let IntRootExt2 = lm.uper.IntRootExt2 let rootCons = cons |> List.choose(fun x -> match x with RangeRootConstraint(_, a) |RangeRootConstraint2(_, a,_) -> Some(x) |_ -> None) @@ -205,11 +206,11 @@ let getIntfuncBodyByCons (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Commo let rootBody, _,_, intEncodingType = IntBod uperR true IntRootExt2 pp (getValueByConstraint uperR) cc rootBody errCode.errCodeName codec, false, false, intEncodingType | _ -> raise(BugErrorException "") - Some({UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=bValIsUnReferenced; bBsIsUnReferenced=bBsIsUnReferenced; resultExpr=resultExpr; typeEncodingKind=Some (Asn1IntegerEncodingType intEncodingType)}) + Some({UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=bValIsUnReferenced; bBsIsUnReferenced=bBsIsUnReferenced; resultExpr=resultExpr; typeEncodingKind=Some (Asn1IntegerEncodingType intEncodingType); auxiliaries = []}) let createIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Integer) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) (us:State) = - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = getIntfuncBodyByCons r lm codec o.uperRange t.Location o.intClass o.cons o.AllCons t.id errCode nestingScope p let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e p -> funcBody e p) soSparkAnnotations [] us @@ -217,14 +218,14 @@ let createIntegerFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Comm let createBooleanFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Boolean) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) (us:State) = - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let pp, resultExpr = adaptArgument lm codec p let Boolean = lm.uper.Boolean let funcBodyContent = Boolean pp errCode.errCodeName codec - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnBooleanEncodingType None)} + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnBooleanEncodingType None); auxiliaries = []} let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p -> Some (funcBody e ns p)) soSparkAnnotations [] us + createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p b -> Some (funcBody e ns p b)) soSparkAnnotations [] us let castRPp = DAstEqual.castRPp @@ -236,21 +237,21 @@ let createRealFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonT | ASN1SCC_FP32 -> "_fp32" | ASN1SCC_FP64 -> "" - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let pp, resultExpr = adaptArgument lm codec p let castPp = castRPp lm codec (o.getClass r.args) pp let Real = lm.uper.Real let funcBodyContent = Real castPp sSuffix errCode.errCodeName codec - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (Asn1RealEncodingType cls)} + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (Asn1RealEncodingType cls); auxiliaries = []} let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) let annots = match ST.lang with | Scala -> ["extern"] | _ -> [] - createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p -> Some (funcBody e ns p)) soSparkAnnotations annots us + createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p b -> Some (funcBody e ns p b)) soSparkAnnotations annots us let createObjectIdentifierFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.ObjectIdentifier) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) (us:State) = - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let pp, resultExpr = adaptArgumentPtr lm codec p let ObjectIdentifier = if o.relativeObjectId then @@ -258,9 +259,9 @@ let createObjectIdentifierFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) ( else lm.uper.ObjectIdentifier let funcBodyContent = ObjectIdentifier pp errCode.errCodeName codec - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some Placeholder} // TODO: Placeholder + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some Placeholder; auxiliaries = []} // TODO: Placeholder let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p -> Some (funcBody e ns p)) soSparkAnnotations [] us + createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p b -> Some (funcBody e ns p b)) soSparkAnnotations [] us let getTimeSubTypeByClass (tc) = match tc with @@ -274,20 +275,20 @@ let getTimeSubTypeByClass (tc) = let createTimeTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.TimeType) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) (us:State) = - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let pp, resultExpr = adaptArgumentPtr lm codec p let TimeType = lm.uper.Time let funcBodyContent = TimeType pp (getTimeSubTypeByClass o.timeClass) errCode.errCodeName codec - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some Placeholder} // TODO: Placeholder + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some Placeholder; auxiliaries = []} // TODO: Placeholder let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p -> Some (funcBody e ns p)) soSparkAnnotations [] us + createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p b -> Some (funcBody e ns p b)) soSparkAnnotations [] us let createNullTypeFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.NullType) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) (us:State) = - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let pp, _ = adaptArgument lm codec p match codec, lm.lg.decodingKind with | Decode, Copy -> - Some ({UPERFuncBodyResult.funcBody = lm.uper.Null_declare pp; errCodes = []; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=Some pp; typeEncodingKind=Some (AcnNullEncodingType None)}) + Some ({UPERFuncBodyResult.funcBody = lm.uper.Null_declare pp; errCodes = []; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=Some pp; typeEncodingKind=Some (AcnNullEncodingType None); auxiliaries = []}) | _ -> None let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc funcBody soSparkAnnotations [] us @@ -299,7 +300,7 @@ let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C let Enumerated_no_switch = lm.uper.Enumerated_no_switch - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let nMax = BigInteger(Seq.length o.items) - 1I let nLastItemIndex = nMax let typeDef0 = lm.lg.getEnumTypeDefinition o.typeDef @@ -313,15 +314,15 @@ let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C o.items |> List.mapi(fun i itm -> Enumerated_item pp (lm.lg.getNamedItemBackendName (Some typeDefinition) itm) (BigInteger i) nLastItemIndex codec) let nBits = (GetNumberOfBitsForNonNegativeInteger (nMax-nMin)) let funcBodyContent = Enumerated pp td items nMin nMax nBits errCode.errCodeName nLastItemIndex sFirstItemName codec - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (Asn1IntegerEncodingType (Some (FullyConstrained (nMin, nMax))))} + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (Asn1IntegerEncodingType (Some (FullyConstrained (nMin, nMax)))); auxiliaries = []} | true -> let sEnumIndex = "nEnumIndex" let enumIndexVar = (Asn1SIntLocalVariable (sEnumIndex, None)) let funcBodyContent = Enumerated_no_switch pp td errCode.errCodeName sEnumIndex nLastItemIndex sFirstItemName codec - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = [enumIndexVar]; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (Asn1IntegerEncodingType (Some (FullyConstrained (nMin, nMax))))} - + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = [enumIndexVar]; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (Asn1IntegerEncodingType (Some (FullyConstrained (nMin, nMax)))); auxiliaries = []} + let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p -> Some (funcBody e ns p)) soSparkAnnotations [] us + createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p b -> Some (funcBody e ns p b)) soSparkAnnotations [] us let C64K = BigInteger 0x10000 let C48K = BigInteger 0xC000 @@ -429,7 +430,7 @@ let createIA5StringFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Co match o.minSize.uper = o.maxSize.uper with | true -> [] | false -> [lm.lg.uper.createLv "nStringLength"] - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let td0 = lm.lg.getStrTypeDefinition o.typeDef let td = td0.longTypedefName2 lm.lg.hasModules (ToC p.modName) let InternalItem_string_no_alpha = lm.uper.InternalItem_string_no_alpha @@ -441,7 +442,7 @@ let createIA5StringFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Co let nBits = GetNumberOfBitsForNonNegativeInteger (BigInteger (o.uperCharSet.Length-1)) let internalItem = match o.uperCharSet.Length = 128 with - | true -> InternalItem_string_no_alpha (p.arg.joined lm.lg) errCode.errCodeName i codec + | true -> InternalItem_string_no_alpha (p.arg.joined lm.lg) errCode.errCodeName i codec | false -> let nBits = GetNumberOfBitsForNonNegativeInteger (BigInteger (o.uperCharSet.Length-1)) let arrAsciiCodes = o.uperCharSet |> Array.map(fun x -> BigInteger (System.Convert.ToInt32 x)) @@ -465,30 +466,30 @@ let createIA5StringFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Co acnMaxSizeBits = nBits typeKind = Some (AcnStringEncodingType o.acnEncodingClass) // TODO: Check this } - sel = pp + nestingScope = nestingScope + cs = p + encDec = Some internalItem + elemDecodeFn = None ixVariable = i } - let sqfProofGenRes = lm.lg.generateSequenceOfLikeProof ACN (SequenceOfLike.StrType o) sqfProofGen codec - let preSerde = sqfProofGenRes |> Option.map (fun r -> r.preSerde) - let postSerde = sqfProofGenRes |> Option.map (fun r -> r.postSerde) - let postInc = sqfProofGenRes |> Option.map (fun r -> r.postInc) - let invariant = sqfProofGenRes |> Option.map (fun r -> r.invariant) let introSnap = nestingScope.nestingLevel = 0I + let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries (if fromACN then ACN else UPER) (StrType o) sqfProofGen codec + let funcBodyContent,localVariables = match o.minSize with | _ when o.maxSize.uper < 65536I && o.maxSize.uper=o.minSize.uper -> - str_FixedSize pp typeDefinitionName i internalItem o.minSize.uper nBits nBits 0I initExpr introSnap preSerde postSerde postInc invariant codec, lv::charIndex@nStringLength + str_FixedSize pp typeDefinitionName i internalItem o.minSize.uper nBits nBits 0I initExpr introSnap callAux codec, lv::charIndex@nStringLength | _ when o.maxSize.uper < 65536I && o.maxSize.uper<>o.minSize.uper -> - str_VarSize pp typeDefinitionName i internalItem o.minSize.uper o.maxSize.uper nSizeInBits nBits nBits 0I initExpr codec, lv::charIndex@nStringLength + str_VarSize pp (p.arg.joined lm.lg) typeDefinitionName i internalItem o.minSize.uper o.maxSize.uper nSizeInBits nBits nBits 0I initExpr callAux codec, lv::charIndex@nStringLength | _ -> let funcBodyContent,localVariables = handleFragmentation lm p codec errCode ii o.uperMaxSizeInBits o.minSize.uper o.maxSize.uper internalItem nBits false true let localVariables = localVariables |> List.addIf (lm.lg.uper.requires_IA5String_i || o.maxSize.uper<>o.minSize.uper) lv funcBodyContent, charIndex@localVariables - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnStringEncodingType o.acnEncodingClass)} + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnStringEncodingType o.acnEncodingClass); auxiliaries = auxiliaries} let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p -> Some (funcBody e ns p)) soSparkAnnotations [] us + createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p b -> Some (funcBody e ns p b)) soSparkAnnotations [] us let createOctetStringFunction_funcBody (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (id : ReferenceToType) (typeDefinition:TypeDefinitionOrReference) isFixedSize uperMaxSizeInBits minSize maxSize (o:Asn1AcnAst.OctetString) (errCode:ErrorCode) (p:CallerScope) = @@ -522,17 +523,17 @@ let createOctetStringFunction_funcBody (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros let localVariables = localVariables |> List.addIf (lm.lg.uper.requires_IA5String_i || (not isFixedSize)) (lv) funcBodyContent, localVariables - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnOctetStringEncodingType o.acnEncodingClass)} + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnOctetStringEncodingType o.acnEncodingClass); auxiliaries = []} let createOctetStringFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.OctetString) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) (us:State) = - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = createOctetStringFunction_funcBody r lm codec t.id typeDefinition o.isFixedSize o.uperMaxSizeInBits o.minSize.uper o.maxSize.uper o (errCode:ErrorCode) (p:CallerScope) let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p -> Some (funcBody e ns p)) soSparkAnnotations [] us + createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p b -> Some (funcBody e ns p b)) soSparkAnnotations [] us @@ -568,16 +569,16 @@ let createBitStringFunction_funcBody (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) let fragmentationLvars = fragmentationLvars |> List.addIf ((not isFixedSize) && lm.lg.uper.requires_sBLJ) (iVar) (funcBodyContent,fragmentationLvars) - {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnBitStringEncodingType o.acnEncodingClass)} + {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (AcnBitStringEncodingType o.acnEncodingClass); auxiliaries = []} let createBitStringFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.BitString) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) (us:State) = - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = createBitStringFunction_funcBody r lm codec t.id typeDefinition o.isFixedSize o.uperMaxSizeInBits o.minSize.uper o.maxSize.uper o (errCode:ErrorCode) (p:CallerScope) let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p -> Some (funcBody e ns p)) soSparkAnnotations [] us + createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc (fun e ns p b -> Some (funcBody e ns p b)) soSparkAnnotations [] us let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.SequenceOf) (typeDefinition:TypeDefinitionOrReference) (baseTypeUperFunc : UPerFunction option) (isValidFunc: IsValidFunction option) (child:Asn1Type) (us:State) = @@ -588,12 +589,11 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C let nIntItemMaxSize = ( child.uperMaxSizeInBits) let baseFuncName = match baseTypeUperFunc with None -> None | Some baseFunc -> baseFunc.funcName - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = - + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = match baseFuncName with | None -> let pp, resultExpr = joinedOrAsIdentifier lm codec p - let childNestingScope = {nestingScope with nestingLevel = nestingScope.nestingLevel + 1I} + let childNestingScope = {nestingScope with nestingLevel = nestingScope.nestingLevel + 1I; parents = (p, t) :: nestingScope.parents} let access = lm.lg.getAccess p.arg // `childInitExpr` is used to initialize the array of elements in which we will write their decoded values // It is only meaningful for "Copy" decoding kind, since InPlace will directly modify `p`'s array @@ -610,8 +610,10 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C | false, Decode -> [lm.lg.uper.count_var] let chFunc = child.getUperFunction codec - let internalItem = - chFunc.funcBody childNestingScope ({p with arg = lm.lg.getArrayItem p.arg i child.isIA5String}) + let chp = + let recv = if lm.lg.decodingKind = Copy then Selection.emptyPath p.arg.asIdentifier p.arg.selectionType else p.arg + {p with arg = lm.lg.getArrayItem recv i child.isIA5String} + let internalItem = chFunc.funcBody childNestingScope chp fromACN let sqfProofGen = { SequenceOfLikeProofGen.acnOuterMaxSize = nestingScope.acnOuterMaxSize @@ -625,14 +627,13 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C acnMaxSizeBits = child.acnMaxSizeInBits typeKind = internalItem |> Option.bind (fun i -> i.typeEncodingKind) } - sel = pp + nestingScope = nestingScope + cs = p + encDec = internalItem |> Option.map (fun ii -> ii.funcBody) + elemDecodeFn = None // TODO: elemDecodeFn ixVariable = i } - let sqfProofGenRes = lm.lg.generateSequenceOfLikeProof ACN (SqOf o) sqfProofGen codec - let preSerde = sqfProofGenRes |> Option.map (fun r -> r.preSerde) - let postSerde = sqfProofGenRes |> Option.map (fun r -> r.postSerde) - let postInc = sqfProofGenRes |> Option.map (fun r -> r.postInc) - let invariant = sqfProofGenRes |> Option.map (fun r -> r.invariant) + let auxiliaries, callAux = lm.lg.generateSequenceOfLikeAuxiliaries (if fromACN then ACN else UPER) (SqOf o) sqfProofGen codec let absOffset = nestingScope.uperOffset let remBits = nestingScope.uperOuterMaxSize - nestingScope.uperOffset @@ -646,11 +647,11 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C match o.minSize with | _ when o.maxSize.uper < 65536I && o.maxSize.uper=o.minSize.uper -> None | _ when o.maxSize.uper < 65536I && o.maxSize.uper<>o.minSize.uper -> - let funcBody = varSize pp access td i "" o.minSize.uper o.maxSize.uper nSizeInBits child.uperMinSizeInBits nIntItemMaxSize 0I childInitExpr errCode.errCodeName absOffset remBits lvl ix offset introSnap preSerde postSerde postInc invariant codec - Some ({UPERFuncBodyResult.funcBody = funcBody; errCodes = [errCode]; localVariables = lv@nStringLength; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None}) + let funcBody = varSize pp access td i "" o.minSize.uper o.maxSize.uper nSizeInBits child.uperMinSizeInBits nIntItemMaxSize 0I childInitExpr errCode.errCodeName absOffset remBits lvl ix offset introSnap callAux codec + Some ({UPERFuncBodyResult.funcBody = funcBody; errCodes = [errCode]; localVariables = lv@nStringLength; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None; auxiliaries = auxiliaries}) | _ -> let funcBody, localVariables = handleFragmentation lm p codec errCode ii ( o.uperMaxSizeInBits) o.minSize.uper o.maxSize.uper "" nIntItemMaxSize false false - Some ({UPERFuncBodyResult.funcBody = funcBody; errCodes = [errCode]; localVariables = localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None}) + Some ({UPERFuncBodyResult.funcBody = funcBody; errCodes = [errCode]; localVariables = localVariables; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None; auxiliaries = auxiliaries}) | Some internalItem -> let childErrCodes = internalItem.errCodes let internalItemBody = @@ -661,15 +662,15 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C | _ -> internalItem.funcBody let ret,localVariables = match o.minSize with - | _ when o.maxSize.uper < 65536I && o.maxSize.uper=o.minSize.uper -> fixedSize pp td i internalItemBody o.minSize.uper child.uperMinSizeInBits nIntItemMaxSize 0I childInitExpr codec, nStringLength - | _ when o.maxSize.uper < 65536I && o.maxSize.uper<>o.minSize.uper -> varSize pp access td i internalItemBody o.minSize.uper o.maxSize.uper nSizeInBits child.uperMinSizeInBits nIntItemMaxSize 0I childInitExpr errCode.errCodeName absOffset remBits lvl ix offset introSnap preSerde postSerde postInc invariant codec , nStringLength + | _ when o.maxSize.uper < 65536I && o.maxSize.uper=o.minSize.uper -> fixedSize pp td i internalItemBody o.minSize.uper child.uperMinSizeInBits nIntItemMaxSize 0I childInitExpr callAux codec, nStringLength + | _ when o.maxSize.uper < 65536I && o.maxSize.uper<>o.minSize.uper -> varSize pp access td i internalItemBody o.minSize.uper o.maxSize.uper nSizeInBits child.uperMinSizeInBits nIntItemMaxSize 0I childInitExpr errCode.errCodeName absOffset remBits lvl ix offset introSnap callAux codec, nStringLength | _ -> handleFragmentation lm p codec errCode ii ( o.uperMaxSizeInBits) o.minSize.uper o.maxSize.uper internalItemBody nIntItemMaxSize false false let typeEncodingKind = internalItem.typeEncodingKind |> Option.map (fun tpe -> TypeEncodingKind.SequenceOfEncodingType (tpe, o.acnEncodingClass)) - Some ({UPERFuncBodyResult.funcBody = ret; errCodes = errCode::childErrCodes; localVariables = lv@(localVariables@internalItem.localVariables); bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind}) + Some ({UPERFuncBodyResult.funcBody = ret; errCodes = errCode::childErrCodes; localVariables = lv@(localVariables@internalItem.localVariables); bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=typeEncodingKind; auxiliaries=internalItem.auxiliaries@auxiliaries}) | Some baseFuncName -> let pp, resultExpr = adaptArgumentPtr lm codec p let funcBodyContent = callBaseTypeFunc lm pp baseFuncName codec - Some ({UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None}) + 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) createUperFunction r lm codec t typeDefinition baseTypeUperFunc isValidFunc funcBody soSparkAnnotations [] us @@ -688,6 +689,7 @@ type private SequenceChildResult = { resultExpr: string option props: SequenceChildProps typeEncodingKind: TypeEncodingKind option + auxiliaries: string list } let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Sequence) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (children:SeqChildInfo list) (us:State) = @@ -701,7 +703,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let td = typeDefinition.longTypedefName2 lm.lg.hasModules - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let nonAcnChildren = children |> List.choose(fun c -> match c with Asn1Child c -> Some c | AcnChild _ -> None) let localVariables = match nonAcnChildren |> Seq.exists(fun x -> x.Optionality.IsSome) with @@ -738,33 +740,21 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com nestingLevel = nestingScope.nestingLevel + 1I nestingIx = nestingScope.nestingIx + s.childIx uperRelativeOffset = s.uperAccBits - uperOffset = nestingScope.uperOffset + s.uperAccBits} + uperOffset = nestingScope.uperOffset + s.uperAccBits + parents = (p, t) :: nestingScope.parents} let chFunc = child.Type.getUperFunction codec - let newArg = lm.lg.getSeqChild p.arg childName child.Type.isIA5String child.Optionality.IsSome - let newArg = if lm.lg.usesWrappedOptional && newArg.isOptional && codec = Encode then newArg.asLast else newArg - let childP = {p with arg = newArg} - let childContentResult = chFunc.funcBody childNestingScope childP + let childSel = lm.lg.getSeqChild p.arg childName child.Type.isIA5String child.Optionality.IsSome + let childP = + let newArg = if lm.lg.usesWrappedOptional && childSel.isOptional && codec = Encode then childSel.asLast else childSel + {p with arg = newArg} + let childContentResult = chFunc.funcBody childNestingScope childP fromACN let existVar = match codec, lm.lg.decodingKind with | Decode, Copy -> Some (ToC (child._c_name + "_exist")) | _ -> None - let presenceBit = - let absent, present = - match ST.lang with - | Scala -> "false", "true" - | _ -> "0", "1" - // please note that in decode, macro uper_sequence_presence_bit_fix - // calls macro uper_sequence_presence_bit (i.e. behaves like optional) - let seq_presence_bit_fix (value: string) = - sequence_presence_bit_fix pp access childName existVar errCode.errCodeName value codec - match child.Optionality with - | None -> None - | Some Asn1AcnAst.AlwaysAbsent -> Some (seq_presence_bit_fix absent) - | Some Asn1AcnAst.AlwaysPresent -> Some (seq_presence_bit_fix present) - | Some (Asn1AcnAst.Optional opt) -> Some (sequence_presence_bit pp access childName existVar errCode.errCodeName codec) let typeInfo = {uperMaxSizeBits=child.uperMaxSizeInBits; acnMaxSizeBits=child.acnMaxSizeInBits; typeKind=childContentResult |> Option.bind (fun c -> c.typeEncodingKind)} - let props = {sel=Some (childP.arg.joined lm.lg); uperMaxOffset=s.uperAccBits; acnMaxOffset=s.acnAccBits; typeInfo=typeInfo} + 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 newAcc = {childIx=s.childIx + 1I; uperAccBits=s.uperAccBits + child.uperMaxSizeInBits; acnAccBits=s.acnAccBits + child.acnMaxSizeInBits} match childContentResult with @@ -774,7 +764,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com match codec, lm.lg.decodingKind with | Decode, Copy -> Some child.Type.initFunction.initExpression | _ -> None - {stmt=None; resultExpr=childResultExpr; props=props; typeEncodingKind=None}, newAcc + {stmt=None; resultExpr=childResultExpr; props=props; typeEncodingKind=None; auxiliaries = []}, newAcc | Some childContent -> let childBody, child_localVariables = match child.Optionality with @@ -796,7 +786,17 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com | Some v -> let defInit= child.Type.initFunction.initByAsn1Value childP (mapValue v).kind Some (sequence_default_child pp access childName childContent.funcBody existVar childContent.resultExpr childTypeDef defInit codec), childContent.localVariables - {stmt=Some {body=childBody; lvs=child_localVariables; errCodes=childContent.errCodes}; resultExpr=childContent.resultExpr; props=props; typeEncodingKind=childContent.typeEncodingKind}, newAcc + { + stmt = Some { + body = childBody + lvs = child_localVariables + errCodes = childContent.errCodes + } + resultExpr = childContent.resultExpr + props = props + typeEncodingKind = childContent.typeEncodingKind + auxiliaries = childContent.auxiliaries + }, newAcc let presenceBits = nonAcnChildren |> List.map printPresenceBit let nbPresenceBits = presenceBits |> List.sumBy (fun s -> if s.IsSome then 1I else 0I) @@ -804,10 +804,10 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let seqProofGen = let presenceBitsInfo = presenceBits |> List.mapi (fun i _ -> - {sel=None; uperMaxOffset = bigint i; acnMaxOffset = bigint i; - typeInfo = {uperMaxSizeBits = 1I; acnMaxSizeBits = 1I; typeKind = Some (AcnBooleanEncodingType None)};}) + {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) - {acnOuterMaxSize = nestingScope.acnOuterMaxSize; uperOuterMaxSize = nestingScope.uperOuterMaxSize; + {t = t; 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; @@ -822,14 +822,15 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let childrenErrCodes = childrenStatements0 |> List.collect(fun s -> s.errCodes) let childrenResultExpr = childrenStatements00 |> List.choose(fun s -> s.resultExpr) let childrenTypeKindEncoding = childrenStatements00 |> List.map(fun s -> s.typeEncodingKind) + let childrenAuxiliaries = childrenStatements00 |> List.collect(fun s -> s.auxiliaries) // If we are Decoding with Copy decoding kind, then all children `resultExpr` must be defined as well (i.e. we must have the same number of `resultExpr` as children) assert (resultExpr.IsNone || childrenResultExpr.Length = nonAcnChildren.Length) - let seqBuild = resultExpr |> Option.map (fun res -> sequence_build res td childrenResultExpr) |> Option.toList + let seqBuild = resultExpr |> Option.map (fun res -> sequence_build res td p.arg.isOptional childrenResultExpr) |> Option.toList let seqContent = (childrenStatements@seqBuild) |> nestChildItems lm codec match seqContent with | None -> None - | Some ret -> Some ({UPERFuncBodyResult.funcBody = ret; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalVars; bValIsUnReferenced=false; bBsIsUnReferenced=(o.uperMaxSizeInBits = 0I); resultExpr=resultExpr; typeEncodingKind=Some (SequenceEncodingType childrenTypeKindEncoding)}) + | Some ret -> Some ({UPERFuncBodyResult.funcBody = ret; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalVars; bValIsUnReferenced=false; bBsIsUnReferenced=(o.uperMaxSizeInBits = 0I); resultExpr=resultExpr; typeEncodingKind=Some (SequenceEncodingType childrenTypeKindEncoding); auxiliaries=childrenAuxiliaries}) let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) createUperFunction r lm codec t typeDefinition None isValidFunc funcBody soSparkAnnotations [] us @@ -850,20 +851,25 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Commo let typeDefinitionName = typeDefinition.longTypedefName2 lm.lg.hasModules - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = let td0 = lm.lg.getChoiceTypeDefinition o.typeDef let td = td0.longTypedefName2 lm.lg.hasModules (ToC p.modName) let acnSiblingMaxSize = children |> List.map (fun c -> c.chType.acnMaxSizeInBits) |> List.max let uperSiblingMaxSize = children |> List.map (fun c -> c.chType.uperMaxSizeInBits) |> List.max - let handleChild (nIndexSizeInBits: BigInteger) (i: int) (child: ChChildInfo): string * LocalVariable list * ErrorCode list * TypeEncodingKind option = - let childNestingScope = {nestingScope with nestingLevel = nestingScope.nestingLevel + 1I; uperSiblingMaxSize = Some uperSiblingMaxSize; acnSiblingMaxSize = Some acnSiblingMaxSize} + let handleChild (nIndexSizeInBits: BigInteger) (i: int) (child: ChChildInfo): string * LocalVariable list * ErrorCode list * TypeEncodingKind option * string list = + let childNestingScope = + {nestingScope with + nestingLevel = nestingScope.nestingLevel + 1I + uperSiblingMaxSize = Some uperSiblingMaxSize + acnSiblingMaxSize = Some acnSiblingMaxSize + parents = (p, t) :: nestingScope.parents} let chFunc = child.chType.getUperFunction codec let uperChildRes = match lm.lg.uper.catd with - | false -> chFunc.funcBody childNestingScope ({p with arg = lm.lg.getChChild p.arg (lm.lg.getAsn1ChChildBackendName child) child.chType.isIA5String}) - | true when codec = CommonTypes.Decode -> chFunc.funcBody childNestingScope {p with arg = Selection.valueEmptyPath ((lm.lg.getAsn1ChChildBackendName child) + "_tmp")} - | true -> chFunc.funcBody childNestingScope ({p with arg = lm.lg.getChChild p.arg (lm.lg.getAsn1ChChildBackendName child) child.chType.isIA5String}) + | false -> chFunc.funcBody childNestingScope ({p with arg = lm.lg.getChChild p.arg (lm.lg.getAsn1ChChildBackendName child) child.chType.isIA5String}) fromACN + | true when codec = CommonTypes.Decode -> chFunc.funcBody childNestingScope {p with arg = Selection.valueEmptyPath ((lm.lg.getAsn1ChChildBackendName child) + "_tmp")} fromACN + | true -> chFunc.funcBody childNestingScope ({p with arg = lm.lg.getChChild p.arg (lm.lg.getAsn1ChChildBackendName child) child.chType.isIA5String}) fromACN let sChildName = (lm.lg.getAsn1ChChildBackendName child) let sChildTypeDef = child.chType.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules let isSequence = match child.chType.Kind with | Sequence _ -> true | _ -> false @@ -886,27 +892,29 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Commo | Sequence _ -> uper_a.decode_empty_sequence_emptySeq childp.arg.receiverId | _ -> lm.lg.createSingleLineComment "no encoding/decoding is required" | true -> lm.lg.createSingleLineComment "no encoding/decoding is required" - mk_choice_child childContent, [], [], None + mk_choice_child childContent, [], [], None, [] | Some childContent -> - mk_choice_child childContent.funcBody, childContent.localVariables, childContent.errCodes, childContent.typeEncodingKind + mk_choice_child childContent.funcBody, childContent.localVariables, childContent.errCodes, childContent.typeEncodingKind, childContent.auxiliaries match baseFuncName with | None -> let nIndexSizeInBits = (GetNumberOfBitsForNonNegativeInteger (BigInteger (children.Length - 1))) let childrenContent3 = children |> List.mapi (handleChild nIndexSizeInBits) - let childrenContent = childrenContent3 |> List.map(fun (s,_,_,_) -> s) - let childrenLocalvars = childrenContent3 |> List.collect(fun (_,s,_,_) -> s) - let childrenErrCodes = childrenContent3 |> List.collect(fun (_,_,s,_) -> s) - let childrenTypeKindEncoding = childrenContent3 |> List.map(fun (_,_,_,s) -> s) + let childrenContent = childrenContent3 |> List.map(fun (s,_,_,_,_) -> s) + let childrenLocalvars = childrenContent3 |> List.collect(fun (_,s,_,_,_) -> s) + let childrenErrCodes = childrenContent3 |> List.collect(fun (_,_,s,_,_) -> s) + let childrenTypeKindEncoding = childrenContent3 |> List.map(fun (_,_,_,s, _) -> s) + let childrenAuxiliaries = childrenContent3 |> List.collect(fun (_,_,_,_, a) -> a) 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 - Some ({UPERFuncBodyResult.funcBody = ret; errCodes = errCode::childrenErrCodes; localVariables = localVariables@childrenLocalvars; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ChoiceEncodingType childrenTypeKindEncoding)}) + let ret = lm.lg.generateChoiceProof 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 - // TODO: Qu'est-ce que c'est que ça???? - Some ({UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=None}) + let ret = lm.lg.generateChoiceProof 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) @@ -922,8 +930,8 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C match TypesEquivalence.uperEquivalence t1 t1WithExtensions with | true -> let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = - match (baseType.getUperFunction codec).funcBody nestingScope p with + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = + match (baseType.getUperFunction codec).funcBody nestingScope p fromACN with | Some _ -> let pp, resultExpr = let str = lm.lg.getParamValue t p.arg codec @@ -933,7 +941,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C toc, Some toc | _ -> str, None let funcBodyContent = callBaseTypeFunc lm pp baseFncName codec - Some {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ReferenceEncodingType baseTypeDefinitionName)} + Some {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ReferenceEncodingType baseTypeDefinitionName); auxiliaries = []} | None -> None createUperFunction r lm codec t typeDefinition None isValidFunc funcBody soSparkAnnotations [] us | false -> @@ -942,8 +950,8 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C let octet_string_containing_func = lm.uper.octet_string_containing_func let bit_string_containing_func = lm.uper.bit_string_containing_func let soSparkAnnotations = Some(sparkAnnotations lm (lm.lg.getLongTypedefName typeDefinition) codec) - let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) = - match (baseType.getUperFunction codec).funcBody nestingScope p with + let funcBody (errCode:ErrorCode) (nestingScope: NestingScope) (p:CallerScope) (fromACN: bool) = + match (baseType.getUperFunction codec).funcBody nestingScope p fromACN with | Some _ -> let pp, resultExpr = let str = lm.lg.getParamValue t p.arg codec @@ -959,6 +967,6 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:C match opts.octOrBitStr with | ContainedInOctString -> octet_string_containing_func pp baseFncName sReqBytesForUperEncoding nBits opts.minSize.uper opts.maxSize.uper codec | ContainedInBitString -> bit_string_containing_func pp baseFncName sReqBytesForUperEncoding sReqBitForUperEncoding nBits opts.minSize.uper opts.maxSize.uper codec - Some {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ReferenceEncodingType baseTypeDefinitionName)} + Some {UPERFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced=false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind=Some (ReferenceEncodingType baseTypeDefinitionName); auxiliaries = []} | None -> None createUperFunction r lm codec t typeDefinition None isValidFunc funcBody soSparkAnnotations [] us diff --git a/BackendAst/DAstUtilFunctions.fs b/BackendAst/DAstUtilFunctions.fs index 1ee92422f..c4bfbde46 100644 --- a/BackendAst/DAstUtilFunctions.fs +++ b/BackendAst/DAstUtilFunctions.fs @@ -926,7 +926,7 @@ let hasAcnEncodeFunction (encFunc : AcnFunction option) acnParameters = match acnParameters with | [] -> let p = {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} - let ret,_ = fnc.funcBody emptyState [] (NestingScope.init 0I 0I) p + let ret,_ = fnc.funcBody emptyState [] (NestingScope.init 0I 0I []) p match ret with | None -> false | Some _ -> true @@ -937,7 +937,7 @@ let hasUperEncodeFunction (encFunc : UPerFunction option) = | None -> false | Some fnc -> let p = {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} - match fnc.funcBody (NestingScope.init 0I 0I) p with + match fnc.funcBody (NestingScope.init 0I 0I []) p false with | None -> false | Some _ -> true diff --git a/BackendAst/DastTestCaseCreation.fs b/BackendAst/DastTestCaseCreation.fs index e08a3ce48..773fe2df9 100644 --- a/BackendAst/DastTestCaseCreation.fs +++ b/BackendAst/DastTestCaseCreation.fs @@ -74,7 +74,7 @@ let PrintValueAssignmentAsTestCase (r:DAst.AstRoot) lm (e:Asn1Encoding) (v:Value match ST.lang with | Scala -> match resolveReferenceType v.Type.Kind with - | Integer v -> "tc_data = " + initStatement + | Integer v -> "val tc_data = " + initStatement | Real v -> initStatement | IA5String v -> initStatement | OctetString v -> initStatement @@ -287,4 +287,3 @@ let printAllTestCasesAndTestCaseRunner (r:DAst.AstRoot) (lm:LanguageMacros) outD arrsSrcTstFiles, arrsHdrTstFiles - diff --git a/BackendAst/GenerateFiles.fs b/BackendAst/GenerateFiles.fs index 05719768b..e667df0af 100644 --- a/BackendAst/GenerateFiles.fs +++ b/BackendAst/GenerateFiles.fs @@ -90,25 +90,21 @@ let private printUnit (r:DAst.AstRoot) (lm:LanguageMacros) (encodings: CommonTy let requiresUPER = encodings |> Seq.exists ( (=) Asn1Encoding.UPER) let requiresAcn = encodings |> Seq.exists ( (=) Asn1Encoding.ACN) - //let requiresXER = encodings |> Seq.exists ( (=) Asn1Encoding.XER) //header file - //let typeDefs = tases |> List.choose(fun t -> t.getTypeDefinition l) let typeDefs = tases |> List.map(fun tas -> - let type_definition = //tas.Type.typeDefinition.completeDefinition + let type_definition = match tas.Type.typeDefinitionOrReference with | TypeDefinition td -> td.typedefBody () | ReferenceToExistingDefinition _ -> raise(BugErrorException "Type Assignment with no Type Definition") let init_def = match lm.lg.initMethod with | Procedure -> - //Some (GetMySelfAndChildren tas.Type |> List.choose(fun t -> t.initFunction.initProcedure) |> List.map(fun c -> c.def) |> Seq.StrJoin "\n") Some(getInitializationFunctions tas.Type.initFunction |> List.choose( fun i_f -> i_f.initProcedure) |> List.map(fun c -> c.def) |> Seq.StrJoin "\n" ) | Function -> Some(getInitializationFunctions tas.Type.initFunction |> List.choose( fun i_f -> i_f.initFunction) |> List.map(fun c -> c.def) |> Seq.StrJoin "\n" ) - //Some (GetMySelfAndChildren tas.Type |> List.choose(fun t -> t.initFunction.initFunction ) |> List.map(fun c -> c.def) |> Seq.StrJoin "\n") let init_globals = //we generate const globals only if requested by user and the init method is procedure match r.args.generateConstInitGlobals && (lm.lg.initMethod = Procedure) with @@ -119,15 +115,11 @@ let private printUnit (r:DAst.AstRoot) (lm:LanguageMacros) (encodings: CommonTy tas.Type.initFunction.user_aux_functions |> List.map fst - let equal_defs = //collectEqualFuncs tas.Type |> List.choose(fun ef -> ef.isEqualFuncDef) + let equal_defs = match r.args.GenerateEqualFunctions with | true -> GetMySelfAndChildren tas.Type |> List.choose(fun t -> t.equalFunction.isEqualFuncDef ) | false -> [] - let isValidFuncs = - //match tas.Type.isValidFunction with - //| None -> [] - //| Some f -> - //GetMySelfAndChildren3 printChildrenIsValidFuncs tas.Type |> List.choose(fun f -> f.isValidFunction ) |> List.choose(fun f -> f.funcDef) + let isValidFuncs = match tas.Type.isValidFunction with | None -> [] | Some f -> @@ -162,7 +154,6 @@ let private printUnit (r:DAst.AstRoot) (lm:LanguageMacros) (encodings: CommonTy let arrsPrototypes = [] - //sFileNameWithNoExtUpperCase, sPackageName, arrsIncludedModules, arrsTypeAssignments, arrsValueAssignments, arrsPrototypes, arrsUtilityDefines, bHasEncodings, bXer let sFileNameWithNoExtUpperCase = (ToC (System.IO.Path.GetFileNameWithoutExtension pu.specFileName)) let bXer = r.args.encodings |> Seq.exists ((=) XER) let arrsUtilityDefines = [] @@ -196,7 +187,7 @@ let private printUnit (r:DAst.AstRoot) (lm:LanguageMacros) (encodings: CommonTy let tstCasesHdrContent = lm.atc.PrintAutomaticTestCasesSpecFile (ToC pu.testcase_specFileName) pu.name (pu.name::pu.importedProgramUnits) typeDefs File.WriteAllText(testcase_specFileName, tstCasesHdrContent.Replace("\r","")) - //sourse file + //source file let arrsTypeAssignments = tases |> List.map(fun t -> let privateDefinition = @@ -204,14 +195,11 @@ let private printUnit (r:DAst.AstRoot) (lm:LanguageMacros) (encodings: CommonTy | TypeDefinition td -> td.privateTypeDefinition | ReferenceToExistingDefinition _ -> None - - let initialize = + let initialize = match lm.lg.initMethod with | InitMethod.Procedure -> - //Some(GetMySelfAndChildren t.Type |> List.choose(fun y -> y.initFunction.initProcedure) |> List.map(fun c -> c.body) |> Seq.StrJoin "\n") Some(getInitializationFunctions t.Type.initFunction |> List.choose( fun i_f -> i_f.initProcedure) |> List.map(fun c -> c.body) |> Seq.StrJoin "\n" ) | InitMethod.Function -> - //Some (GetMySelfAndChildren t.Type |> List.choose(fun t -> t.initFunction.initFunction ) |> List.map(fun c -> c.body) |> Seq.StrJoin "\n") Some(getInitializationFunctions t.Type.initFunction |> List.choose( fun i_f -> i_f.initFunction) |> List.map(fun c -> c.body) |> Seq.StrJoin "\n" ) let init_globals = @@ -223,47 +211,43 @@ let private printUnit (r:DAst.AstRoot) (lm:LanguageMacros) (encodings: CommonTy let special_init_funcs = t.Type.initFunction.user_aux_functions |> List.map snd - //let eqFuncs = collectEqualDeffinitions t |> List.choose(fun ef -> ef.isEqualFunc) - let eqFuncs = //collectEqualFuncs t.Type |> List.choose(fun ef -> ef.isEqualFunc) + let eqFuncs = match r.args.GenerateEqualFunctions with | true -> GetMySelfAndChildren t.Type |> List.choose(fun y -> y.equalFunction.isEqualFunc) | false -> [] - let isValidFuncs = //match t.Type.isValidFunction with None -> None | Some isVal -> isVal.func - //GetMySelfAndChildren3 printChildrenIsValidFuncs t.Type |> List.choose(fun f -> f.isValidFunction ) |> List.choose(fun f -> f.func) + let isValidFuncs = match t.Type.isValidFunction with | None -> [] | Some f -> getValidFunctions f |> List.choose(fun f -> f.func) - let uperEncDec codec = - match requiresUPER with - | true -> - match codec with - | CommonTypes.Encode -> t.Type.uperEncFunction.func - | CommonTypes.Decode -> t.Type.uperDecFunction.func - | false -> None - - let xerEncDec codec = - match codec with - | CommonTypes.Encode -> - match t.Type.xerEncFunction with - | XerFunction z -> z.func - | XerFunctionDummy -> None - | CommonTypes.Decode -> - match t.Type.xerDecFunction with - | XerFunction z -> z.func - | XerFunctionDummy -> None - - let ancEncDec codec = - match requiresAcn with - | true -> - match codec with - | CommonTypes.Encode -> match t.Type.acnEncFunction with None -> None | Some x -> x.func - | CommonTypes.Decode -> match t.Type.acnDecFunction with None -> None | Some x -> x.func - | false -> None - let allProcs = ([privateDefinition]|>List.choose id)@eqFuncs@isValidFuncs@special_init_funcs@([init_globals;initialize; (uperEncDec CommonTypes.Encode); (uperEncDec CommonTypes.Decode);(ancEncDec CommonTypes.Encode); (ancEncDec CommonTypes.Decode);(xerEncDec CommonTypes.Encode); (xerEncDec CommonTypes.Decode)] |> List.choose id) - lm.src.printTass allProcs ) + let uperEncDec = + if requiresUPER then + ((t.Type.uperEncFunction.func |> Option.toList |> List.collect (fun f -> f :: t.Type.uperEncFunction.auxiliaries))) @ + ((t.Type.uperDecFunction.func |> Option.toList |> List.collect (fun f -> f :: t.Type.uperDecFunction.auxiliaries))) + else [] + + let xerEncDec = + (match t.Type.xerEncFunction with + | XerFunction z -> z.func |> Option.toList + | XerFunctionDummy -> []) @ + (match t.Type.xerDecFunction with + | XerFunction z -> z.func |> Option.toList + | XerFunctionDummy -> []) + + let ancEncDec = + if requiresAcn then + (t.Type.acnEncFunction |> Option.toList |> List.collect (fun x -> (x.func |> Option.toList) @ x.auxiliaries)) @ + (t.Type.acnDecFunction |> Option.toList |> List.collect (fun x -> (x.func |> Option.toList) @ x.auxiliaries)) + else [] + let allProcs = + (privateDefinition |> Option.toList) @ + eqFuncs @ isValidFuncs @ special_init_funcs @ + (init_globals |> Option.toList) @ + (initialize |> Option.toList) @ + uperEncDec @ ancEncDec @ xerEncDec + lm.src.printTass allProcs) let arrsValueAssignments, arrsSourceAnonymousValues = @@ -297,7 +281,7 @@ let private printUnit (r:DAst.AstRoot) (lm:LanguageMacros) (encodings: CommonTy File.WriteAllText(fileName, eqContntent.Replace("\r","")) | None -> () - //test cases sourse file + //test cases source file match r.args.generateAutomaticTestCases with | false -> () | true -> diff --git a/CommonTypes/AbstractMacros.fs b/CommonTypes/AbstractMacros.fs index 960a5b774..878bea1b7 100644 --- a/CommonTypes/AbstractMacros.fs +++ b/CommonTypes/AbstractMacros.fs @@ -64,20 +64,20 @@ Generated by the C stg macros with the following command abstract member Define_subType_enumerated_private : td:FE_EnumeratedTypeDefinition -> prTd:FE_EnumeratedTypeDefinition -> arrsValidEnumNames:seq -> arrsEnumNames:seq -> string; abstract member Define_new_ia5string : td:FE_StringTypeDefinition -> nMin:BigInteger -> nMax:BigInteger -> nCMax:BigInteger -> arrnAlphaChars:seq -> string; abstract member Define_subType_ia5string : td:FE_StringTypeDefinition -> prTd:FE_StringTypeDefinition -> soParentTypePackage:string option -> string; - abstract member Define_new_octet_string : td:FE_SizeableTypeDefinition -> nMin:BigInteger -> nMax:BigInteger -> bFixedSize:bool -> string; + abstract member Define_new_octet_string : td:FE_SizeableTypeDefinition -> nMin:BigInteger -> nMax:BigInteger -> bFixedSize:bool -> arrsInvariants:seq -> string; abstract member Define_subType_octet_string : td:FE_SizeableTypeDefinition -> prTd:FE_SizeableTypeDefinition -> soParentTypePackage:string option -> bFixedSize:bool -> string; abstract member Define_new_bit_string_named_bit : td:FE_SizeableTypeDefinition -> sTargetLangBitName:string -> sHexValue:string -> sComment:string -> string; - abstract member Define_new_bit_string : td:FE_SizeableTypeDefinition -> nMin:BigInteger -> nMax:BigInteger -> bFixedSize:bool -> nMaxOctets:BigInteger -> arrsNamedBits:seq -> string; + abstract member Define_new_bit_string : td:FE_SizeableTypeDefinition -> nMin:BigInteger -> nMax:BigInteger -> bFixedSize:bool -> nMaxOctets:BigInteger -> arrsNamedBits:seq -> arrsInvariants:seq -> string; abstract member Define_subType_bit_string : td:FE_SizeableTypeDefinition -> prTd:FE_SizeableTypeDefinition -> soParentTypePackage:string option -> bFixedSize:bool -> string; - abstract member Define_new_sequence_of : td:FE_SizeableTypeDefinition -> nMin:BigInteger -> nMax:BigInteger -> bFixedSize:bool -> sChildType:string -> soChildDefinition:string option -> string; + abstract member Define_new_sequence_of : td:FE_SizeableTypeDefinition -> nMin:BigInteger -> nMax:BigInteger -> bFixedSize:bool -> sChildType:string -> soChildDefinition:string option -> arrsSizeClassDefinition:seq -> arrsSizeObjDefinition:seq -> arrsInvariants:seq -> string; abstract member Define_subType_sequence_of : td:FE_SizeableTypeDefinition -> prTd:FE_SizeableTypeDefinition -> soParentTypePackage:string option -> bFixedSize:bool -> soChildDefinition:string option -> string; abstract member Define_new_sequence_child_bit : sName:string -> string; abstract member Define_new_sequence_child : sName:string -> sType:string -> bIsOptional:bool -> string; abstract member Define_new_sequence_save_pos_child : td:FE_SequenceTypeDefinition -> sName:string -> nMaxBytesInACN:BigInteger -> string; - abstract member Define_new_sequence : td:FE_SequenceTypeDefinition -> arrsChildren:seq -> arrsOptionalChildren:seq -> arrsChildrenDefinitions:seq -> arrsNullFieldsSavePos:seq -> string; - abstract member Define_subType_sequence : td:FE_SequenceTypeDefinition -> prTd:FE_SequenceTypeDefinition -> soParentTypePackage:string option -> arrsOptionalChildren:seq -> string; + abstract member Define_new_sequence : td:FE_SequenceTypeDefinition -> arrsChildren:seq -> arrsOptionalChildren:seq -> arrsChildrenDefinitions:seq -> arrsNullFieldsSavePos:seq -> arrsSizeDefinition:seq -> arrsInvariants:seq -> string; + abstract member Define_subType_sequence : td:FE_SequenceTypeDefinition -> prTd:FE_SequenceTypeDefinition -> soParentTypePackage:string option -> arrsOptionalChildren:seq -> arrsExtraDefs:seq -> string; abstract member Define_new_choice_child : sName:string -> sType:string -> sPresent:string -> string; - abstract member Define_new_choice : td:FE_ChoiceTypeDefinition -> sChoiceIDForNone:string -> sFirstChildNamePresent:string -> arrsChildren:seq -> arrsPresent:seq -> arrsCombined:seq -> nIndexMax:BigInteger -> arrsChildrenDefinitions:seq -> string; + abstract member Define_new_choice : td:FE_ChoiceTypeDefinition -> sChoiceIDForNone:string -> sFirstChildNamePresent:string -> arrsChildren:seq -> arrsPresent:seq -> arrsCombined:seq -> nIndexMax:BigInteger -> arrsChildrenDefinitions:seq -> arrsSizeDefinition:seq -> string; abstract member Define_subType_choice : td:FE_ChoiceTypeDefinition -> prTd:FE_ChoiceTypeDefinition -> soParentTypePackage:string option -> string; abstract member Define_SubType_int_range : soParentTypePackage:string option -> sParentType:string -> noMin:BigInteger option -> noMax:BigInteger option -> string; @@ -240,9 +240,9 @@ Generated by the C stg macros with the following command abstract member methodNameSuffix : unit -> string; abstract member initTypeAssignment_def : sVarName:string -> sStar:string -> sFuncName:string -> sTypeDefName:string -> string; abstract member initTypeAssignment : sVarName:string -> sPtrPrefix:string -> sPtrSuffix:string -> sFuncName:string -> sTypeDefName:string -> sContent:string -> arrsLocalVariables:seq -> sDefaultInitValue:string -> arrsAnnots:seq -> string; - abstract member initInteger : sVal:string -> sValue:string -> bIsOptional:bool -> string; - abstract member initReal : sVal:string -> dValue:double -> bIsOptional:bool -> string; - abstract member initBoolean : sVal:string -> bValue:bool -> bIsOptional:bool -> string; + abstract member initInteger : sVal:string -> sValue:string -> bIsOptional:bool -> sResVar:string -> string; + abstract member initReal : sVal:string -> dValue:double -> bIsOptional:bool -> sResVar:string -> string; + abstract member initBoolean : sVal:string -> bValue:bool -> bIsOptional:bool -> sResVar:string -> string; abstract member initObjectIdentifier_valid : p:string -> sAcc:string -> sI:string -> nIntVal:BigInteger -> string; abstract member initObjectIdentifier : p:string -> sAcc:string -> nSize:BigInteger -> arrsValues:seq -> string; abstract member init_Asn1LocalTime : p:string -> sAcc:string -> tv:Asn1TimeValue -> string; @@ -254,28 +254,28 @@ Generated by the C stg macros with the following command abstract member init_Asn1Date_LocalTimeWithTimeZone : p:string -> sAcc:string -> dt:Asn1DateValue -> tv:Asn1TimeValue -> tz:Asn1TimeZoneValue -> string; abstract member assignAny : p:string -> sValue:string -> sTypeDecl:string -> string; abstract member assignString : p:string -> sValue:string -> string; - abstract member initIA5String : sPtr:string -> sValue:string -> bIsOptional:bool -> string; - abstract member initEnumerated : sVal:string -> sValue:string -> bIsOptional:bool -> string; - abstract member initNull : sVal:string -> bIsOptional:bool -> string; - abstract member initTestCaseIA5String : p:string -> sAcc:string -> nSize:BigInteger -> nMaxSizePlusOne:BigInteger -> i:string -> td:FE_StringTypeDefinition -> bAlpha:bool -> arrnAlphabetAsciiCodes:seq -> nAlphabetLength:BigInteger -> bZero:bool -> string; + abstract member initIA5String : sPtr:string -> sValue:string -> bIsOptional:bool -> sResVar:string -> string; + abstract member initEnumerated : sVal:string -> sValue:string -> sTypeDefName:string -> bIsOptional:bool -> sResVar:string -> string; + abstract member initNull : sVal:string -> bIsOptional:bool -> sResVar:string -> string; + abstract member initTestCaseIA5String : p:string -> sAcc:string -> nSize:BigInteger -> nMaxSizePlusOne:BigInteger -> i:string -> td:FE_StringTypeDefinition -> bAlpha:bool -> arrnAlphabetAsciiCodes:seq -> nAlphabetLength:BigInteger -> bZero:bool -> sResVar:string -> string; abstract member initBitOrOctStringFromCompoundLiteral : p:string -> sCompLiteral:string -> string; abstract member initFixSizeBitOrOctString_bytei : p:string -> sAcc:string -> sI:string -> sByteHexVal:string -> string; abstract member initFixSizeBitOrOctString : p:string -> sAcc:string -> arrsBytes:seq -> string; abstract member initFixVarSizeBitOrOctString : p:string -> sAcc:string -> nSize:BigInteger -> arrsBytes:seq -> string; - abstract member initTestCaseOctetString : p:string -> sAcc:string -> sArrayHolderName:string -> nSize:BigInteger -> i:string -> bIsFixedSize:bool -> bZero:bool -> nMinSize:BigInteger -> bZeroSizedArray:bool -> string; - abstract member initTestCaseBitString : p:string -> sAcc:string -> sArrayHolderName:string -> nSize:BigInteger -> nSizeCeiled:BigInteger -> i:string -> bIsFixedSize:bool -> bZero:bool -> nMinSize:BigInteger -> bIsOptionalField:bool -> string; + abstract member initTestCaseOctetString : p:string -> sAcc:string -> sArrayHolderName:string -> nSize:BigInteger -> i:string -> bIsFixedSize:bool -> bZero:bool -> nMinSize:BigInteger -> bZeroSizedArray:bool -> sResVar:string -> string; + abstract member initTestCaseBitString : p:string -> sAcc:string -> sArrayHolderName:string -> nSize:BigInteger -> nSizeCeiled:BigInteger -> i:string -> bIsFixedSize:bool -> bZero:bool -> nMinSize:BigInteger -> bIsOptionalField:bool -> sResVar:string -> string; abstract member initSequence_pragma : p:string -> string; abstract member initFixedSequenceOf : arrsInnerValues:seq -> string; abstract member initVarSizeSequenceOf : p:string -> sAcc:string -> nSize:BigInteger -> arrsInnerValues:seq -> string; - abstract member initTestCaseSizeSequenceOf_innerItem : bFirst:bool -> bLastItem:bool -> nCaseIdx:BigInteger -> sChildCaseInit:string -> i:string -> nCaseLen:BigInteger -> string; - abstract member initTestCaseSizeSequenceOf : p:string -> sAcc:string -> noMinSize:BigInteger option -> nSize:BigInteger -> bIsFixedSize:bool -> arrsInnerItems:seq -> bMultiCases:bool -> i:string -> string; + abstract member initTestCaseSizeSequenceOf_innerItem : bFirst:bool -> bLastItem:bool -> nCaseIdx:BigInteger -> sChildCaseInit:string -> i:string -> nCaseLen:BigInteger -> sResVar:string -> string; + abstract member initTestCaseSizeSequenceOf : p:string -> sAcc:string -> sArrayHolderName:string -> noMinSize:BigInteger option -> nSize:BigInteger -> bIsFixedSize:bool -> arrsInnerItems:seq -> bMultiCases:bool -> i:string -> sResVar:string -> string; abstract member initSequence_optionalChild : p:string -> sAcc:string -> sChName:string -> sPresentFlag:string -> sChildContent:string -> string; abstract member initSequence : arrsInnerValues:seq -> string; abstract member initSequence_emptySeq : p:string -> string; abstract member initTestCase_sequence_child : p:string -> sAcc:string -> sChName:string -> sChildContent:string -> bOptional:bool -> sInitExpr:string -> string; - abstract member initTestCase_sequence_child_opt : p:string -> sAcc:string -> sChName:string -> string; + abstract member initTestCase_sequence_child_opt : p:string -> sAcc:string -> sChName:string -> sChildTypedef:string -> sResVar:string -> string; abstract member initChoice : p:string -> sAcc:string -> sChildContent:string -> sChildID:string -> sChildName:string -> sChildTypeName:string -> sChoiceTypeName:string -> sChildTempVarName:string -> sChildTempDefaultInit:string -> bComponentTempInit:bool -> string; - abstract member initTestCase_choice_child : p:string -> sAcc:string -> sChildContent:string -> sChildID:string -> sChildName:string -> sChildTypeName:string -> sChoiceTypeName:string -> sChildTempVarName:string -> sChildTempDefaultInit:string -> bIsOptional:bool -> string; + abstract member initTestCase_choice_child : p:string -> sAcc:string -> sChildContent:string -> sChildID:string -> sChildName:string -> sChildTypeName:string -> sChoiceTypeName:string -> sChildTempVarName:string -> sChildTempDefaultInit:string -> bIsOptional:bool -> sResVar:string -> string; abstract member initChildWithInitFunc : p:string -> sChildInitFuncName:string -> string; abstract member initBitStringAtPos : sVarName:string -> sStar:string -> sFuncName:string -> sTypeDefName:string -> sNamedBit:string -> nZeroBasedByteIndex:BigInteger -> sHexByteMax:string -> nZeroBasedBitIndex:BigInteger -> string; abstract member initBitStringAtPos_def : sVarName:string -> sStar:string -> sFuncName:string -> sTypeDefName:string -> sNamedBit:string -> string; @@ -335,11 +335,11 @@ Generated by the C stg macros with the following command abstract member sequence_mandatory_child : sChName:string -> sChildContent:string -> codec:Codec -> string; abstract member sequence_optional_child : p:string -> sAcc:string -> sChName:string -> sChildContent:string -> soExistVar:string option -> soChildExpr:string option -> sChildTypedef:string -> codec:Codec -> string; abstract member sequence_default_child : p:string -> sAcc:string -> sChName:string -> sChildContent:string -> soExistVar:string option -> soChildExpr:string option -> sChildTypedef:string -> sInitWithDefaultValue:string -> codec:Codec -> string; - abstract member sequence_build : p:string -> sTypeDefName:string -> arrsChildren:seq -> string; - abstract member str_FixedSize : p:string -> sTasName:string -> i:string -> sInternalItem:string -> nFixedSize:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> soInitExpr:string option -> bIntroSnap:bool -> soPreSerde:string option -> soPostSerde:string option -> soPostInc:string option -> soInvariant:string option -> codec:Codec -> string; - abstract member str_VarSize : p:string -> sTasName:string -> i:string -> sInternalItem:string -> nSizeMin:BigInteger -> nSizeMax:BigInteger -> nSizeInBits:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> soInitExpr:string option -> codec:Codec -> string; - abstract member seqOf_FixedSize : p:string -> sTasName:string -> i:string -> sInternalItem:string -> nFixedSize:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> sChildInitExpr:string -> codec:Codec -> string; - abstract member seqOf_VarSize : p:string -> sAcc:string -> sTasName:string -> i:string -> sInternalItem:string -> nSizeMin:BigInteger -> nSizeMax:BigInteger -> nSizeInBits:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> sChildInitExpr:string -> sErrCode:string -> nAbsOffset:BigInteger -> nRemainingMinBits:BigInteger -> nLevel:BigInteger -> nIx:BigInteger -> nOffset:BigInteger -> bIntroSnap:bool -> soPreSerde:string option -> soPostSerde:string option -> soPostInc:string option -> soInvariant:string option -> codec:Codec -> string; + abstract member sequence_build : p:string -> sTypeDefName:string -> bIsOptional:bool -> arrsChildren:seq -> string; + abstract member str_FixedSize : p:string -> sTasName:string -> i:string -> sInternalItem:string -> nFixedSize:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> soInitExpr:string option -> bIntroSnap:bool -> soCallAux:string option -> codec:Codec -> string; + abstract member str_VarSize : p:string -> sPIden:string -> sTasName:string -> i:string -> sInternalItem:string -> nSizeMin:BigInteger -> nSizeMax:BigInteger -> nSizeInBits:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> soInitExpr:string option -> soCallAux:string option -> codec:Codec -> string; + abstract member seqOf_FixedSize : p:string -> sTasName:string -> i:string -> sInternalItem:string -> nFixedSize:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> sChildInitExpr:string -> soCallAux:string option -> codec:Codec -> string; + abstract member seqOf_VarSize : p:string -> sAcc:string -> sTasName:string -> i:string -> sInternalItem:string -> nSizeMin:BigInteger -> nSizeMax:BigInteger -> nSizeInBits:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> sChildInitExpr:string -> sErrCode:string -> nAbsOffset:BigInteger -> nRemainingMinBits:BigInteger -> nLevel:BigInteger -> nIx:BigInteger -> nOffset:BigInteger -> bIntroSnap:bool -> soCallAux:string option -> codec:Codec -> string; abstract member octet_FixedSize : sTypeDefName:string -> p:string -> sAcc:string -> nFixedSize:BigInteger -> codec:Codec -> string; abstract member octet_VarSize : sTypeDefName:string -> p:string -> sAcc:string -> nSizeMin:BigInteger -> nSizeMax:BigInteger -> nSizeInBits:BigInteger -> sErrCode:string -> codec:Codec -> string; abstract member bitString_FixSize : sTypeDefName:string -> p:string -> sAcc:string -> nFixedSize:BigInteger -> sErrCode:string -> codec:Codec -> string; @@ -417,8 +417,9 @@ Generated by the C stg macros with the following command abstract member Acn_IA5String_CharIndex_External_Field_Determinant : p:string -> sErrCode:string -> nAsn1Max:BigInteger -> sExtFld:string -> td:FE_StringTypeDefinition -> nCharSize:BigInteger -> nRemainingBits:BigInteger -> codec:Codec -> string; abstract member oct_external_field : sTypedefName:string -> p:string -> sAcc:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> sExtFld:string -> bIsUnsigned:bool -> nAlignSize:BigInteger -> sErrCode:string -> codec:Codec -> string; abstract member oct_external_field_fix_size : sTypedefName:string -> p:string -> sAcc:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> sExtFld:string -> bIsUnsigned:bool -> nAlignSize:BigInteger -> sErrCode:string -> codec:Codec -> string; - abstract member sqf_external_field : sTypeDefName:string -> p:string -> sAcc:string -> i:string -> sInternalItem:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> sExtFld:string -> bIsUnsigned:bool -> nAlignSize:BigInteger -> sErrCode:string -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> sChildInitExpr:string -> bIntroSnap:bool -> soPreSerde:string option -> soPostSerde:string option -> soPostInc:string option -> soInvariant:string option -> codec:Codec -> string; - abstract member sqf_external_field_fix_size : sTypeDefName:string -> p:string -> sAcc:string -> i:string -> sInternalItem:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> sExtFld:string -> bIsUnsigned:bool -> nAlignSize:BigInteger -> sErrCode:string -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> sChildInitExpr:string -> bIntroSnap:bool -> soPreSerde:string option -> soPostSerde:string option -> soPostInc:string option -> soInvariant:string option -> codec:Codec -> string; + abstract member seqOf_VarSize : p:string -> sAcc:string -> sTasName:string -> i:string -> sInternalItem:string -> nSizeMin:BigInteger -> nSizeMax:BigInteger -> nSizeInBits:BigInteger -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> nAlignSize:BigInteger -> sChildInitExpr:string -> sErrCode:string -> nAbsOffset:BigInteger -> nRemainingMinBits:BigInteger -> nLevel:BigInteger -> nIx:BigInteger -> nOffset:BigInteger -> bIntroSnap:bool -> soCallAux:string option -> codec:Codec -> string; + abstract member sqf_external_field : sTypeDefName:string -> p:string -> sAcc:string -> i:string -> sInternalItem:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> sExtFld:string -> bIsUnsigned:bool -> nAlignSize:BigInteger -> sErrCode:string -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> sChildInitExpr:string -> bIntroSnap:bool -> soCallAux:string option -> codec:Codec -> string; + abstract member sqf_external_field_fix_size : sTypeDefName:string -> p:string -> sAcc:string -> i:string -> sInternalItem:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> sExtFld:string -> bIsUnsigned:bool -> nAlignSize:BigInteger -> sErrCode:string -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> sChildInitExpr:string -> bIntroSnap:bool -> soCallAux:string option -> codec:Codec -> string; abstract member oct_sqf_null_terminated : p:string -> sAcc:string -> i:string -> sInternalItem:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> arruNullBytes:seq -> nBitPatternLength:BigInteger -> sErrCode:string -> nIntItemMinSize:BigInteger -> nIntItemMaxSize:BigInteger -> codec:Codec -> string; abstract member bit_string_external_field : sTypeDefName:string -> p:string -> sErrCode:string -> sAcc:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> sExtFld:string -> codec:Codec -> string; abstract member bit_string_external_field_fixed_size : sTypeDefName:string -> p:string -> sErrCode:string -> sAcc:string -> noSizeMin:BigInteger option -> nSizeMax:BigInteger -> sExtFld:string -> codec:Codec -> string; @@ -434,7 +435,7 @@ Generated by the C stg macros with the following command abstract member sequence_save_bitstream : sBitStreamPositionsLocalVar:string -> sChName:string -> codec:Codec -> string; abstract member sequence_acn_child : sChName:string -> sChildContent:string -> sErrCode:string -> soSaveBitStrmPosStatement:string option -> codec:Codec -> string; abstract member sequence_mandatory_child : sChName:string -> sChildContent:string -> soSaveBitStrmPosStatement:string option -> codec:Codec -> string; - abstract member sequence_always_present_child : p:string -> sAcc:string -> sChName:string -> soChildContent:string option -> soChildExpr:string option -> soSaveBitStrmPosStatement:string option -> codec:Codec -> string; + abstract member sequence_always_present_child : p:string -> sAcc:string -> sChName:string -> soChildContent:string option -> soChildExpr:string option -> sChildTypedef:string -> soSaveBitStrmPosStatement:string option -> codec:Codec -> string; abstract member sequence_always_absent_child : p:string -> sAcc:string -> sChName:string -> sChildContent:string -> sChildTypedef:string -> soSaveBitStrmPosStatement:string option -> codec:Codec -> string; abstract member sequence_optional_child : p:string -> sAcc:string -> sChName:string -> sChildContent:string -> soExistVar:string option -> soChildExpr:string option -> sChildTypedef:string -> soSaveBitStrmPosStatement:string option -> codec:Codec -> string; abstract member sequence_default_child : p:string -> sAcc:string -> sChName:string -> sChildContent:string -> sInitWithDefaultValue:string -> soExistVar:string option -> soChildExpr:string option -> sChildTypedef:string -> soSaveBitStrmPosStatement:string option -> codec:Codec -> string; diff --git a/CommonTypes/AcnGenericTypes.fs b/CommonTypes/AcnGenericTypes.fs index 7d6f3e9ac..77caca3ac 100644 --- a/CommonTypes/AcnGenericTypes.fs +++ b/CommonTypes/AcnGenericTypes.fs @@ -15,6 +15,24 @@ with match this with RelativePath p -> p |> Seq.StrJoin "." member this.location = match this with RelativePath p -> p |> List.map(fun z -> z.Location) |> List.head + member this.isPrefixOf (other: RelativePath) = + match this, other with + RelativePath this, RelativePath other -> + List.isPrefixOf this other + + member this.isPrefixOf2 (other: string list) = + match this with + RelativePath this -> + List.isPrefixOf (this |> List.map (fun s -> s.Value)) other + member this.asStringList = + match this with + | RelativePath path -> path |> List.map (fun s -> s.Value) + + member this.concat (other: RelativePath): RelativePath = + match this, other with + RelativePath this, RelativePath other -> + RelativePath (this @ other) + override this.ToString() = this.AsString type AcnEndianness = @@ -25,6 +43,12 @@ type AcnAlignment = | NextByte | NextWord | NextDWord +with + member this.nbBits: bigint = + match this with + | NextByte -> 8I + | NextWord -> 16I + | NextDWord -> 32I @@ -359,11 +383,11 @@ with | TrueFalseValueEncoding (tv,_) -> tv.Value.Length type BooleanAcnProperties = { - encodingPattern : AcnBooleanEncoding option + encodingPattern: AcnBooleanEncoding option } type ChoiceAcnProperties = { - enumDeterminant : RelativePath option + enumDeterminant: RelativePath option } type SequenceAcnProperties = { @@ -418,12 +442,12 @@ with member this.c_name = ToC this.name -type GenericAcnPresentWhenCondition = +type GenericAcnPresentWhenCondition = | GP_PresenceBool of RelativePath | GP_PresenceInt of RelativePath*IntLoc | GP_PresenceStr of RelativePath*StringLoc -type GenAcnEncodingProp = +type GenAcnEncodingProp = | GP_PosInt | GP_TwosComplement | GP_Ascii @@ -431,14 +455,14 @@ type GenAcnEncodingProp = | GP_IEEE754_32 | GP_IEEE754_64 -type GenSizeProperty = +type GenSizeProperty = | GP_Fixed of IntLoc | GP_NullTerminated | GP_SizeDeterminant of RelativePath -type GenericAcnProperty = +type GenericAcnProperty = | ENCODING of GenAcnEncodingProp | SIZE of GenSizeProperty | ALIGNTONEXT of AcnAlignment @@ -460,16 +484,16 @@ type GenericAcnProperty = -type AcnTypeEncodingSpec = { +type AcnTypeEncodingSpec = { acnProperties : GenericAcnProperty list children : ChildSpec list loc : SrcLoc comments : string list - position : SrcLoc*SrcLoc //start pos, end pos + position : SrcLoc*SrcLoc //start pos, end pos antlrSubTree :ITree option } -and ChildSpec = { +and ChildSpec = { name : StringLoc childEncodingSpec : AcnTypeEncodingSpec asn1Type : AcnParamType option // if present then it indicates an ACN inserted type @@ -477,7 +501,7 @@ and ChildSpec = { comments : string list } -type AcnTypeAssignment = { +type AcnTypeAssignment = { name : StringLoc acnParameters : AcnParameter list typeEncodingSpec: AcnTypeEncodingSpec @@ -485,18 +509,18 @@ type AcnTypeAssignment = { position : RangeWithinFile } -type AcnModule = { +type AcnModule = { name : StringLoc typeAssignments : AcnTypeAssignment list } -type AcnFile = { +type AcnFile = { antlrResult : CommonTypes.AntlrParserResult modules : AcnModule list } -type AcnAst = { +type AcnAst = { files : AcnFile list acnConstants : Map } \ No newline at end of file diff --git a/CommonTypes/CommonTypes.fs b/CommonTypes/CommonTypes.fs index 6a6bf3369..e1cb35903 100644 --- a/CommonTypes/CommonTypes.fs +++ b/CommonTypes/CommonTypes.fs @@ -54,34 +54,50 @@ type Selection = { member this.appendSelection (selectionId: string) (selTpe: SelectionType) (selOpt: bool): Selection = let currTpe = this.selectionType assert (currTpe = Value || currTpe = Pointer) + assert (selectionId.Trim() <> "") this.append (if currTpe = Value then ValueAccess (selectionId, selTpe, selOpt) else PointerAccess (selectionId, selTpe, selOpt)) member this.selectionType: SelectionType = if this.path.IsEmpty then this.receiverType else (List.last this.path).selectionType + member this.dropLast: Selection = + if this.path.IsEmpty then this + else {this with path = List.initial this.path} + member this.isOptional: bool = (not this.path.IsEmpty) && match List.last this.path with - |ValueAccess (_exist, _, isOptional) -> isOptional - |PointerAccess (_, _, isOptional) -> isOptional - |ArrayAccess _ -> false + | ValueAccess (_exist, _, isOptional) -> isOptional + | PointerAccess (_, _, isOptional) -> isOptional + | ArrayAccess _ -> false member this.lastId: string = if this.path.IsEmpty then this.receiverId else match List.last this.path with - |ValueAccess (id, _, _) -> id - |PointerAccess (id, _, _) -> id - |ArrayAccess _ -> raise (BugErrorException "lastId on ArrayAccess") + | ValueAccess (id, _, _) -> id + | PointerAccess (id, _, _) -> id + | ArrayAccess _ -> raise (BugErrorException "lastId on ArrayAccess") + + member this.lastIdOrArr: string = + if this.path.IsEmpty then this.receiverId + else + match List.last this.path with + | ValueAccess (id, _, _) -> id + | PointerAccess (id, _, _) -> id + | ArrayAccess _ -> "arr" member this.asLast: Selection = assert (not this.path.IsEmpty) match List.last this.path with - |ValueAccess (id, _, _) -> Selection.emptyPath id Value - |PointerAccess (id, _, _) -> Selection.emptyPath id Pointer - |ArrayAccess _ -> raise (BugErrorException "lastId on ArrayAccess") + | ValueAccess (id, _, _) -> Selection.emptyPath id Value + | PointerAccess (id, _, _) -> Selection.emptyPath id Pointer + | ArrayAccess _ -> raise (BugErrorException "lastId on ArrayAccess") + member this.asLastOrSelf: Selection = + if this.path.IsEmpty then this + else this.asLast type UserError = { line : int @@ -479,6 +495,19 @@ type ReferenceToType with match path with | (MD modName)::_ -> modName | _ -> raise(BugErrorException "Did not find module at the beginning of the scope path") + member this.fieldPath = + let select (xs: ScopeNode list): string list = + xs |> List.map (fun s -> + match s with + | SEQ_CHILD (fld, _) -> fld + | CH_CHILD (fld, _, _) -> fld + | _ -> raise (BugErrorException $"ReferenceToType.fieldPath expects a selection of either Sequence or Choice fields (got {s})")) + match this with + | ReferenceToType path -> + match path with + | (MD _) :: (TA _) :: path -> select path + | _ -> select path + member this.tasInfo = match this with | ReferenceToType path -> @@ -543,6 +572,11 @@ type ReferenceToType with | ReferenceToType path -> ReferenceToType (List.removeAt ((List.length path) - 1) path) + member this.dropModule = + match this with + | ReferenceToType (MD _ :: rest) -> ReferenceToType rest + | _ -> this + member this.parentTypeId = match this with | ReferenceToType path -> diff --git a/CommonTypes/FsUtils.fs b/CommonTypes/FsUtils.fs index b63df6e83..a7e16caa7 100644 --- a/CommonTypes/FsUtils.fs +++ b/CommonTypes/FsUtils.fs @@ -367,6 +367,16 @@ module List = let last lst = lst |> List.rev |> List.head + let rec isPrefixOf (lhs: 'a list) (rhs: 'a list): bool = + match lhs, rhs with + | [], _ -> true + | _, [] -> false + | l :: lhs, r :: rhs -> + l = r && isPrefixOf lhs rhs + + let rec endsWith (xs: 'a list) (suffix: 'a list): bool = + isPrefixOf (List.rev suffix) (List.rev xs) + let rec initial (xs: 'a list): 'a list = match xs with | [] -> failwith "init of an empty list" @@ -379,6 +389,14 @@ module List = let pre, rest = List.splitAt 2 xs List.fold (fun acc x -> acc @ [(snd (List.last acc), x)]) [(pre.[0], pre.[1])] rest + let rec tryFindMap (f: 'a -> 'b option) (xs: 'a list): 'b option = + match xs with + | [] -> None + | x :: xs -> + match f(x) with + | Some(b) -> Some(b) + | None -> tryFindMap f xs + let foldBackWith (f: 'a -> 's -> 's) (init: 'a -> 's) (xs: 'a list): 's = assert (not xs.IsEmpty) List.foldBack f xs.Tail (init xs.Head) @@ -888,5 +906,3 @@ let TL_report () = let (a,b) = subsystems.[z] sprintf "%s nCall %d = took %A" z a b) |> StrJoin_priv "\n" printfn "%s" bbb - - diff --git a/FrontEndAst/AcnCreateFromAntlr.fs b/FrontEndAst/AcnCreateFromAntlr.fs index 66fc6c265..bf07160ab 100644 --- a/FrontEndAst/AcnCreateFromAntlr.fs +++ b/FrontEndAst/AcnCreateFromAntlr.fs @@ -378,8 +378,8 @@ let isCharacterAllowedByAlphabetConstrains (cons:IA5StringConstraint list) (b:by let private mergeStringType (asn1: Asn1Ast.AstRoot) (t: Asn1Ast.Asn1Type option) (loc: SrcLoc) (acnErrLoc: SrcLoc option) (props: GenericAcnProperty list) cons withcons defaultCharSet isNumeric (tdarg: EnmStrGetTypeDefinition_arg) (us: Asn1AcnMergeState) = let acnErrLoc0 = match acnErrLoc with Some a -> a | None -> loc - let sizeUperRange = uPER.getSrtingSizeUperRange cons loc - let sizeUperAcnRange = uPER.getSrtingSizeUperRange (cons@withcons) loc + let sizeUperRange = uPER.getStringSizeUperRange cons loc + let sizeUperAcnRange = uPER.getStringSizeUperRange (cons@withcons) loc let uperCharSet = uPER.getSrtingAlphaUperRange cons defaultCharSet loc let uminSize, umaxSize = uPER.getSizeMinAndMaxValue loc sizeUperRange let aminSize, amaxSize = uPER.getSizeMinAndMaxValue loc sizeUperAcnRange @@ -669,7 +669,7 @@ let private mergeEnumerated (asn1: Asn1Ast.AstRoot) (items: Asn1Ast.NamedItem li let alignment = tryGetProp props (fun x -> match x with ALIGNTONEXT e -> Some e | _ -> None) let acnEncodingClass, acnMinSizeInBits, acnMaxSizeInBits= AcnEncodingClasses.GetEnumeratedEncodingClass asn1.args.integerSizeInBytes items alignment loc acnProperties uperSizeInBits uperSizeInBits encodeValues - + let validItems = items |> List.filter (Asn1Fold.isValidValueGeneric cons (fun a b -> a = b.Name.Value)) |> List.sortBy(fun x -> x.definitionValue) match validItems with @@ -707,8 +707,8 @@ let rec private mergeAcnEncodingSpecs (thisType:AcnTypeEncodingSpec option) (bas | Some x, None -> Some x | Some thisChild, Some baseChild -> match mergeAcnEncodingSpecs (Some thisChild.childEncodingSpec) (Some baseChild.childEncodingSpec) with - | Some combinedEncoingSpec -> - Some ({name = nm; childEncodingSpec = combinedEncoingSpec; asn1Type = thisChild.asn1Type; argumentList = thisChild.argumentList; comments=thisChild.comments}) + | Some combinedEncodingSpec -> + Some ({name = nm; childEncodingSpec = combinedEncodingSpec; asn1Type = thisChild.asn1Type; argumentList = thisChild.argumentList; comments=thisChild.comments}) | None -> None) Some {AcnTypeEncodingSpec.acnProperties = mergedProperties; children = mergedChildren; loc = thisType.loc; comments = thisType.comments; position=thisType.position; antlrSubTree=thisType.antlrSubTree} @@ -834,7 +834,6 @@ let rec private mapAcnParamTypeToAcnAcnInsertedType (asn1:Asn1Ast.AstRoot) (acn: | Asn1Ast.Integer -> let cons = asn1Type0.Constraints |> List.collect (fixConstraint asn1) |> List.map (ConstraintsMapping.getIntegerTypeConstraint asn1 asn1Type0) let uperRange = uPER.getIntTypeConstraintUperRange cons ts.Location - let alignmentSize = AcnEncodingClasses.getAlignmentSize acnAlignment let uperMinSizeInBits, uperMaxSizeInBits = uPER.getRequiredBitsForIntUperEncoding asn1.args.integerSizeInBytes uperRange let acnProperties = {IntegerAcnProperties.encodingProp = getIntEncodingProperty ts.Location props; sizeProp = getIntSizeProperty ts.Location props; endiannessProp = getEndiannessProperty props; mappingFunction = getMappingFunctionProperty ts.Location props} let isUnsigned = @@ -915,14 +914,36 @@ 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) (acnType:AcnTypeEncodingSpec option) - (originalLocation : SrcLoc option) //parameter not used. + (originalLocation : SrcLoc option) (refTypeCons:Asn1Ast.Asn1Constraint list) // constraints applied to this type originating from reference types --> uPER visible (withCons:Asn1Ast.Asn1Constraint list) // constraints applied to this type originating from with component and with components --> non uPER visible (acnArgs : AcnGenericTypes.RelativePath list) + (acnParamSubst: Map) (acnParameters : AcnParameter list) (inheritInfo : InheritanceInfo option) (typeAssignmentInfo : AssignmentInfo option) @@ -934,15 +955,9 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo let acnErrLoc = acnType |> Option.map(fun x -> x.loc) let combinedProperties = acnProps let allCons = t.Constraints@refTypeCons@withCons - let debug = ReferenceToType curPath - //if debug.AsString = "RW90-DATAVIEW.UART-Config" then - // printfn "%s" debug.AsString - //if debug.AsString = "RW90-DATAVIEW.UART-Config.timeout" then - // printfn "%s" debug.AsString - let tfdArg = {GetTypeDefinition_arg.asn1TypeKind = t.Kind; loc = t.Location; curPath = curPath; typeDefPath = typeDefPath; enmItemTypeDefPath = enmItemTypeDefPath; inheritInfo = inheritInfo; typeAssignmentInfo = typeAssignmentInfo; rtlFnc = None; blm=asn1.args.blm} - let fixConstraint = (fixConstraint asn1) - //let actualLocation = match originalLocation with Some l -> l | None -> t.Location + let fixConstraint = fixConstraint asn1 + let asn1Kind, kindState = match t.Kind with | Asn1Ast.Integer -> @@ -1006,25 +1021,29 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo Enumerated o, us1 | Asn1Ast.SequenceOf chType -> let childWithCons = allCons |> List.choose(fun c -> match c with Asn1Ast.WithComponentConstraint (_,w,_) -> Some w| _ -> None) - let myVisibleConstraints = t.Constraints@refTypeCons //|> List.choose(fun c -> match c with Asn1Ast.WithComponentConstraint _ -> None | _ -> Some c) - let myNonVisibleConstraints = withCons //|> List.choose(fun c -> match c with Asn1Ast.WithComponentConstraint _ -> None | _ -> Some c) + let myVisibleConstraints = t.Constraints@refTypeCons + let myNonVisibleConstraints = withCons let cons = myVisibleConstraints |> List.collect fixConstraint |> List.map (ConstraintsMapping.getSequenceOfConstraint asn1 t chType) let wcons = myNonVisibleConstraints |> List.collect fixConstraint |> List.map (ConstraintsMapping.getSequenceOfConstraint asn1 t chType) - let childEncSpec, acnArgs = + let childEncSpec, acnArgs, sizeDetArg = match acnType with - | None -> None, [] + | None -> None, [], None | Some acnType -> + let sizeDetArg = acnType.acnProperties |> List.tryFindMap (fun prop -> + match prop with + | SIZE (GP_SizeDeterminant det) -> Some det + | _ -> None) match acnType.children with - | [] -> None, [] - | c1::[] -> Some c1.childEncodingSpec, c1.argumentList + | [] -> None, [], sizeDetArg + | c1::[] -> Some c1.childEncodingSpec, c1.argumentList, sizeDetArg | c1::c2::_ -> raise(SemanticError(c1.name.Location, (sprintf "%s Unexpected field name" c2.name.Value))) - + let acnArgsSubsted = substAcnArgs acnParamSubst (acnArgs @ Option.toList sizeDetArg) let typeDef, us1 = getSizeableTypeDefinition tfdArg us - let newChType, us2 = mergeType asn1 acn m chType (curPath@[SQF]) (typeDefPath@[SQF]) (enmItemTypeDefPath@[SQF]) childEncSpec None [] childWithCons acnArgs [] None None us1 + let newChType, us2 = mergeType asn1 acn m chType (curPath@[SQF]) (typeDefPath@[SQF]) (enmItemTypeDefPath@[SQF]) childEncSpec None [] childWithCons acnArgs acnParamSubst [] None None us1 let sizeUperRange = uPER.getSequenceOfUperRange cons t.Location let sizeUperAcnRange = uPER.getSequenceOfUperRange (cons@wcons) t.Location @@ -1035,9 +1054,6 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo let maxSize = {SIZE.uper = umaxSize; acn = amaxSize } let hasNCount = minSize.uper <> maxSize.uper - //let minSize, maxSize = uPER.getSizeMinAndMaxValue t.Location sizeUperRange - //let fixAsn1Size = match minSize = maxSize with true -> Some minSize | false -> None - let acnProperties = match acnErrLoc with | Some acnErrLoc -> { SizeableAcnProperties.sizeProp = getSizeableSizeProperty minSize.acn maxSize.acn acnErrLoc combinedProperties} @@ -1046,19 +1062,15 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo let uperMinSizeInBits, _ = uPER.getSizeableTypeSize minSize.uper maxSize.uper newChType.uperMinSizeInBits let _, uperMaxSizeInBits = uPER.getSizeableTypeSize minSize.uper maxSize.uper newChType.uperMaxSizeInBits - let acnUperMinSizeInBits, _ =uPER.getSizeableTypeSize minSize.acn maxSize.acn newChType.acnMinSizeInBits - let _, acnUperMaxSizeInBits = uPER.getSizeableTypeSize minSize.acn maxSize.acn newChType.acnMinSizeInBits - let alignment = tryGetProp combinedProperties (fun x -> match x with ALIGNTONEXT e -> Some e | _ -> None) let acnEncodingClass, acnMinSizeInBits, acnMaxSizeInBits= AcnEncodingClasses.GetSequenceOfEncodingClass alignment loc acnProperties uperMinSizeInBits uperMaxSizeInBits minSize.acn maxSize.acn newChType.acnMinSizeInBits newChType.acnMaxSizeInBits hasNCount - let newKind = {SequenceOf.child=newChType; acnProperties = acnProperties; cons = cons; withcons = wcons;minSize=minSize; maxSize =maxSize; uperMaxSizeInBits = uperMaxSizeInBits; uperMinSizeInBits=uperMinSizeInBits; acnEncodingClass = acnEncodingClass; acnMinSizeInBits = acnMinSizeInBits; acnMaxSizeInBits=acnMaxSizeInBits; typeDef=typeDef} + let newKind = {SequenceOf.child=newChType; acnProperties = acnProperties; cons = cons; withcons = wcons;minSize=minSize; maxSize =maxSize; uperMaxSizeInBits = uperMaxSizeInBits; uperMinSizeInBits=uperMinSizeInBits; acnEncodingClass = acnEncodingClass; acnMinSizeInBits = acnMinSizeInBits; acnMaxSizeInBits=acnMaxSizeInBits; acnArgs=acnArgsSubsted; typeDef=typeDef} SequenceOf newKind, us2 | Asn1Ast.Sequence children -> let childrenNameConstraints = allCons |> List.choose(fun c -> match c with Asn1Ast.WithComponentsConstraint (_,w) -> Some w| _ -> None) |> List.collect id - let myVisibleConstraints = refTypeCons@t.Constraints //|> List.choose(fun c -> match c with Asn1Ast.WithComponentsConstraint _ -> None | _ -> Some c) - let myNonVisibleConstraints = withCons //|> List.choose(fun c -> match c with Asn1Ast.WithComponentsConstraint _ -> None | _ -> Some c) - + let myVisibleConstraints = refTypeCons@t.Constraints + let myNonVisibleConstraints = withCons let cons = myVisibleConstraints|> List.collect fixConstraint |> List.map (ConstraintsMapping.getSeqConstraint asn1 t children) let wcons = myNonVisibleConstraints |> List.collect fixConstraint |> List.map (ConstraintsMapping.getSeqConstraint asn1 t children) @@ -1149,15 +1161,14 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo match cc with | None -> - let newChild, us1 = mergeType asn1 acn m c.Type (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (typeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (enmItemTypeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) None None [] childWithCons [] [] None None us + let newChild, us1 = mergeType asn1 acn m c.Type (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (typeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (enmItemTypeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) None None [] childWithCons [] acnParamSubst [] None None us Asn1Child ({Asn1Child.Name = c.Name; _c_name = c.c_name; _scala_name = c.scala_name; _ada_name = c.ada_name; Type = newChild; Optionality = newOptionality; asn1Comments = c.Comments |> Seq.toList; acnComments=[]}), us1 | Some cc -> match cc.asn1Type with | None -> - let newChild, us1 = mergeType asn1 acn m c.Type (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (typeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (enmItemTypeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (Some cc.childEncodingSpec) None [] childWithCons cc.argumentList [] None None us + let newChild, us1 = mergeType asn1 acn m c.Type (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (typeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (enmItemTypeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (Some cc.childEncodingSpec) None [] childWithCons cc.argumentList acnParamSubst [] None None us Asn1Child ({Asn1Child.Name = c.Name; _c_name = c.c_name; _scala_name = c.scala_name; _ada_name = c.ada_name; Type = newChild; Optionality = newOptionality; asn1Comments = c.Comments |> Seq.toList; acnComments = cc.comments}), us1 | Some xx -> - //let tdprm = {GetTypeDefinition_arg.asn1TypeKind = t.Kind; loc = t.Location; curPath = (curPath@[SEQ_CHILD c.Name.Value]); typeDefPath = (typeDefPath@[SEQ_CHILD c.Name.Value]); inheritInfo =None ; typeAssignmentInfo = None; rtlFnc = None} let newType, us1 = mapAcnParamTypeToAcnAcnInsertedType asn1 acn xx cc.childEncodingSpec.acnProperties (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) us AcnChild({AcnChild.Name = c.Name; id = ReferenceToType(curPath@[SEQ_CHILD (c.Name.Value, isOptional)]); Type = newType; Comments = cc.comments |> Seq.toArray}), us1 @@ -1199,7 +1210,6 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo let uperMinChildrenSize = asn1Children |> List.filter(fun x -> x.Optionality.IsNone) |> List.map(fun x -> x.Type.uperMinSizeInBits) |> Seq.sum let alignment = tryGetProp combinedProperties (fun x -> match x with ALIGNTONEXT e -> Some e | _ -> None) - let alignmentSize = AcnEncodingClasses.getAlignmentSize alignment let acnBitMaskSize = mergedChildren |> List.filter(fun c -> @@ -1214,40 +1224,26 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo | Some (Optional _) -> 0I | _ -> c.acnMinSizeInBits) |> Seq.sum let maxChildrenSize = mergedChildren |> List.map(fun c -> c.acnMaxSizeInBits) |> Seq.sum - let acnMaxSizeInBits = alignmentSize + acnBitMaskSize + maxChildrenSize - let acnMinSizeInBits = alignmentSize + acnBitMaskSize + minChildrenSize + let acnMaxSizeInBits = acnBitMaskSize + maxChildrenSize + AcnEncodingClasses.getAlignmentSize alignment + let acnMinSizeInBits = acnBitMaskSize + minChildrenSize let acnProperties = { SequenceAcnProperties.postEncodingFunction = tryGetProp combinedProperties (fun x -> match x with POST_ENCODING_FUNCTION (md,fn) -> Some (PostEncodingFunction (md,fn)) | _ -> None); preDecodingFunction = tryGetProp combinedProperties (fun x -> match x with PRE_DECODING_FUNCTION (md,fn) -> Some (PreDecodingFunction (md,fn)) | _ -> None) } - (* - match asn1.args.mappingFunctionsModule with - | Some _ -> () - | None -> - let fncName = - match acnProperties.postEncodingFunction with - | Some (PostEncodingFunction fncName) -> Some fncName - | None -> - match acnProperties.preDecodingFunction with - | Some (PreDecodingFunction fncName) -> Some fncName - | None -> None - match fncName with - | None -> () - | Some fncName -> - raise(SemanticError(fncName.Location, (sprintf "Usage of ACN attributes 'post-encoding-function' or 'post-decoding-validator' requires the -mfm argument"))) - *) - Sequence ({Sequence.children = mergedChildren; acnProperties=acnProperties; cons=cons; withcons = wcons;uperMaxSizeInBits=uperBitMaskSize+uperMaxChildrenSize; uperMinSizeInBits=uperBitMaskSize+uperMinChildrenSize;acnMaxSizeInBits=acnMaxSizeInBits;acnMinSizeInBits=acnMinSizeInBits; typeDef=typeDef}), chus - | Asn1Ast.Choice children -> + let acnArgsSubsted = substAcnArgs acnParamSubst acnArgs + Sequence ({Sequence.children = mergedChildren; acnProperties=acnProperties; cons=cons; withcons = wcons;uperMaxSizeInBits=uperBitMaskSize+uperMaxChildrenSize; uperMinSizeInBits=uperBitMaskSize+uperMinChildrenSize;acnMaxSizeInBits=acnMaxSizeInBits;acnMinSizeInBits=acnMinSizeInBits; acnArgs=acnArgsSubsted; typeDef=typeDef}), chus + | Asn1Ast.Choice children -> let childrenNameConstraints = t.Constraints@refTypeCons |> List.choose(fun c -> match c with Asn1Ast.WithComponentsConstraint (_,w) -> Some w| _ -> None) |> List.collect id - let myVisibleConstraints = t.Constraints@refTypeCons //|> List.choose(fun c -> match c with Asn1Ast.WithComponentsConstraint _ -> None | _ -> Some c) - let myNonVisibleConstraints = withCons //|> List.choose(fun c -> match c with Asn1Ast.WithComponentsConstraint _ -> None | _ -> Some c) + let myVisibleConstraints = t.Constraints@refTypeCons + let myNonVisibleConstraints = withCons let cons = myVisibleConstraints |> List.collect fixConstraint |> List.map (ConstraintsMapping.getChoiceConstraint asn1 t children) let wcons = myNonVisibleConstraints |> List.collect fixConstraint |> List.map (ConstraintsMapping.getChoiceConstraint asn1 t children) let typeDef, us1 = getChoiceTypeDefinition tfdArg us - let mergeChild (cc:ChildSpec option) (c:Asn1Ast.ChildInfo) (us:Asn1AcnMergeState)= + + let mergeChild (cc:ChildSpec option) (c:Asn1Ast.ChildInfo) (us:Asn1AcnMergeState) = let childNamedConstraints = childrenNameConstraints |> List.filter(fun x -> x.Name = c.Name) let childWithCons = childNamedConstraints |> List.choose(fun nc -> nc.Constraint) let asn1OptionalityFromWithComponents = @@ -1310,14 +1306,14 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo match cc with | None -> - let newChild, us1 = mergeType asn1 acn m c.Type (curPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) (enmItemTypeDefPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) (typeDefPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) None None [] childWithCons [] [] None None us + let newChild, us1 = mergeType asn1 acn m c.Type (curPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) (enmItemTypeDefPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) (typeDefPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) None None [] childWithCons [] acnParamSubst [] None None us {ChChildInfo.Name = c.Name; _c_name = c.c_name; _scala_name = c.scala_name; _ada_name = c.ada_name; Type = newChild; acnPresentWhenConditions = acnPresentWhenConditions; asn1Comments = c.Comments|> Seq.toList; acnComments = []; present_when_name = present_when_name; Optionality = newOptionality}, us1 | Some cc -> let enumClassName = match us.args.targetLanguages with | Scala::x -> typeDef[Scala].typeName | _ -> "" - let newChild, us1 = mergeType asn1 acn m c.Type (curPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (typeDefPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (enmItemTypeDefPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (Some cc.childEncodingSpec) None [] childWithCons cc.argumentList [] None None us + let newChild, us1 = mergeType asn1 acn m c.Type (curPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (typeDefPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (enmItemTypeDefPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (Some cc.childEncodingSpec) None [] childWithCons cc.argumentList acnParamSubst [] None None us {ChChildInfo.Name = c.Name; _c_name = c.c_name; _scala_name = c.scala_name; _ada_name = c.ada_name; Type = newChild; acnPresentWhenConditions = acnPresentWhenConditions; asn1Comments = c.Comments |> Seq.toList; acnComments = cc.comments ; present_when_name = present_when_name; Optionality = newOptionality}, us1 let mergedChildren, chus = match acnType with @@ -1338,11 +1334,7 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo match acnChildren |> Seq.tryFind(fun a -> a.name.Value = asn1Child.Name.Value) with | Some acnChild -> mergeChild (Some acnChild) asn1Child st | None -> mergeChild None asn1Child st) us1 -// acnChildren |> -// List.map(fun acnChild -> -// match children |> Seq.tryFind (fun a -> a.Name = acnChild.name) with -// | Some x -> mergeChild (Some acnChild) x -// | None -> raise(SemanticError(acnChild.name.Location, (sprintf "invalid name %s" acnChild.name.Value)))) + let alwaysPresentChildren = mergedChildren |> List.filter(fun x -> x.Optionality = Some (ChoiceAlwaysPresent)) match alwaysPresentChildren with | [] -> () @@ -1358,39 +1350,35 @@ 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 mergedChildren = - // match asn1.args.renamePolicy with - // | AlwaysPrefixTypeName -> - // let activeLang = - // match asn1.args.targetLanguages |> List.exists ((=) C) with - // | true -> C - // | false -> Ada - // mergedChildren |> List.map(fun x -> {x with present_when_name = typeDef.[activeLang].typeName + "_" + x.present_when_name}) - // | _ -> mergedChildren - + 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) Choice ({Choice.children = mergedChildren; acnProperties = acnProperties; cons=cons; withcons = wcons; uperMaxSizeInBits=indexSize+maxChildSize; uperMinSizeInBits=indexSize+minChildSize; acnMinSizeInBits =acnMinSizeInBits; - acnMaxSizeInBits=acnMaxSizeInBits; acnLoc = acnLoc; typeDef=typeDef}), chus + acnMaxSizeInBits=acnMaxSizeInBits; acnParameters = acnParameters; acnArgs = acnArgsSubsted; acnLoc = acnLoc; typeDef=typeDef}), chus | Asn1Ast.ReferenceType rf -> let acnArguments = acnArgs let oldBaseType = Asn1Ast.GetBaseTypeByName rf.modName rf.tasName asn1 - //t.Constraints@refTypeCons@withCons - let withCompCons = withCons//allCons |> List.choose(fun c -> match c with Asn1Ast.WithComponentConstraint _ -> Some c| Asn1Ast.WithComponentsConstraint _ -> Some c | _ -> None) - let restCons = t.Constraints@refTypeCons//allCons |> List.choose(fun c -> match c with Asn1Ast.WithComponentConstraint _ -> None | Asn1Ast.WithComponentsConstraint _ -> None | _ -> Some c) + let withCompCons = withCons + let restCons = t.Constraints@refTypeCons let acnTypeAssign = tryFindAcnTypeByName rf.modName rf.tasName acn let baseTypeAcnParams = match acnTypeAssign with | None -> [] | Some x -> x.acnParameters + assert (baseTypeAcnParams.Length = acnArgs.Length) + let baseTypeAcnEncSpec = match acnTypeAssign with | None -> None | Some x -> Some x.typeEncodingSpec let mergedAcnEncSpec = //if a reference type has a component constraint (i.e. it is actually a SEQUENCE, CHOICE or SEQUENCE OF) then we should not merge the ACN spec - //We must take the the ACN specification only from this type and not the base type. The reason is that with the WITH COMONENTS constraints you can + //We must take the the ACN specification only from this type and not the base type. The reason is that with the WITH COMPONENTS constraints you can //change the definition of the type (i.e. make child as always absent). match t.Constraints@refTypeCons |> Seq.exists(fun c -> match c with Asn1Ast.WithComponentConstraint _ -> true | Asn1Ast.WithComponentsConstraint _ -> true | _ -> false) with | true -> acnType @@ -1404,7 +1392,7 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo | [] -> [MD rf.modName.Value; TA rf.tasName.Value] | _ -> typeDefPath let newEnmItemTypeDefPath = [MD rf.modName.Value; TA rf.tasName.Value] - //let typeDef, us1 = getReferenceTypeDefinition asn1 t {tfdArg with typeDefPath = newTypeDefPath; inheritInfo =inheritanceInfo } us + let typeDef, us1 = getReferenceTypeDefinition asn1 t {tfdArg with typeDefPath = newTypeDefPath} us let hasChildren, hasAcnProps = match acnType with @@ -1414,8 +1402,8 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo let b2 =acnEncSpec.acnProperties.Length>0 b1,b2 - - let resolvedType, us2 = mergeType asn1 acn m oldBaseType curPath newTypeDefPath newEnmItemTypeDefPath mergedAcnEncSpec (Some t.Location) restCons withCompCons acnArgs baseTypeAcnParams inheritanceInfo typeAssignmentInfo us1 + let newSubst = addAcnSubst acnParamSubst baseTypeAcnParams acnArgs + let resolvedType, us2 = mergeType asn1 acn m oldBaseType curPath newTypeDefPath newEnmItemTypeDefPath mergedAcnEncSpec (Some t.Location) restCons withCompCons acnArgs newSubst baseTypeAcnParams inheritanceInfo typeAssignmentInfo us1 let hasExtraConstrainsOrChildrenOrAcnArgs = let b1 = hasAdditionalConstraints || hasChildren || acnArguments.Length > 0 || hasAcnProps match resolvedType.Kind with @@ -1494,7 +1482,7 @@ let private mergeTAS (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Module) | None -> [], [] | Some acnTas -> acnTas.acnParameters, acnTas.comments let typeEncodingSpec = tas.Type.acnInfo - let newType, us1 = mergeType asn1 acn m tas.Type [MD m.Name.Value; TA tas.Name.Value] [MD m.Name.Value; TA tas.Name.Value] [MD m.Name.Value; TA tas.Name.Value] typeEncodingSpec (*(acnTas |> Option.map(fun x -> x.typeEncodingSpec))*) None [] [] [] acnParameters None (Some (TypeAssignmentInfo {TypeAssignmentInfo.modName = m.Name.Value; tasName = tas.Name.Value})) us + let newType, us1 = mergeType asn1 acn m tas.Type [MD m.Name.Value; TA tas.Name.Value] [MD m.Name.Value; TA tas.Name.Value] [MD m.Name.Value; TA tas.Name.Value] typeEncodingSpec None [] [] [] Map.empty acnParameters None (Some (TypeAssignmentInfo {TypeAssignmentInfo.modName = m.Name.Value; tasName = tas.Name.Value})) us let newTas = { TypeAssignment.Name = tas.Name @@ -1512,7 +1500,7 @@ let private mergeValueAssignment (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast. match vas.Type.Kind with | Asn1Ast.ReferenceType rf -> (Some ({InheritanceInfo.modName = rf.modName.Value; tasName = rf.tasName.Value; hasAdditionalConstraints=false}))//(Some {InheritanceInfo.id = ReferenceToType [MD rf.modName.Value; TA rf.tasName.Value]; hasAdditionalConstraints=false}) | _ -> None - let newType, us1 = mergeType asn1 acn m vas.Type [MD m.Name.Value; VA vas.Name.Value] [MD m.Name.Value; VA vas.Name.Value] [MD m.Name.Value; VA vas.Name.Value] None None [] [] [] [] inheritInfo (Some (ValueAssignmentInfo {ValueAssignmentInfo.modName = m.Name.Value; vasName = vas.Name.Value})) us + let newType, us1 = mergeType asn1 acn m vas.Type [MD m.Name.Value; VA vas.Name.Value] [MD m.Name.Value; VA vas.Name.Value] [MD m.Name.Value; VA vas.Name.Value] None None [] [] [] Map.empty [] inheritInfo (Some (ValueAssignmentInfo {ValueAssignmentInfo.modName = m.Name.Value; vasName = vas.Name.Value})) us let newVas = { ValueAssignment.Name = vas.Name diff --git a/FrontEndAst/AcnEncodingClasses.fs b/FrontEndAst/AcnEncodingClasses.fs index 39881a694..251723217 100644 --- a/FrontEndAst/AcnEncodingClasses.fs +++ b/FrontEndAst/AcnEncodingClasses.fs @@ -15,15 +15,30 @@ let getAlignmentSize (alignment: AcnAlignment option) = | Some NextWord -> 15I | Some NextDWord -> 31I +let alignedToBits (alignment: bigint) (bits: bigint) = + assert (1I < alignment) + let rem = bits % alignment + if rem <> 0I then bits + (alignment - rem) + else bits +let alignedToByte (b: bigint): bigint = alignedToBits 8I b +let alignedToWord (b: bigint): bigint = alignedToBits 16I b +let alignedToDWord (b: bigint): bigint = alignedToBits 32I b + +let alignedTo (alignment: AcnAlignment option) (b: bigint): bigint = + match alignment with + | None -> b + | Some NextByte -> alignedToByte b + | Some NextWord -> alignedToWord b + | Some NextDWord -> alignedToDWord b + let GetIntEncodingClass (integerSizeInBytes:BigInteger) (alignment: AcnAlignment option) errLoc (p : IntegerAcnProperties) (uperMinSizeInBits:BigInteger) (uperMaxSizeInBits:BigInteger) isUnsigned= - let alignmentSize = getAlignmentSize alignment let maxDigitsInInteger = match integerSizeInBytes with | _ when integerSizeInBytes = 8I && isUnsigned -> UInt64.MaxValue.ToString().Length | _ when integerSizeInBytes = 8I && not(isUnsigned) -> Int64.MaxValue.ToString().Length | _ when integerSizeInBytes = 4I && isUnsigned -> UInt32.MaxValue.ToString().Length | _ when integerSizeInBytes = 4I && not(isUnsigned) -> Int32.MaxValue.ToString().Length - | _ -> raise(SemanticError(errLoc, (sprintf "Unsuported integer size :%A" integerSizeInBytes))) + | _ -> raise(SemanticError(errLoc, (sprintf "Unsupported integer size :%A" integerSizeInBytes))) let maxDigitsInInteger = BigInteger maxDigitsInInteger @@ -107,7 +122,7 @@ let GetIntEncodingClass (integerSizeInBytes:BigInteger) (alignment: AcnAlignment | _, IntNullTerminated _, _ -> raise(SemanticError(errLoc, "null-terminated can be applied only for ASCII or BCD encodings")) | _, _ , LittleEndianness -> raise(SemanticError(errLoc, "Little endian can be applied only for fixed size encodings and size must be 16 or 32 or 64")) - encClass, minSizeInBits+alignmentSize, maxSizeInBits+alignmentSize + encClass, minSizeInBits, maxSizeInBits + getAlignmentSize alignment let GetEnumeratedEncodingClass (integerSizeInBytes:BigInteger) (items:NamedItem list) (alignment: AcnAlignment option) errLoc (p : IntegerAcnProperties) uperMinSizeInBits uperMaxSizeInBits encodeValues = @@ -132,7 +147,6 @@ let GetEnumeratedEncodingClass (integerSizeInBytes:BigInteger) (items:NamedItem *) let GetRealEncodingClass (alignment: AcnAlignment option) errLoc (p : RealAcnProperties) uperMinSizeInBits uperMaxSizeInBits = - let alignmentSize = getAlignmentSize alignment let encClass, minSizeInBits, maxSizeInBits = match p.encodingProp.IsNone && p.endiannessProp.IsNone with | true -> Real_uPER, uperMinSizeInBits, uperMaxSizeInBits @@ -150,7 +164,7 @@ let GetRealEncodingClass (alignment: AcnAlignment option) errLoc (p : RealAcnPr | IEEE754_64, BigEndianness -> Real_IEEE754_64_big_endian, 64I, 64I | IEEE754_32, LittleEndianness -> Real_IEEE754_32_little_endian, 32I, 32I | IEEE754_64, LittleEndianness -> Real_IEEE754_64_little_endian, 64I, 64I - encClass, minSizeInBits+alignmentSize, maxSizeInBits+alignmentSize + encClass, minSizeInBits, maxSizeInBits + getAlignmentSize alignment (* @@ -166,7 +180,6 @@ let GetRealEncodingClass (alignment: AcnAlignment option) errLoc (p : RealAcnPr let GetStringEncodingClass (alignment: AcnAlignment option) errLoc (p : StringAcnProperties) (uperMinSizeInBits:BigInteger) (uperMaxSizeInBits:BigInteger) (asn1Min:BigInteger) (asn1Max:BigInteger) alphaSet = - let alignmentSize = getAlignmentSize alignment let lengthDeterminantSize = GetNumberOfBitsForNonNegativeInteger (asn1Max-asn1Min) let bAsciiEncoding = @@ -189,7 +202,7 @@ let GetStringEncodingClass (alignment: AcnAlignment option) errLoc (p : StringA | true, Some (StrExternalField longField) -> Acn_Enc_String_Ascii_External_Field_Determinant (charSizeInBits, longField), asn1Min*charSizeInBits, asn1Max*charSizeInBits | true, Some (StrNullTerminated nullChars) -> Acn_Enc_String_Ascii_Null_Terminated (charSizeInBits, nullChars), asn1Min*charSizeInBits + (BigInteger (nullChars.Length * 8)), asn1Max*charSizeInBits + (BigInteger (nullChars.Length * 8)) - encClass, minSizeInBits+alignmentSize, maxSizeInBits+alignmentSize + encClass, minSizeInBits, maxSizeInBits + getAlignmentSize alignment //banner text from this link //http://patorjk.com/software/taag/#p=display&v=2&f=ANSI%20Shadow&t=Octet%20String%0A @@ -203,8 +216,6 @@ let GetStringEncodingClass (alignment: AcnAlignment option) errLoc (p : StringA *) let GetOctetBitSeqofEncodingClass (alignment: AcnAlignment option) errLoc (p : SizeableAcnProperties) uperMinSizeInBits uperMaxSizeInBits asn1Min asn1Max internalMinSize internalMaxSize bOcteOrBitString hasNCount = - let alignmentSize = getAlignmentSize alignment - let encClass, minSizeInBits, maxSizeInBits = match p.sizeProp with | None -> @@ -220,7 +231,7 @@ let GetOctetBitSeqofEncodingClass (alignment: AcnAlignment option) errLoc (p : | SzExternalField p -> SZ_EC_ExternalField p, asn1Min*internalMinSize, asn1Max*internalMaxSize | SzNullTerminated tp -> SZ_EC_TerminationPattern tp, (BigInteger tp.Value.Length) + asn1Min*internalMinSize, (BigInteger tp.Value.Length) + asn1Max*internalMaxSize - encClass, minSizeInBits+alignmentSize, maxSizeInBits+alignmentSize + encClass, minSizeInBits, maxSizeInBits + getAlignmentSize alignment let GetOctetStringEncodingClass (alignment: AcnAlignment option) errLoc (p : SizeableAcnProperties) uperMinSizeInBits uperMaxSizeInBits asn1Min asn1Max hasNCount = GetOctetBitSeqofEncodingClass alignment errLoc p uperMinSizeInBits uperMaxSizeInBits asn1Min asn1Max 8I 8I true hasNCount @@ -233,24 +244,24 @@ let GetSequenceOfEncodingClass (alignment: AcnAlignment option) errLoc (p : Siz let GetNullEncodingClass (alignment: AcnAlignment option) errLoc (p : NullTypeAcnProperties) = - let alignmentSize = getAlignmentSize alignment - match p.encodingPattern with - | None -> alignmentSize, alignmentSize - | Some (PATTERN_PROP_BITSTR_VALUE p) -> alignmentSize + p.Value.Length.AsBigInt, alignmentSize + p.Value.Length.AsBigInt - | Some (PATTERN_PROP_OCTSTR_VALUE p) -> alignmentSize + (p.Length*8).AsBigInt, alignmentSize + (p.Length*8).AsBigInt + let sz = + match p.encodingPattern with + | None -> 0I + | Some (PATTERN_PROP_BITSTR_VALUE p) -> p.Value.Length.AsBigInt + | Some (PATTERN_PROP_OCTSTR_VALUE p) -> (p.Length*8).AsBigInt + sz, sz + getAlignmentSize alignment let GetBooleanEncodingClass (alignment: AcnAlignment option) errLoc (p : BooleanAcnProperties) = - let alignmentSize = getAlignmentSize alignment - match p.encodingPattern with - | None -> alignmentSize + 1I, alignmentSize + 1I - | Some (p) -> alignmentSize + p.bitValLength.AsBigInt, alignmentSize + p.bitValLength.AsBigInt - + let sz = + match p.encodingPattern with + | None -> 1I + | Some p -> p.bitValLength.AsBigInt + sz, sz + getAlignmentSize alignment let GetChoiceEncodingClass (children : ChChildInfo list) (alignment: AcnAlignment option) errLoc (p : ChoiceAcnProperties) = let maxChildSize = children |> List.map(fun c -> c.Type.acnMaxSizeInBits) |> Seq.max let minChildSize = children |> List.map(fun c -> c.Type.acnMinSizeInBits) |> Seq.min - let alignmentSize = getAlignmentSize alignment let presenceDeterminantByAcn = p.enumDeterminant.IsSome || (children |> Seq.exists(fun z -> not z.acnPresentWhenConditions.IsEmpty)) @@ -258,6 +269,6 @@ let GetChoiceEncodingClass (children : ChChildInfo list) (alignment: AcnAlignme match presenceDeterminantByAcn with | false -> let indexSize = GetChoiceUperDeterminantLengthInBits(BigInteger(Seq.length children)) - alignmentSize + indexSize + minChildSize, alignmentSize + indexSize + maxChildSize + indexSize + minChildSize, indexSize + maxChildSize + getAlignmentSize alignment | true -> - alignmentSize + minChildSize, alignmentSize + maxChildSize + minChildSize, maxChildSize + getAlignmentSize alignment diff --git a/FrontEndAst/Asn1AcnAst.fs b/FrontEndAst/Asn1AcnAst.fs index 9d4cae78f..780656456 100644 --- a/FrontEndAst/Asn1AcnAst.fs +++ b/FrontEndAst/Asn1AcnAst.fs @@ -562,14 +562,14 @@ type AcnReferenceToIA5String = { modName : StringLoc tasName : StringLoc str : StringType - acnAlignment : AcnAlignment option + acnAlignment : AcnAlignment option } type AcnInteger = { acnProperties : IntegerAcnProperties cons : IntegerTypeConstraint list withcons : IntegerTypeConstraint list - acnAlignment : AcnAlignment option + acnAlignment : AcnAlignment option acnMaxSizeInBits : BigInteger acnMinSizeInBits : BigInteger acnEncodingClass : IntEncodingClass @@ -659,7 +659,32 @@ type Asn1Type = { acnEncSpecAntlrSubTree : ITree option unitsOfMeasure : string option } - + with + member this.externalDependencies: RelativePath list = + match this.Kind with + | ReferenceType tp -> tp.resolvedType.externalDependencies + | Sequence sq -> + let prefixes = sq.children |> List.map (fun c -> + match c with + | Asn1Child c -> c.Name.Value + | AcnChild c -> c.id.lastItem + ) + this.allDependencies |> List.filter (fun dep -> + prefixes |> List.forall (fun prefix -> not (List.isPrefixOf [prefix] dep.asStringList))) + | _ -> this.allDependencies + + member this.allDependencies: RelativePath list = + match this.Kind with + | ReferenceType tp -> tp.resolvedType.allDependencies + | Sequence sq -> + sq.acnArgs @ (sq.children |> List.collect (fun c -> + match c with + | Asn1Child c -> c.Type.allDependencies + | AcnChild _ -> [] + )) + | Choice ch -> ch.acnArgs + | SequenceOf sqf -> sqf.acnArgs + | _ -> [] and Asn1TypeKind = | Integer of Integer @@ -678,7 +703,6 @@ and Asn1TypeKind = | ObjectIdentifier of ObjectIdentifier | ReferenceType of ReferenceType - and SequenceOf = { child : Asn1Type acnProperties : SizeableAcnProperties @@ -692,6 +716,7 @@ and SequenceOf = { acnMaxSizeInBits : BigInteger acnMinSizeInBits : BigInteger acnEncodingClass : SizeableAcnEncodingClass + acnArgs : RelativePath list typeDef : Map } @@ -703,9 +728,9 @@ and Sequence = { withcons : SeqConstraint list uperMaxSizeInBits : BigInteger uperMinSizeInBits : BigInteger - acnMaxSizeInBits : BigInteger acnMinSizeInBits : BigInteger + acnArgs : RelativePath list typeDef : Map } @@ -728,6 +753,7 @@ and Asn1Child = { _ada_name : string Type : Asn1Type Optionality : Asn1Optionality option + // acnArgs : RelativePath list // TODO: RM? asn1Comments : string list acnComments : string list } @@ -747,6 +773,8 @@ and Choice = { acnMaxSizeInBits : BigInteger acnMinSizeInBits : BigInteger + acnParameters : AcnParameter list + acnArgs : RelativePath list acnLoc : SrcLoc option typeDef : Map } @@ -791,6 +819,9 @@ and ReferenceType = { refCons : AnyConstraint list } +type Asn1AcnTypeKind = + | Acn of AcnInsertedType + | Asn1 of Asn1TypeKind type TypeAssignment = { Name:StringLoc @@ -846,14 +877,14 @@ type ReferenceToEnumerated = { } type AcnDependencyKind = - | AcnDepIA5StringSizeDeterminant of (SIZE*SIZE*StringAcnProperties) // The asn1Type has a size dependency in IA5String etc - | AcnDepSizeDeterminant of (SIZE*SIZE*SizeableAcnProperties) // The asn1Type has a size dependency a SEQUENCE OF, BIT STRING, OCTET STRING etc - | AcnDepSizeDeterminant_bit_oct_str_contain of ReferenceType // The asn1Type has a size dependency a BIT STRING, OCTET STRING containing another type - | AcnDepRefTypeArgument of AcnParameter // string is the param name - | AcnDepPresenceBool // points to a SEQUENCE or Choice child - | AcnDepPresence of (RelativePath*Choice) - | AcnDepPresenceStr of (RelativePath*Choice*StringType) - | AcnDepChoiceDeterminant of (ReferenceToEnumerated*Choice*bool) // points to Enumerated type acting as CHOICE determinant; is optional + | AcnDepIA5StringSizeDeterminant of SIZE * SIZE * StringAcnProperties // The asn1Type has a size dependency in IA5String etc + | AcnDepSizeDeterminant of SIZE * SIZE * SizeableAcnProperties // The asn1Type has a size dependency a SEQUENCE OF, BIT STRING, OCTET STRING etc + | AcnDepSizeDeterminant_bit_oct_str_contain of ReferenceType // The asn1Type has a size dependency a BIT STRING, OCTET STRING containing another type + | AcnDepRefTypeArgument of AcnParameter // string is the param name + | AcnDepPresenceBool // points to a SEQUENCE or Choice child + | AcnDepPresence of RelativePath * Choice + | AcnDepPresenceStr of RelativePath * Choice * StringType + | AcnDepChoiceDeterminant of ReferenceToEnumerated * Choice * bool // points to Enumerated type acting as CHOICE determinant; is optional with member this.isString = match this with diff --git a/FrontEndAst/Asn1AcnAstUtilFunctions.fs b/FrontEndAst/Asn1AcnAstUtilFunctions.fs index b9ac61660..cd1db13ff 100644 --- a/FrontEndAst/Asn1AcnAstUtilFunctions.fs +++ b/FrontEndAst/Asn1AcnAstUtilFunctions.fs @@ -13,9 +13,14 @@ open Asn1AcnAst let toByte sizeInBits = sizeInBits/8I + (if sizeInBits % 8I = 0I then 0I else 1I) -type Asn1Type with +type Asn1TypeKind with + member this.ActualType = + match this with + | ReferenceType t -> t.resolvedType.Kind.ActualType + | _ -> this + member this.uperMinSizeInBits = - match this.Kind with + match this with | Integer x -> x.uperMinSizeInBits | Real x -> x.uperMinSizeInBits | IA5String x -> x.uperMinSizeInBits @@ -34,7 +39,7 @@ type Asn1Type with member this.uperMaxSizeInBits = - match this.Kind with + match this with | Integer x -> x.uperMaxSizeInBits | Real x -> x.uperMaxSizeInBits | IA5String x -> x.uperMaxSizeInBits @@ -52,7 +57,7 @@ type Asn1Type with | ReferenceType x -> x.uperMaxSizeInBits member this.acnMinSizeInBits = - match this.Kind with + match this with | Integer x -> x.acnMinSizeInBits | Real x -> x.acnMinSizeInBits | IA5String x -> x.acnMinSizeInBits @@ -70,7 +75,7 @@ type Asn1Type with | ReferenceType x -> x.acnMinSizeInBits member this.acnMaxSizeInBits = - match this.Kind with + match this with | Integer x -> x.acnMaxSizeInBits | Real x -> x.acnMaxSizeInBits | IA5String x -> x.acnMaxSizeInBits @@ -87,6 +92,15 @@ type Asn1Type with | ObjectIdentifier x -> x.acnMaxSizeInBits | ReferenceType x -> x.acnMaxSizeInBits +type Asn1Type with + member this.uperMinSizeInBits = this.Kind.uperMinSizeInBits + + member this.uperMaxSizeInBits = this.Kind.uperMaxSizeInBits + + member this.acnMinSizeInBits = this.Kind.acnMinSizeInBits + + member this.acnMaxSizeInBits = this.Kind.acnMaxSizeInBits + member this.maxSizeInBits (enc: Asn1Encoding): BigInteger = match enc with | UPER -> this.uperMaxSizeInBits @@ -96,20 +110,7 @@ type Asn1Type with member this.ActualType = match this.Kind with | ReferenceType t-> t.resolvedType.ActualType - | Integer _ -> this - | Real _ -> this - | IA5String _ -> this - | NumericString _ -> this - | OctetString _ -> this - | NullType _ -> this - | TimeType _ -> this - | BitString _ -> this - | Boolean _ -> this - | Enumerated _ -> this - | SequenceOf _ -> this - | Sequence _ -> this - | Choice _ -> this - | ObjectIdentifier _ -> this + | _ -> this member this.isComplexType = @@ -617,7 +618,3 @@ type Asn1Type with match tas.Type.inheritInfo with | None -> Some tas.Type | Some _ -> tas.Type.getBaseType r - - - - diff --git a/FrontEndAst/DAst.fs b/FrontEndAst/DAst.fs index 627234793..ed3ca0802 100644 --- a/FrontEndAst/DAst.fs +++ b/FrontEndAst/DAst.fs @@ -63,7 +63,7 @@ type IcdRow = { // An Octet string may return multiple IcdRow (e.g. one for length determinant and one for the body content) and an empty list of IcdTypeAss // A composite type such as SEQUENCE will return multiple IcdRow one for each asn1/acn child. // if the child can be embedded in the parent type then the rows of the child are returned as rows of the parent type. -// if the child cannot be embedded in the parent type then a single IcdRow is returned for this child (of type ReferenceToCompositeTypeRow) and +// if the child cannot be embedded in the parent type then a single IcdRow is returned for this child (of type ReferenceToCompositeTypeRow) and // the child IcdTypeAss is included in the list of the returned IcdTypeAss type IcdInnerTableFunc = string-> string -> string list -> ((IcdRow list)*(IcdTypeAss list)) @@ -252,6 +252,7 @@ Generates initialization statement(s) that initialize the type with the given As *) type InitFunctionResult = { funcBody : string + resultVar : string localVariables : LocalVariable list } @@ -380,7 +381,7 @@ type Asn1IntegerEncodingType = | UnconstrainedMax of bigint | Unconstrained -type TypeEncodingKind = +type TypeEncodingKind = // TODO: Alignment??? | Asn1IntegerEncodingType of Asn1IntegerEncodingType option // None if range min = max | Asn1RealEncodingType of Asn1AcnAst.RealClass | AcnIntegerEncodingType of AcnIntegerEncodingType @@ -411,10 +412,14 @@ type NestingScope = { uperRelativeOffset: bigint acnSiblingMaxSize: bigint option uperSiblingMaxSize: bigint option + // The parents are ordered in ascendant (i.e. the head is a child of the second parent etc.) + parents: (CallerScope * Asn1AcnAst.Asn1Type) list } with - static member init (acnOuterMaxSize: bigint) (uperOuterMaxSize: bigint): NestingScope = - {acnOuterMaxSize = acnOuterMaxSize; uperOuterMaxSize = uperOuterMaxSize; nestingLevel = 0I; nestingIx = 0I; acnRelativeOffset = 0I; uperRelativeOffset = 0I; acnOffset = 0I; uperOffset = 0I; acnSiblingMaxSize = None; uperSiblingMaxSize = None} - + static member init (acnOuterMaxSize: bigint) (uperOuterMaxSize: bigint) (parents: (CallerScope * Asn1AcnAst.Asn1Type) list): NestingScope = + {acnOuterMaxSize = acnOuterMaxSize; uperOuterMaxSize = uperOuterMaxSize; nestingLevel = 0I; nestingIx = 0I; + acnRelativeOffset = 0I; uperRelativeOffset = 0I; acnOffset = 0I; uperOffset = 0I; acnSiblingMaxSize = None; uperSiblingMaxSize = None; + parents = parents} + member this.isInit: bool = this.nestingLevel = 0I && this.nestingIx = 0I type UPERFuncBodyResult = { funcBody : string @@ -424,13 +429,15 @@ type UPERFuncBodyResult = { bBsIsUnReferenced : bool resultExpr : string option typeEncodingKind : TypeEncodingKind option + auxiliaries : string list } type UPerFunction = { funcName : string option // the name of the function func : string option // the body of the function funcDef : string option // function definition in header file - funcBody : NestingScope -> CallerScope -> (UPERFuncBodyResult option) // returns a list of validations statements - funcBody_e : ErrorCode -> NestingScope -> CallerScope -> (UPERFuncBodyResult option) + funcBody : NestingScope -> CallerScope -> bool -> UPERFuncBodyResult option // returns a list of validations statements. The bool indicates whether this was called from ACN context + funcBody_e : ErrorCode -> NestingScope -> CallerScope -> bool -> UPERFuncBodyResult option // bool: whether called from ACN context + auxiliaries : string list } type IcdArgAux = { @@ -450,6 +457,7 @@ type AcnFuncBodyResult = { bBsIsUnReferenced : bool resultExpr : string option typeEncodingKind : TypeEncodingKind option + auxiliaries : string list icdResult : IcdArgAux option } @@ -481,15 +489,18 @@ type XerFunction = +type AcnFuncBody = State-> (AcnGenericTypes.RelativePath * AcnGenericTypes.AcnParameter) list -> NestingScope -> CallerScope -> AcnFuncBodyResult option * State +type AcnFuncBodySeqComp = State-> (AcnGenericTypes.RelativePath * AcnGenericTypes.AcnParameter) list -> NestingScope -> CallerScope -> string -> AcnFuncBodyResult option * State + type AcnFunction = { funcName : string option // the name of the function. Valid only for TASes) func : string option // the body of the function funcDef : string option // function definition - + auxiliaries : string list // takes as input (a) any acn arguments and (b) the field where the encoding/decoding takes place // returns a list of acn encoding statements - funcBody : State->((AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) -> NestingScope -> CallerScope -> ((AcnFuncBodyResult option)*State) - funcBodyAsSeqComp : State->((AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) -> NestingScope -> CallerScope -> string -> ((AcnFuncBodyResult option)*State) + funcBody : AcnFuncBody + funcBodyAsSeqComp : AcnFuncBodySeqComp isTestVaseValid : AutomaticTestCase -> bool icdTas : IcdTypeAss option (* always present in Encode, always None in Decode *) } @@ -803,13 +814,25 @@ and AcnChild = { funcBody : CommonTypes.Codec -> ((AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) -> NestingScope -> CallerScope -> (AcnFuncBodyResult option) // returns a list of validations statements funcUpdateStatement : AcnChildUpdateResult option // vTarget, pSrcRoot, return the update statement Comments : string array + deps : Asn1AcnAst.AcnInsertedFieldDependencies initExpression : string -} +} with + member this.toAsn1AcnAst: Asn1AcnAst.AcnChild = + { + Name = this.Name + id = this.id + Type = this.Type + Comments = this.Comments + } and SeqChildInfo = | Asn1Child of Asn1Child | AcnChild of AcnChild - +with + member this.toAsn1AcnAst: Asn1AcnAst.SeqChildInfo = + match this with + | Asn1Child child -> Asn1AcnAst.Asn1Child child.toAsn1AcnAst + | AcnChild child -> Asn1AcnAst.AcnChild child.toAsn1AcnAst and Asn1Child = { Name : StringLoc @@ -819,8 +842,22 @@ and Asn1Child = { isEqualBodyStats : CallerScope -> CallerScope -> (string*(LocalVariable list)) option Type : Asn1Type Optionality : Asn1AcnAst.Asn1Optionality option + // acnArgs : RelativePath list Comments : string array -} +} with + member this.toAsn1AcnAst: Asn1AcnAst.Asn1Child = + { + Name = this.Name + _c_name = this._c_name + _scala_name = this._scala_name + _ada_name = this._ada_name + Type = this.Type.toAsn1AcnAst + Optionality = this.Optionality + // acnArgs = this.acnArgs + asn1Comments = this.Comments |> Array.toList + acnComments = [] + } + @@ -944,8 +981,14 @@ and DastAcnParameter = { loc : SrcLoc id : ReferenceToType typeDefinitionBodyWithinSeq : string -} - +} with + member this.toAcnGeneric: AcnGenericTypes.AcnParameter = + { + name = this.name + asn1Type = this.asn1Type + loc = this.loc + id = this.id + } and Asn1Type = { @@ -963,7 +1006,24 @@ and Asn1Type = { Kind : Asn1TypeKind unitsOfMeasure : string option -} +} with + member this.toAsn1AcnAst: Asn1AcnAst.Asn1Type = + { + id = this.id + parameterizedTypeInstance = false + Kind = this.Kind.baseKind + acnAlignment = this.acnAlignment + acnParameters = this.acnParameters |> List.map (fun p -> p.toAcnGeneric) + Location = this.Location + moduleName = this.moduleName + acnLocation = None + inheritInfo = this.inheritInfo + typeAssignmentInfo = this.typeAssignmentInfo + acnEncSpecPosition = None + acnEncSpecAntlrSubTree = None + unitsOfMeasure = this.unitsOfMeasure + } + and Asn1TypeKind = | Integer of Integer @@ -980,8 +1040,39 @@ and Asn1TypeKind = | Choice of Choice | ReferenceType of ReferenceType | TimeType of TimeType - - +with + member this.baseKind: Asn1AcnAst.Asn1TypeKind = + match this with + | Integer k -> Asn1AcnAst.Integer k.baseInfo + | Real k -> Asn1AcnAst.Real k.baseInfo + | IA5String k -> Asn1AcnAst.IA5String k.baseInfo + | OctetString k -> Asn1AcnAst.OctetString k.baseInfo + | NullType k -> Asn1AcnAst.NullType k.baseInfo + | BitString k -> Asn1AcnAst.BitString k.baseInfo + | Boolean k -> Asn1AcnAst.Boolean k.baseInfo + | Enumerated k -> Asn1AcnAst.Enumerated k.baseInfo + | ObjectIdentifier k -> Asn1AcnAst.ObjectIdentifier k.baseInfo + | SequenceOf k -> Asn1AcnAst.SequenceOf k.baseInfo + | Sequence k -> Asn1AcnAst.Sequence k.baseInfo + | Choice k -> Asn1AcnAst.Choice k.baseInfo + | ReferenceType k -> Asn1AcnAst.ReferenceType k.baseInfo + | TimeType k -> Asn1AcnAst.TimeType k.baseInfo + member this.isValidFunction: IsValidFunction option = + match this with + | Integer k -> k.isValidFunction + | Real k -> k.isValidFunction + | IA5String k -> k.isValidFunction + | OctetString k -> k.isValidFunction + | NullType k -> None + | BitString k -> k.isValidFunction + | Boolean k -> k.isValidFunction + | Enumerated k -> k.isValidFunction + | ObjectIdentifier k -> k.isValidFunction + | SequenceOf k -> k.isValidFunction + | Sequence k -> k.isValidFunction + | Choice k -> k.isValidFunction + | ReferenceType k -> k.isValidFunction + | TimeType k -> k.isValidFunction let getNextValidErrorCode (cur:State) (errCodeName:string) (comment:string option) = let rec getErrorCode (errCodeName:string) = diff --git a/FrontEndAst/Language.fs b/FrontEndAst/Language.fs index bff573db7..3f7027348 100644 --- a/FrontEndAst/Language.fs +++ b/FrontEndAst/Language.fs @@ -55,6 +55,7 @@ type UncheckedAccessKind = | FullAccess // unwrap all selection, including the last one | PartialAccess // unwrap all but the last selection +// TODO: Remove? type TypeInfo = { uperMaxSizeBits: bigint acnMaxSizeBits: bigint @@ -66,15 +67,18 @@ type TypeInfo = { | UPER -> this.uperMaxSizeBits | _ -> raise (BugErrorException $"Unexpected encoding: {enc}") +// type TypeKind = +// | Asn1Tpe Asn1AcnAst.Asn1TypeKind +// | AcnTpe + type SequenceChildProps = { - // TODO: String not ideal, but array selection index is string anyway... - sel: string option // None for presence bits - // TODO: What about padding? + info: Asn1AcnAst.SeqChildInfo option // None for presence bits + sel: Selection option // None for presence bits uperMaxOffset: bigint acnMaxOffset: bigint - typeInfo: TypeInfo + typeInfo: TypeInfo // TODO: Remove? + typeKind: Asn1AcnAst.Asn1AcnTypeKind } with - member this.maxOffset (enc: Asn1Encoding): bigint = match enc with | ACN -> this.acnMaxOffset @@ -82,6 +86,8 @@ type SequenceChildProps = { | _ -> raise (BugErrorException $"Unexpected encoding: {enc}") type SequenceProofGen = { + t: Asn1AcnAst.Asn1Type + sel: Selection acnOuterMaxSize: bigint uperOuterMaxSize: bigint nestingLevel: bigint @@ -164,14 +170,12 @@ with member this.maxElemSizeInBits (enc: Asn1Encoding): bigint = snd (this.elemSizeInBits enc) - - member this.isFixedSize: bool = match this with | SqOf sqf -> sqf.isFixedSize | StrType st -> st.isFixedSize - +// TODO: rename type SequenceOfLikeProofGen = { acnOuterMaxSize: bigint uperOuterMaxSize: bigint @@ -180,7 +184,10 @@ type SequenceOfLikeProofGen = { acnMaxOffset: bigint uperMaxOffset: bigint typeInfo: TypeInfo - sel: string + nestingScope: NestingScope + cs: CallerScope + encDec: string option + elemDecodeFn: string option ixVariable: string } with member this.outerMaxSize (enc: Asn1Encoding): bigint = @@ -202,6 +209,18 @@ type SequenceOfLikeProofGenResult = { invariant: string } +type SequenceOptionalChild = { + t: Asn1AcnAst.Asn1Type + sq: Asn1AcnAst.Sequence + child: Asn1Child + existVar: string option + p: CallerScope + nestingScope: NestingScope + childBody: CallerScope -> string option -> string +} + +type AcnFuncBody = State -> ErrorCode -> (AcnGenericTypes.RelativePath * AcnGenericTypes.AcnParameter) list -> NestingScope -> CallerScope -> (AcnFuncBodyResult option) * State + [] type ILangGeneric () = abstract member ArrayStartIndex : int @@ -321,12 +340,28 @@ type ILangGeneric () = abstract member getBoardNames : Targets option -> string list abstract member getBoardDirs : Targets option -> string list - abstract member generatePrecond: Asn1Encoding -> t: Asn1AcnAst.Asn1Type -> 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 generateIntFullyConstraintRangeAssert: topLevelTd: string -> CallerScope -> Codec -> string option + abstract member generateOctetStringInvariants: Asn1AcnAst.Asn1Type -> Asn1AcnAst.OctetString -> string list + abstract member generateBitStringInvariants: Asn1AcnAst.Asn1Type -> Asn1AcnAst.BitString -> string list + abstract member generateSequenceInvariants: Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> SeqChildInfo list -> string list + abstract member generateSequenceOfInvariants: Asn1AcnAst.Asn1Type -> Asn1AcnAst.SequenceOf -> DAst.Asn1TypeKind -> string list + + abstract member generateSequenceSizeDefinitions: Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> SeqChildInfo list -> string list + abstract member generateChoiceSizeDefinitions: Asn1AcnAst.Asn1Type -> Asn1AcnAst.Choice -> ChChildInfo list -> string list + abstract member generateSequenceOfSizeDefinitions: Asn1AcnAst.Asn1Type -> Asn1AcnAst.SequenceOf -> DAst.Asn1Type -> string list * string list + abstract member generateSequenceSubtypeDefinitions: dealiased: string -> Asn1AcnAst.Asn1Type -> Asn1AcnAst.Sequence -> Asn1Child list -> string list + default this.getParamType (t:Asn1AcnAst.Asn1Type) (c:Codec) : CallerScope = this.getParamTypeSuffix t "" c default this.requiresHandlingOfEmptySequences = false @@ -339,12 +374,29 @@ type ILangGeneric () = default this.removeFunctionFromBody (sourceCode: string) (functionName: string) : string = sourceCode - default this.generatePrecond _ _ = [] + default this.adaptAcnFuncBody f _ _ _ = f + 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.generateIntFullyConstraintRangeAssert _ _ _ = None + default this.generateOctetStringInvariants _ _ = [] + default this.generateBitStringInvariants _ _ = [] + default this.generateSequenceInvariants _ _ _ = [] + default this.generateSequenceOfInvariants _ _ _ = [] + + default this.generateSequenceSizeDefinitions _ _ _ = [] + default this.generateChoiceSizeDefinitions _ _ _ = [] + default this.generateSequenceOfSizeDefinitions _ _ _ = [], [] + default this.generateSequenceSubtypeDefinitions _ _ _ _ = [] + //most programming languages are case sensitive default _.isCaseSensitive = true default _.getBoardNames _ = [] diff --git a/FrontEndAst/uPER.fs b/FrontEndAst/uPER.fs index 8b90431b0..54039c27e 100644 --- a/FrontEndAst/uPER.fs +++ b/FrontEndAst/uPER.fs @@ -16,24 +16,24 @@ let getRangeTypeConstraintUperRange (c:RangeTypeConstraint<'v1,'v1>) funcNext fu foldRangeTypeConstraint (fun _ r1 r2 b s -> uperUnion r1 r2, s) (fun _ r1 r2 s -> uperIntersection r1 r2 l, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) (fun _ v s -> Concrete (v,v),s) (fun _ v1 v2 minIsIn maxIsIn s -> let val1 = if minIsIn then v1 else (funcNext v1) let val2 = if maxIsIn then v2 else (funcPrev v2) Concrete(val1 , val2), s) - (fun _ v1 minIsIn s -> + (fun _ v1 minIsIn s -> let val1 = if minIsIn then v1 else (funcNext v1) PosInf(val1) ,s ) - (fun _ v2 maxIsIn s -> + (fun _ v2 maxIsIn s -> let val2 = if maxIsIn then v2 else (funcPrev v2) NegInf(val2), s) - c + c 0 - + let getIntTypeConstraintUperRange (cons:IntegerTypeConstraint list) (l:SrcLoc) = let getIntTypeConstraintUperRange (c:IntegerTypeConstraint) (l:SrcLoc) = @@ -51,35 +51,35 @@ let getSizeableTypeConstraintUperRange (c:SizableTypeConstraint<'v>) funcGetLeng foldSizableTypeConstraint (fun _ r1 r2 b s -> uperUnion r1 r2, s) (fun _ r1 r2 s -> uperIntersection r1 r2 l, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) (fun _ v s -> Concrete (funcGetLength v,funcGetLength v),s) - + (fun _ r1 r2 b s -> uperUnion r1 r2, s) (fun _ r1 r2 s -> uperIntersection r1 r2 l, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) (fun _ v s -> Concrete (v,v),s) (fun _ v1 v2 minIsIn maxIsIn s -> let val1 = if minIsIn then v1 else (v1+1u) let val2 = if maxIsIn then v2 else (v2-1u) Concrete(val1 , val2), s) - (fun _ v1 minIsIn s -> + (fun _ v1 minIsIn s -> let val1 = if minIsIn then v1 else (v1+1u) PosInf(val1) ,s ) - (fun _ v2 maxIsIn s -> + (fun _ v2 maxIsIn s -> let val2 = if maxIsIn then v2 else (v2-1u) NegInf(val2), s) - c + c 0 |> fst let getSizeableUperRange (cons:SizableTypeConstraint<'v> list) funcGetLength (l:SrcLoc) = let getConUperRange (c:SizableTypeConstraint<'v>) (l:SrcLoc) = - getSizeableTypeConstraintUperRange c funcGetLength l + getSizeableTypeConstraintUperRange c funcGetLength l cons |> List.fold(fun s c -> uperIntersection s (getConUperRange c l) l) Full let getOctetStringUperRange (cons:OctetStringConstraint list) (l:SrcLoc) = @@ -95,31 +95,31 @@ let getSequenceOfUperRange (cons:SequenceOfConstraint list) (l:SrcLoc) = foldSequenceOfTypeConstraint (fun _ r1 r2 b s -> uperUnion r1 r2, s) (fun _ r1 r2 s -> uperIntersection r1 r2 l, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) (fun _ v s -> Concrete (uint32 v.Length,uint32 v.Length ),s) - + (fun _ r1 r2 b s -> uperUnion r1 r2, s) (fun _ r1 r2 s -> uperIntersection r1 r2 l, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) (fun _ v s -> Concrete (v,v),s) (fun _ v1 v2 minIsIn maxIsIn s -> let val1 = if minIsIn then v1 else (v1+1u) let val2 = if maxIsIn then v2 else (v2-1u) Concrete(val1 , val2), s) - (fun _ v1 minIsIn s -> + (fun _ v1 minIsIn s -> let val1 = if minIsIn then v1 else (v1+1u) PosInf(val1) ,s ) - (fun _ v2 maxIsIn s -> + (fun _ v2 maxIsIn s -> let val2 = if maxIsIn then v2 else (v2-1u) NegInf(val2), s) - (fun _ c l s -> Full, s) - c + (fun _ c l s -> Full, s) + c 0 |> fst cons |> List.fold(fun s c -> uperIntersection s (getConUperRange c l) l) Full @@ -129,50 +129,50 @@ let getStringConstraintSizeUperRange (c:IA5StringConstraint) (l:SrcLoc) = foldStringTypeConstraint (fun _ r1 r2 b s -> uperUnion r1 r2, s) (fun _ r1 r2 s -> uperIntersection r1 r2 l, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) (fun _ v s -> Concrete (uint32 v.Length, uint32 v.Length),s) - + (fun _ r1 r2 b s -> uperUnion r1 r2, s) (fun _ r1 r2 s -> uperIntersection r1 r2 l, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) (fun _ v s -> Concrete (v,v),s) (fun _ v1 v2 minIsIn maxIsIn s -> let val1 = if minIsIn then v1 else (v1+1u) let val2 = if maxIsIn then v2 else (v2-1u) Concrete(val1 , val2), s) - (fun _ v1 minIsIn s -> + (fun _ v1 minIsIn s -> let val1 = if minIsIn then v1 else (v1+1u) PosInf(val1) ,s ) - (fun _ v2 maxIsIn s -> + (fun _ v2 maxIsIn s -> let val2 = if maxIsIn then v2 else (v2-1u) NegInf(val2), s) (fun _ r1 r2 b s -> Full, s) (fun _ r1 r2 s -> Full, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) - (fun _ r s -> Full, s) + (fun _ r s -> Full, s) (fun _ r1 r2 s -> Full, s) (fun _ v s -> Full,s) (fun _ v1 v2 minIsIn maxIsIn s ->Full, s) (fun _ v1 minIsIn s -> Full ,s ) (fun _ v2 maxIsIn s -> Full, s) - c + c 0 |> fst - -let getSrtingSizeUperRange (cons:IA5StringConstraint list) (l:SrcLoc) = + +let getStringSizeUperRange (cons:IA5StringConstraint list) (l:SrcLoc) = let getConUperRange (c:IA5StringConstraint) (l:SrcLoc) = - getStringConstraintSizeUperRange c l + getStringConstraintSizeUperRange c l cons |> List.fold(fun s c -> uperIntersection s (getConUperRange c l) l) Full -let IntersectArrays (s1:char array) (s2:char array) (l:SrcLoc) = +let IntersectArrays (s1:char array) (s2:char array) (l:SrcLoc) = let cache = s2 |> Set.ofSeq let ret = s1 |> Array.filter(fun ch -> cache.Contains(ch)) match ret.Length with @@ -184,8 +184,8 @@ let getStringConstraintAlphabetUperRange (c:IA5StringConstraint) (defaultCharSet let GetCharSetFromString (str:string) = str.ToCharArray() |> Seq.distinct |> Seq.toArray let CharSetUnion(s1: char array) (s2:char array) = [s1;s2] |>Seq.concat |> Seq.distinct |> Seq.toArray - let GetCharSetFromMinMax a b minIsIn maxIsIn = - + let GetCharSetFromMinMax a b minIsIn maxIsIn = + match defaultCharSet |> Array.tryFindIndex(fun ch -> ch = a) with | Some a1 -> match defaultCharSet |> Array.tryFindIndex(fun ch -> ch = b) with @@ -196,30 +196,30 @@ let getStringConstraintAlphabetUperRange (c:IA5StringConstraint) (defaultCharSet | None -> let errMsg = sprintf "Character '%c' does not belong to the base type characters set" b raise(SemanticError(l, errMsg)) - | None -> + | None -> let errMsg = sprintf "Character '%c' does not belong to the base type characters set" a raise(SemanticError(l, errMsg)) - + let nextChar (c:System.Char) = System.Convert.ToChar(System.Convert.ToInt32(c)+1) let prevChar (c:System.Char) = System.Convert.ToChar(System.Convert.ToInt32(c)-1) - + foldStringTypeConstraint (fun _ r1 r2 b s -> CharSetUnion r1 r2, s) (fun _ r1 r2 s -> IntersectArrays r1 r2 l, s) - (fun _ r s -> defaultCharSet, s) + (fun _ r s -> defaultCharSet, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> defaultCharSet, s) + (fun _ r s -> defaultCharSet, s) (fun _ r1 r2 s -> defaultCharSet, s) (fun _ v s -> defaultCharSet, s) - + (fun _ r1 r2 b s -> defaultCharSet, s) (fun _ r1 r2 s -> defaultCharSet, s) - (fun _ r s -> defaultCharSet, s) + (fun _ r s -> defaultCharSet, s) (fun _ r1 r2 s -> defaultCharSet, s) - (fun _ r s -> defaultCharSet, s) + (fun _ r s -> defaultCharSet, s) (fun _ r1 r2 s -> defaultCharSet, s) (fun _ v s -> defaultCharSet,s) (fun _ v1 v2 minIsIn maxIsIn s ->defaultCharSet, s) @@ -228,26 +228,26 @@ let getStringConstraintAlphabetUperRange (c:IA5StringConstraint) (defaultCharSet (fun _ r1 r2 b s -> CharSetUnion r1 r2, s) (fun _ r1 r2 s -> IntersectArrays r1 r2 l, s) - (fun _ r s -> defaultCharSet, s) + (fun _ r s -> defaultCharSet, s) (fun _ r1 r2 s -> r1, s) - (fun _ r s -> defaultCharSet, s) + (fun _ r s -> defaultCharSet, s) (fun _ r1 r2 s -> defaultCharSet, s) (fun _ v s -> GetCharSetFromString v, s) (fun _ v1 v2 minIsIn maxIsIn s -> GetCharSetFromMinMax v1 v2 minIsIn maxIsIn, s) - (fun _ v1 minIsIn s -> + (fun _ v1 minIsIn s -> let v2 = defaultCharSet.[defaultCharSet.Length-1] let val1 = if minIsIn then v1 else (nextChar v1) GetCharSetFromMinMax v1 v2 minIsIn true ,s ) - (fun _ v2 maxIsIn s -> + (fun _ v2 maxIsIn s -> let v1 = defaultCharSet.[0] GetCharSetFromMinMax v1 v2 true maxIsIn, s) - c + c 0 |> fst let getSrtingAlphaUperRange (cons:IA5StringConstraint list) (defaultCharSet: char array) (l:SrcLoc) = let getConUperRange (c:IA5StringConstraint) (l:SrcLoc) = - getStringConstraintAlphabetUperRange c defaultCharSet l + getStringConstraintAlphabetUperRange c defaultCharSet l cons |> List.fold(fun s c -> IntersectArrays s (getConUperRange c l) l) defaultCharSet diff --git a/PUSCScalaTest/asn1-pusc-lib-asn1CompilerTestInput/.gitignore b/PUSCScalaTest/asn1-pusc-lib-asn1CompilerTestInput/.gitignore index 9924965fe..39c6d2c81 100644 --- a/PUSCScalaTest/asn1-pusc-lib-asn1CompilerTestInput/.gitignore +++ b/PUSCScalaTest/asn1-pusc-lib-asn1CompilerTestInput/.gitignore @@ -1,4 +1,6 @@ +atc-*/ out-*/ +mins/ /.build /.dist /*.pro.user @@ -6,4 +8,4 @@ out-*/ *.swp *.7z *.zip -*.tar.gz +*.tar.gz \ No newline at end of file diff --git a/StgAda/acn_a.stg b/StgAda/acn_a.stg index cb689c8ea..3b90b7aef 100644 --- a/StgAda/acn_a.stg +++ b/StgAda/acn_a.stg @@ -811,14 +811,28 @@ end loop; +seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << +result.Success :=

Length >= AND

Length \<= ; +result.errorCode := ; +if result.Success then + adaasn1rtl.encoding.uper.UPER_Enc_ConstraintWholeNumber(bs, .Asn1Int(

Length), , ); + +end if; +>> +seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << +adaasn1rtl.encoding.uper.UPER_Dec_ConstraintWholeNumberInt(bs, nStringLength, , , , result.Success); +result.errorCode := ; +

.Length := nStringLength; + +>> -sqf_external_field_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << >> -sqf_external_field_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << result := .ASN1_RESULT'(Success => \<= AND \<=, ErrorCode => ); if result.Success then

.Length := Integer(); @@ -827,12 +841,12 @@ end if; >> -sqf_external_field_fix_size_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_fix_size_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << >> -sqf_external_field_fix_size_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_fix_size_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << result := .ASN1_RESULT'(Success => \<= AND \<=, ErrorCode => ); if result.Success then @@ -978,14 +992,14 @@ sequence_mandatory_child_decode(sChName, sChildContent, soSaveBitStrmPosStatemen >> -sequence_always_present_child_encode(p, sAcc, sChName, soChildContent, soChildExpr, soSaveBitStrmPosStatement) ::= << +sequence_always_present_child_encode(p, sAcc, sChName, soChildContent, soChildExpr, sChildTypedef, soSaveBitStrmPosStatement) ::= << -- Encode -- marked as ALWAYS PRESENT, so do not look in exist null; >> -sequence_always_present_child_decode(p, sAcc, sChName, soChildContent, soChildExpr, soSaveBitStrmPosStatement) ::= << +sequence_always_present_child_decode(p, sAcc, sChName, soChildContent, soChildExpr, sChildTypedef, soSaveBitStrmPosStatement) ::= << -- Decode -- marked as ALWAYS PRESENT, so do not look in exist diff --git a/StgAda/init_a.stg b/StgAda/init_a.stg index ef74eb735..b823cf31a 100644 --- a/StgAda/init_a.stg +++ b/StgAda/init_a.stg @@ -23,16 +23,16 @@ assignAny(p, sValue, sTypeDecl) ::= "

:= ;" assignString(p, sValue) ::= "

:= ;" -initInteger(p, sValue, bIsOptional) ::= "

:= ;" -initReal(p, dValue, bIsOptional) ::= "

:= ;" -initBoolean(p, bValue, bIsOptional) ::= "

:= TrueFALSE;" +initInteger(p, sValue, bIsOptional, sResVar) ::= "

:= ;" +initReal(p, dValue, bIsOptional, sResVar) ::= "

:= ;" +initBoolean(p, bValue, bIsOptional, sResVar) ::= "

:= TrueFALSE;" -initIA5String(sPtr, sValue, bIsOptional) ::= " := ;" -initEnumerated(sVal, sValue, bIsOptional) ::= " := ;" -initNull(sVal, bIsOptional) ::= " := 0;" +initIA5String(sPtr, sValue, bIsOptional, sResVar) ::= " := ;" +initEnumerated(sVal, sValue, sTypeDefName, bIsOptional, sResVar) ::= " := ;" +initNull(sVal, bIsOptional, sResVar) ::= " := 0;" -initTestCaseIA5String(p, sAcc, nSize, nMaxSizePlusOne, i, td/*:FE_StringTypeDefinition*/, bAlpha, arrnAlphabetAsciiCodes, nAlphabetLength, bZero) ::= << +initTestCaseIA5String(p, sAcc, nSize, nMaxSizePlusOne, i, td/*:FE_StringTypeDefinition*/, bAlpha, arrnAlphabetAsciiCodes, nAlphabetLength, bZero, sResVar) ::= << := 1; while \<= loop -- commented because it casues this warning @@ -126,7 +126,7 @@ initFixVarSizeBitOrOctString(p, sAcc, nSize, arrsBytes) ::= << >> -initTestCaseOctetString(p, sAcc, sArrayHolderName, nSize, i, bIsFixedSize, bZero, nMinSize, bZeroSizedArray) ::= << +initTestCaseOctetString(p, sAcc, sArrayHolderName, nSize, i, bIsFixedSize, bZero, nMinSize, bZeroSizedArray, sResVar) ::= << := 1; while \<= loop -- commented because it casues this warning @@ -138,7 +138,7 @@ end loop;

Length := ; >> -initTestCaseBitString(p, sAcc, sArrayHolderName, nSize, nSizeCeiled, i, bIsFixedSize, bZero, nMinSize, bIsOptionalField) ::= << +initTestCaseBitString(p, sAcc, sArrayHolderName, nSize, nSizeCeiled, i, bIsFixedSize, bZero, nMinSize, bIsOptionalField, sResVar) ::= << := 1; while \<= loop -- commented because it casues this warning @@ -167,12 +167,12 @@ initVarSizeSequenceOf(p, sAcc, nSize, arrsInnerValues) ::= << >> -initTestCaseSizeSequenceOf_innerItem(bFirst, bLastItem, nCaseIdx, sChildCaseInit, i, nCaseLen) ::= << +initTestCaseSizeSequenceOf_innerItem(bFirst, bLastItem, nCaseIdx, sChildCaseInit, i, nCaseLen, sResVar) ::= << ifelsif (-1) mod = thenelse >> -initTestCaseSizeSequenceOf(p, sAcc, noMinSize, nSize, bIsFixedSize, arrsInnerItems, bMultiCases, i) ::= << +initTestCaseSizeSequenceOf(p, sAcc, sArrayHolderName, noMinSize, nSize, bIsFixedSize, arrsInnerItems, bMultiCases, i, sResVar) ::= << := 1; while \<= loop -- commented because it casues this warning @@ -209,7 +209,7 @@ initTestCase_sequence_child(p, sAcc, sChName, sChildContent, bOptional, sInitExp

exist. := 1; >> -initTestCase_sequence_child_opt(p, sAcc, sChName) ::= << +initTestCase_sequence_child_opt(p, sAcc, sChName, sChildTypedef, sResVar) ::= <<

exist. := 0; >> @@ -231,7 +231,7 @@ end; >> -initTestCase_choice_child(p, sAcc, sChildContent, sChildID, sChildName, sChildTypeName, sChoiceTypeName, sChildTempVarName, sChildTempDefaultInit, bIsOptional) ::= << +initTestCase_choice_child(p, sAcc, sChildContent, sChildID, sChildName, sChildTypeName, sChoiceTypeName, sChildTempVarName, sChildTempDefaultInit, bIsOptional, sResVar) ::= <<

:= '(kind => , => \<\>); >> diff --git a/StgAda/spec_a.stg b/StgAda/spec_a.stg index 339afd338..c6a3cb710 100644 --- a/StgAda/spec_a.stg +++ b/StgAda/spec_a.stg @@ -223,7 +223,7 @@ subtype . is Integer range 1..; subtype is .OctetBuffer(); subtype is Integer range ..; @@ -249,7 +249,7 @@ Define_new_bit_string_named_bit(td/*:FE_SizeableTypeDefinition*/, sTargetLangBit _ : constant .Asn1UInt:= 16##; -- >> -Define_new_bit_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, nMaxOctets, arrsNamedBits) ::= << +Define_new_bit_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, nMaxOctets, arrsNamedBits, arrsInvariants) ::= << }; separator="\n"> subtype is Integer range 1..; @@ -274,7 +274,7 @@ Define_subType_bit_string(td/*:FE_SizeableTypeDefinition*/, prTd/*:FE_SizeableTy /*********************************** SEQUENCE OF ************************************************************/ -Define_new_sequence_of(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, sChildType, soChildDefinition) ::= << +Define_new_sequence_of(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, sChildType, soChildDefinition, arrsSizeClassDefinition, arrsSizeObjDefinition, arrsInvariants) ::= << -- -------------------------------------------- @@ -307,7 +307,7 @@ Define_new_sequence_child_bit(sName) ::= ":.bit;" Define_new_sequence_child(sName, sType, bIsOptional) ::= " : ;" Define_new_sequence_save_pos_child(td/*:FE_SequenceTypeDefinition*/, sName, nMaxBytesInACN) ::= " : .encoding.BitstreamPtr;" -Define_new_sequence(td/*:FE_SequenceTypeDefinition*/, arrsChildren, arrsOptionalChildren, arrsChildrenDefinitions, arrsNullFieldsSavePos) ::= << +Define_new_sequence(td/*:FE_SequenceTypeDefinition*/, arrsChildren, arrsOptionalChildren, arrsChildrenDefinitions, arrsNullFieldsSavePos, arrsSizeDefinition, arrsInvariants) ::= << -- -------------------------------------------- @@ -343,7 +343,7 @@ end record; >> -Define_subType_sequence(td/*:FE_SequenceTypeDefinition*/, prTd/*:FE_SequenceTypeDefinition*/, soParentTypePackage, arrsOptionalChildren) ::= << +Define_subType_sequence(td/*:FE_SequenceTypeDefinition*/, prTd/*:FE_SequenceTypeDefinition*/, soParentTypePackage, arrsOptionalChildren, arrsExtraDefs) ::= << @@ -364,7 +364,7 @@ when => : ; >> -Define_new_choice(td/*:FE_ChoiceTypeDefinition*/, sChoiceIDForNone, sFirstChildNamePresent, arrsChildren, arrsPresent, arrsCombined, nIndexMax, arrsChildrenDefinitions) ::= << +Define_new_choice(td/*:FE_ChoiceTypeDefinition*/, sChoiceIDForNone, sFirstChildNamePresent, arrsChildren, arrsPresent, arrsCombined, nIndexMax, arrsChildrenDefinitions, arrsSizeDefinition) ::= << -- -------------------------------------------- @@ -393,4 +393,3 @@ Define_subType_choice(td/*:FE_ChoiceTypeDefinition*/, prTd/*:FE_ChoiceTypeDefini >> - diff --git a/StgAda/uper_a.stg b/StgAda/uper_a.stg index c7e0a4475..1f79326d1 100644 --- a/StgAda/uper_a.stg +++ b/StgAda/uper_a.stg @@ -391,7 +391,7 @@ end if; update_array_item(p, sI, sExpr) ::= "" -sequence_build(p, sTypeDefName, arrsChildren) ::= "" +sequence_build(p, sTypeDefName, bIsOptional, arrsChildren) ::= "" /* SEQUENCE end */ @@ -499,12 +499,12 @@ result.ErrorCode := ; -str_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +str_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soCallAux) ::= << := 1; >> -str_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +str_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soCallAux) ::= << --val := _Init; result := .ASN1_RESULT'(Success => True, ErrorCode => 0); := 1; @@ -512,7 +512,7 @@ result := .ASN1_RESULT'(Success => True, ErrorCode => 0);

( + 1) := adaasn1rtl.NUL; >> -str_VarSize_encode(p, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr) ::= << +str_VarSize_encode(p, sPIden, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, soCallAux) ::= << nStringLength := .getStringSize(

); result.Success := nStringLength >= AND nStringLength \<= ; := 1; @@ -522,7 +522,7 @@ if result.Success then end if; >> -str_VarSize_decode(p, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr) ::= << +str_VarSize_decode(p, sPIden, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, soCallAux) ::= << --val := _Init; result.ErrorCode := .ERR_INSUFFICIENT_DATA; adaasn1rtl.encoding.uper.UPER_Dec_ConstraintWholeNumberInt(bs, nStringLength, , , , result.Success); @@ -592,18 +592,18 @@ if result.Success then end if; >> -seqOf_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr) ::= << +seqOf_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, soCallAux) ::= << := 1; >> -seqOf_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr) ::= << +seqOf_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, soCallAux) ::= << result := .ASN1_RESULT'(Success => True, ErrorCode => 0); := 1; >> -seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << result.Success :=

Length >= AND

Length \<= ; result.errorCode := ; := 1; @@ -613,7 +613,7 @@ if result.Success then end if; >> -seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << adaasn1rtl.encoding.uper.UPER_Dec_ConstraintWholeNumberInt(bs, nStringLength, , , , result.Success); result.errorCode := ; := 1; diff --git a/StgC/acn_c.stg b/StgC/acn_c.stg index 94cc476a6..ad5e106a6 100644 --- a/StgC/acn_c.stg +++ b/StgC/acn_c.stg @@ -501,7 +501,7 @@ if (ret) { ret = ret && \>= 0 && \<= ; *pErrCode = ret ? 0 : ;

= ret ? [] : ; - + } /*COVERAGE_IGNORE*/ >> @@ -606,13 +606,24 @@ if (ret) { >> +seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << +BitStream_EncodeConstraintWholeNumber(pBitStrm,

nCount, , ); + +>> + +seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << +ret = BitStream_DecodeConstraintWholeNumber(pBitStrm, &nCount, , ); +*pErrCode = ret ? 0 : ; +

nCount = (long)nCount; + +>> -sqf_external_field_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << >> -sqf_external_field_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << ret = ((\<=) && (\<=)); if (ret) {

nCount = (int); @@ -620,12 +631,12 @@ if (ret) { } >> -sqf_external_field_fix_size_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_fix_size_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << >> -sqf_external_field_fix_size_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_fix_size_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << ret = ((\<=) && (\<=)); if (ret) { @@ -795,13 +806,13 @@ sequence_mandatory_child_decode(sChName, sChildContent, soSaveBitStrmPosStatemen >> -sequence_always_present_child_encode(p, sAcc, sChName, soChildContent, soChildExpr, soSaveBitStrmPosStatement) ::= << +sequence_always_present_child_encode(p, sAcc, sChName, soChildContent, soChildExpr, sChildTypedef, soSaveBitStrmPosStatement) ::= << /*Encode */ /* marked as ALWAYS PRESENT, so do not look in exist */ >> -sequence_always_present_child_decode(p, sAcc, sChName, soChildContent, soChildExpr, soSaveBitStrmPosStatement) ::= << +sequence_always_present_child_decode(p, sAcc, sChName, soChildContent, soChildExpr, sChildTypedef, soSaveBitStrmPosStatement) ::= << /*Decode */ /* marked as ALWAYS PRESENT */

exist. = 1; diff --git a/StgC/header_c.stg b/StgC/header_c.stg index cc44418eb..f47abffa1 100644 --- a/StgC/header_c.stg +++ b/StgC/header_c.stg @@ -176,7 +176,7 @@ typedef ; /*********************************** OCTET STRING ************************************************************/ -Define_new_octet_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize) ::= << +Define_new_octet_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, arrsInvariants) ::= << typedef struct { int nCount; @@ -197,7 +197,7 @@ Define_new_bit_string_named_bit(td/*:FE_SizeableTypeDefinition*/, sTargetLangBit #define _ 0x /**/ >> -Define_new_bit_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, nMaxOctets, arrsNamedBits) ::= << +Define_new_bit_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, nMaxOctets, arrsNamedBits, arrsInvariants) ::= << }; separator="\n"> typedef struct { @@ -216,7 +216,7 @@ typedef ; /*********************************** SEQUENCE OF ************************************************************/ -Define_new_sequence_of(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, sChildType, soChildDefinition) ::= << +Define_new_sequence_of(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, sChildType, soChildDefinition, arrsSizeClassDefinition, arrsSizeObjDefinition, arrsInvariants) ::= << @@ -246,7 +246,7 @@ Define_new_sequence_child(sName, sType, bIsOptional) ::= " ;" Define_new_sequence_save_pos_child(td/*:FE_SequenceTypeDefinition*/, sName, nMaxBytesInACN) ::= "BitStream ;" -Define_new_sequence(td/*:FE_SequenceTypeDefinition*/, arrsChildren, arrsOptionalChildren, arrsChildrenDefinitions, arrsNullFieldsSavePos) ::= << +Define_new_sequence(td/*:FE_SequenceTypeDefinition*/, arrsChildren, arrsOptionalChildren, arrsChildrenDefinitions, arrsNullFieldsSavePos, arrsSizeDefinition, arrsInvariants) ::= << /*-- --------------------------------------------*/ @@ -271,7 +271,7 @@ typedef struct { } ; >> -Define_subType_sequence(td/*:FE_SequenceTypeDefinition*/, prTd/*:FE_SequenceTypeDefinition*/, soParentTypePackage, arrsOptionalChildren) ::= << +Define_subType_sequence(td/*:FE_SequenceTypeDefinition*/, prTd/*:FE_SequenceTypeDefinition*/, soParentTypePackage, arrsOptionalChildren, arrsExtraDefs) ::= << typedef ; typedef ; @@ -286,7 +286,7 @@ Define_new_choice_child(sName, sType, sPresent) ::=<< ; >> -Define_new_choice(td/*:FE_ChoiceTypeDefinition*/, sChoiceIDForNone, sFirstChildNamePresent, arrsChildren, arrsPresent, arrsCombined, nIndexMax, arrsChildrenDefinitions) ::= << +Define_new_choice(td/*:FE_ChoiceTypeDefinition*/, sChoiceIDForNone, sFirstChildNamePresent, arrsChildren, arrsPresent, arrsCombined, nIndexMax, arrsChildrenDefinitions, arrsSizeDefinition) ::= << /*-- --------------------------------------------*/ diff --git a/StgC/init_c.stg b/StgC/init_c.stg index 86f912a67..c5a5187a0 100644 --- a/StgC/init_c.stg +++ b/StgC/init_c.stg @@ -20,9 +20,9 @@ void ( ) >> -initInteger(sVal, sValue, bIsOptional) ::= " = ;" -initReal(sVal, dValue, bIsOptional) ::= " = ;" -initBoolean(sVal, bValue, bIsOptional) ::= " = TRUEFALSE;" +initInteger(sVal, sValue, bIsOptional, sResVar) ::= " = ;" +initReal(sVal, dValue, bIsOptional, sResVar) ::= " = ;" +initBoolean(sVal, bValue, bIsOptional, sResVar) ::= " = TRUEFALSE;" initObjectIdentifier_valid(p, sAcc, sI, nIntVal) ::= "

values[] = ;" initObjectIdentifier(p, sAcc, nSize, arrsValues) ::= << @@ -80,11 +80,11 @@ assignAny(p, sValue, sTypeDecl) ::= "

= ();" assignString(p, sValue) ::= "memcpy(

, , sizeof());" -initIA5String(sPtr, sValue, bIsOptional) ::= "strcpy(,);" -initEnumerated(sVal, sValue, bIsOptional) ::= " = ;" -initNull(sVal, bIsOptional) ::= " = 0;" +initIA5String(sPtr, sValue, bIsOptional, sResVar) ::= "strcpy(,);" +initEnumerated(sVal, sValue, sTypeDefName, bIsOptional, sResVar) ::= " = ;" +initNull(sVal, bIsOptional, sResVar) ::= " = 0;" -initTestCaseIA5String(p, sAcc, nSize, nMaxSizePlusOne, i, td/*:FE_StringTypeDefinition*/, bAlpha, arrnAlphabetAsciiCodes, nAlphabetLength, bZero) ::= << +initTestCaseIA5String(p, sAcc, nSize, nMaxSizePlusOne, i, td/*:FE_StringTypeDefinition*/, bAlpha, arrnAlphabetAsciiCodes, nAlphabetLength, bZero, sResVar) ::= << memset(

, 0x0, ); @@ -121,7 +121,7 @@ initFixVarSizeBitOrOctString(p, sAcc, nSize, arrsBytes) ::= << >> -initTestCaseOctetString(p, sAcc, sArrayHolderName, nSize, i, bIsFixedSize, bZero, nMinSize, bZeroSizedArray) ::= << +initTestCaseOctetString(p, sAcc, sArrayHolderName, nSize, i, bIsFixedSize, bZero, nMinSize, bZeroSizedArray, sResVar) ::= << memset(

arr, 0x0, ); @@ -137,7 +137,7 @@ while (\< ) { >> -initTestCaseBitString(p, sAcc, sArrayHolderName, nSize, nSizeCeiled, i, bIsFixedSize, bZero, nMinSize, bIsOptionalField) ::= << +initTestCaseBitString(p, sAcc, sArrayHolderName, nSize, nSizeCeiled, i, bIsFixedSize, bZero, nMinSize, bIsOptionalField, sResVar) ::= << memset(

arr, 0x0, /8); @@ -172,12 +172,12 @@ initVarSizeSequenceOf(p, sAcc, nSize, arrsInnerValues) ::= << >> -initTestCaseSizeSequenceOf_innerItem(bFirst, bLastItem, nCaseIdx, sChildCaseInit, i, nCaseLen) ::= << +initTestCaseSizeSequenceOf_innerItem(bFirst, bLastItem, nCaseIdx, sChildCaseInit, i, nCaseLen, sResVar) ::= << ifelse if ( % == ) {else { }>> -initTestCaseSizeSequenceOf(p, sAcc, noMinSize, nSize, bIsFixedSize, arrsInnerItems, bMultiCases, i) ::= << +initTestCaseSizeSequenceOf(p, sAcc, sArrayHolderName, noMinSize, nSize, bIsFixedSize, arrsInnerItems, bMultiCases, i, sResVar) ::= << = 0; while (\< ) { @@ -206,7 +206,7 @@ initTestCase_sequence_child(p, sAcc, sChName, sChildContent, bOptional, sInitExp

exist. = 1; >> -initTestCase_sequence_child_opt(p, sAcc, sChName) ::= << +initTestCase_sequence_child_opt(p, sAcc, sChName, sChildTypedef, sResVar) ::= <<

exist. = 0; >> @@ -217,7 +217,7 @@ initChoice(p, sAcc, sChildContent, sChildID, sChildName, sChildTypeName, sChoice >> -initTestCase_choice_child(p, sAcc, sChildContent, sChildID, sChildName, sChildTypeName, sChoiceTypeName, sChildTempVarName, sChildTempDefaultInit, bIsOptional) ::= << +initTestCase_choice_child(p, sAcc, sChildContent, sChildID, sChildName, sChildTypeName, sChoiceTypeName, sChildTempVarName, sChildTempDefaultInit, bIsOptional, sResVar) ::= << /*set */

kind = ; diff --git a/StgC/uper_c.stg b/StgC/uper_c.stg index 5d30f6a35..72fbacfa4 100644 --- a/StgC/uper_c.stg +++ b/StgC/uper_c.stg @@ -437,7 +437,7 @@ if (

exist.) { } >> -sequence_build(p, sTypeDefName, arrsChildren) ::= "" +sequence_build(p, sTypeDefName, bIsOptional, arrsChildren) ::= "" /* SEQUENCE END */ @@ -452,16 +452,16 @@ for(=0; ( \< (int)) && ret; ++) /* IA5String & Numeric String */ -str_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +str_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soCallAux) ::= << >> -str_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +str_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soCallAux) ::= <<

[] = 0x0; >> -str_VarSize_encode(p, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr) ::= << +str_VarSize_encode(p, sPIden, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, soCallAux) ::= << nStringLength = strlen(

); /*ret = nStringLength >= && nStringLength \<= ;*/ BitStream_EncodeConstraintWholeNumber(pBitStrm, nStringLength, , ); @@ -469,7 +469,7 @@ BitStream_EncodeConstraintWholeNumber(pBitStrm, nStringLength, , > -str_VarSize_decode(p, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr) ::= << +str_VarSize_decode(p, sPIden, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, soCallAux) ::= << ret = BitStream_DecodeConstraintWholeNumber(pBitStrm, &nStringLength, , );

[nStringLength] = 0x0; @@ -478,20 +478,20 @@ ret = BitStream_DecodeConstraintWholeNumber(pBitStrm, &nStringLength, /* SEQUENCE OF & OCTET STRING*/ -seqOf_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr) ::= << +seqOf_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, soCallAux) ::= << >> -seqOf_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr) ::= << +seqOf_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, soCallAux) ::= << >> -seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << BitStream_EncodeConstraintWholeNumber(pBitStrm,

nCount, , ); >> -seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << ret = BitStream_DecodeConstraintWholeNumber(pBitStrm, &nCount, , ); *pErrCode = ret ? 0 : ;

nCount = (long)nCount; diff --git a/StgScala/LangGeneric_scala.fs b/StgScala/LangGeneric_scala.fs index 7af2e10cc..7ba6db19a 100644 --- a/StgScala/LangGeneric_scala.fs +++ b/StgScala/LangGeneric_scala.fs @@ -7,6 +7,8 @@ open Language open System.IO open System open Asn1AcnAstUtilFunctions +open ProofGen +open ProofAst let rec resolveReferenceType(t: Asn1TypeKind): Asn1TypeKind = match t with @@ -141,7 +143,7 @@ type LangGeneric_scala() = override _.doubleValueToString (v:double) = v.ToString(FsUtils.doubleParseString, System.Globalization.NumberFormatInfo.InvariantInfo) - override _.initializeString stringSize = sprintf "Array.fill[UByte](%d.toInt+1)(0x0.toRawUByte)" stringSize + override _.initializeString stringSize = sprintf "Vector.fill[UByte](%d.toInt+1)(0x0.toRawUByte)" stringSize override _.supportsInitExpressions = false @@ -316,34 +318,135 @@ type LangGeneric_scala() = override this.bitStringValueToByteArray (v : BitStringValue) = FsUtils.bitStringValueToByteArray (StringLoc.ByValue v) - // TODO: Replace with an AST when it becomes complete - override this.generatePrecond (enc: Asn1Encoding) (t: Asn1AcnAst.Asn1Type) = [$"codec.base.bitStream.validate_offset_bits({t.maxSizeInBits enc})"] + override this.generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (o: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): string list * string option = + let fds, call = generateSequenceOfLikeAuxiliaries enc o pg codec + fds |> List.collect (fun fd -> [show (FunDefTree fd); ""]), Some (show (ExprTree call)) + + override this.generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): string list * string = + let fds, call = generateOptionalAuxiliaries 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 = + let shouldWrap = + match t.Kind with + | Asn1AcnAst.ReferenceType rt -> rt.hasExtraConstrainsOrChildrenOrAcnArgs + | Asn1AcnAst.Sequence _ | Asn1AcnAst.Choice _ | Asn1AcnAst.SequenceOf _ -> true + | _ -> false + + let rec collectAllAcnChildren (tpe: Asn1AcnAst.Asn1TypeKind): Asn1AcnAst.AcnChild list = + match tpe.ActualType with + | Asn1AcnAst.Sequence sq -> + sq.children |> List.collect (fun c -> + match c with + | Asn1AcnAst.AcnChild c -> [c] + | Asn1AcnAst.Asn1Child c -> collectAllAcnChildren c.Type.Kind + ) + | _ -> [] + + let newFuncBody (s: State) + (err: ErrorCode) + (prms: (AcnGenericTypes.RelativePath * AcnGenericTypes.AcnParameter) list) + (nestingScope: NestingScope) + (p: CallerScope): (AcnFuncBodyResult option) * State = + if not nestingScope.isInit && shouldWrap then + let recP = {p with arg = p.arg.asLastOrSelf} + let recNS = NestingScope.init t.acnMaxSizeInBits t.uperMaxSizeInBits ((p, t) :: nestingScope.parents) + let res, s = funcBody s err prms recNS recP + 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 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 + | 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 + [show (ExprTree precond)] - // TODO: Replace with an AST when it becomes complete override this.generatePostcond (enc: Asn1Encoding) (funcNameBase: string) (p: CallerScope) (t: Asn1AcnAst.Asn1Type) (codec: Codec) = - let suffix, buf = + let errTpe = IntegerType Int + let postcondExpr = match codec with - | Encode -> "", "w1.base.bitStream.buf.length == w2.base.bitStream.buf.length" - | Decode -> "Mut", "w1.base.bitStream.buf == w2.base.bitStream.buf" - let res = $""" -res match - case Left{suffix}(_) => true - case Right{suffix}(res) => - val w1 = old(codec) - val w2 = codec - {buf} && w2.base.bitStream.bitIndex <= w1.base.bitStream.bitIndex + {t.maxSizeInBits enc}""" - Some (res.TrimStart()) + | 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 = - ProofGen.generateSequenceChildProof enc stmts pg codec + 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 + 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 = - ProofGen.generateSequenceOfLikeProof enc o pg codec + generateSequenceOfLikeProof enc o pg codec override this.generateIntFullyConstraintRangeAssert (topLevelTd: string) (p: CallerScope) (codec: Codec): string option = + None + // TODO: Need something better than that + (* match codec with | Encode -> Some $"assert({topLevelTd}_IsConstraintValid(pVal).isRight)" // TODO: HACK: When for CHOICE, `p` gets reset to the choice variant name, so we hardcode "pVal" here... | Decode -> None + *) + override this.generateOctetStringInvariants (t: Asn1AcnAst.Asn1Type) (os: Asn1AcnAst.OctetString): string list = + let inv = octetStringInvariants t os This + [$"require({show (ExprTree inv)})"] + + override this.generateBitStringInvariants (t: Asn1AcnAst.Asn1Type) (bs: Asn1AcnAst.BitString): string list = + let inv = bitStringInvariants t bs This + [$"require({show (ExprTree inv)})"] + + override this.generateSequenceInvariants (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (children: SeqChildInfo list): string list = + let inv = sequenceInvariants t sq (children |> List.choose (fun c -> match c with Asn1Child c -> Some c | AcnChild _ -> None)) This + inv |> Option.map (fun inv -> $"require({show (ExprTree inv)})") |> Option.toList + + override this.generateSequenceOfInvariants (t: Asn1AcnAst.Asn1Type) (sqf: Asn1AcnAst.SequenceOf) (tpe: DAst.Asn1TypeKind): string list = + let inv = sequenceOfInvariants sqf This + [$"require({show (ExprTree inv)})"] + + override this.generateSequenceSizeDefinitions (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (children: SeqChildInfo list): string list = + generateSequenceSizeDefinitions t sq children + + override this.generateChoiceSizeDefinitions (t: Asn1AcnAst.Asn1Type) (choice: Asn1AcnAst.Choice) (children: DAst.ChChildInfo list): string list = + generateChoiceSizeDefinitions t choice children + + override this.generateSequenceOfSizeDefinitions (t: Asn1AcnAst.Asn1Type) (sqf: Asn1AcnAst.SequenceOf) (elemTpe: DAst.Asn1Type): string list * string list = + generateSequenceOfSizeDefinitions t sqf elemTpe + + override this.generateSequenceSubtypeDefinitions (dealiased: string) (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (children: Asn1Child list): string list = + generateSequenceSubtypeDefinitions dealiased t sq children override this.uper = { diff --git a/StgScala/ProofAst.fs b/StgScala/ProofAst.fs index 0f79e2d6a..367f86928 100644 --- a/StgScala/ProofAst.fs +++ b/StgScala/ProofAst.fs @@ -4,26 +4,9 @@ open FsUtils open Language open DAst open CommonTypes +open Asn1AcnAstUtilFunctions -type CodecClass = - | BaseCodec - | AcnCodec - | UperCodec -with - member this.companionObjectName = - match this with - | BaseCodec -> "Codec" - | AcnCodec -> "ACN" - | UperCodec -> "UPER" - -type RuntimeType = - | BitStream - | CodecClass of CodecClass -with - member this.companionObjectName = - match this with - | BitStream -> "BitStream" - | CodecClass cc -> cc.companionObjectName +type Identifier = string // TODO: Find something better type IntegerType = | Byte @@ -35,64 +18,89 @@ type IntegerType = | UInt | ULong +type Annot = + | Opaque + | InlineOnce + | GhostAnnot + | Pure + type Type = | IntegerType of IntegerType - | RuntimeType of RuntimeType - | TypeInfo of TypeInfo - -type Lemma = - | ValidTransitiveLemma - | ValidReflexiveLemma - | ArrayBitRangesEqReflexiveLemma - | ArrayBitRangesEqSlicedLemma - | ValidateOffsetBitsIneqLemma - | ValidateOffsetBitsWeakeningLemma - | ReadPrefixLemma of TypeEncodingKind option - -type BitStreamMethod = - | ResetAt - | BitIndex - | ValidateOffsetBits - -type BitStreamFunction = - | Invariant - -type RTFunction = - | GetBitCountUnsigned + | BooleanType + | UnitType + | DoubleType + | ArrayType of ArrayType + | ClassType of ClassType + | TupleType of Type list +and ClassType = { + id: Identifier + tps: Type list +} +and ArrayType = { + tpe: Type +} type Var = { - name: string + name: Identifier tpe: Type } type Pattern = | Wildcard of Var option | ADTPattern of ADTPattern + | TuplePattern of TuplePattern +with + member this.allBindings: Var list = + match this with + | Wildcard bdg -> bdg |> Option.toList + | ADTPattern pat -> + (pat.binder |> Option.toList) @ (pat.subPatterns |> List.collect (fun subpat -> subpat.allBindings)) + | TuplePattern pat -> + (pat.binder |> Option.toList) @ (pat.subPatterns |> List.collect (fun subpat -> subpat.allBindings)) and ADTPattern = { binder: Var option - id: string // TODO: Have something better + id: Identifier // TODO: Have something better subPatterns: Pattern list } +and TuplePattern = { + binder: Var option + subPatterns: Pattern list +} +// TODO: Have "Tree" as well -type Expr = +type Tree = + | ExprTree of Expr + | FunDefTree of FunDef + | LocalFunDefTree of LocalFunDef + +and Expr = | Var of Var | Block of Expr list | Ghost of Expr | Locally of Expr - | AppliedLemma of AppliedLemma | Snapshot of Expr + | FreshCopy of Expr + | Unfold of Expr | Let of Let | LetGhost of Let + | LetTuple of LetTuple + | LetRec of LetRec | Assert of Expr | Check of Expr - | BitStreamMethodCall of BitStreamMethodCall - | BitStreamFunctionCall of BitStreamFunctionCall - | RTFunctionCall of RTFunctionCall + | FunctionCall of FunctionCall + | ApplyLetRec of ApplyLetRec + | MethodCall of MethodCall + | Tuple of Expr list | TupleSelect of Expr * int - | FieldSelect of Expr * string + | FieldSelect of Expr * Identifier | ArraySelect of Expr * Expr + | ArrayUpdate of Expr * Expr * Expr | ArrayLength of Expr + | ClassCtor of ClassCtor + | Old of Expr + | Return of Expr + | IfExpr of IfExpr | MatchExpr of MatchExpr | And of Expr list | SplitAnd of Expr list @@ -100,37 +108,53 @@ type Expr = | Not of Expr | Equals of Expr * Expr | Mult of Expr * Expr - | Plus of Expr * Expr + | Mod of Expr * Expr + | Plus of Expr list | Minus of Expr * Expr | Leq of Expr * Expr + | UnitLit + | BoolLit of bool | IntLit of IntegerType * bigint | EncDec of string + | This // TODO: Add type | SelectionExpr of string // TODO: Not ideal -and AppliedLemma = { - lemma: Lemma - args: Expr list -} + and Let = { bdg: Var e: Expr body: Expr } - -and BitStreamMethodCall = { - method: BitStreamMethod - recv: Expr +and LetTuple = { + bdgs: Var list + e: Expr + body: Expr +} +and LetRec = { + fds: LocalFunDef list + body: Expr +} +and FunctionCall = { + prefix: Identifier list + id: Identifier + tps: Type list args: Expr list } -and BitStreamFunctionCall = { - fn: BitStreamFunction +and ApplyLetRec = { + id: Identifier args: Expr list } -and RTFunctionCall = { - fn: RTFunction +and MethodCall = { + recv: Expr + id: Identifier args: Expr list } +and IfExpr = { + cond: Expr + thn: Expr + els: Expr +} and MatchExpr = { scrut: Expr cases: MatchCase list @@ -139,6 +163,27 @@ and MatchCase = { pattern: Pattern rhs: Expr } +and ClassCtor = { + ct: ClassType + args: Expr list +} +and PreSpec = + | LetSpec of Var * Expr + | Precond of Expr + | Measure of Expr + +and FunDefLike = { + id: Identifier // TODO: Quid name clash??? + prms: Var list + annots: Annot list + specs: PreSpec list + postcond: (Var * Expr) option + returnTpe: Type + body: Expr +} +and FunDef = FunDefLike +and LocalFunDef = FunDefLike + let mkBlock (exprs: Expr list): Expr = if exprs.Length = 1 then exprs.Head @@ -146,104 +191,568 @@ let mkBlock (exprs: Expr list): Expr = exprs |> List.collect (fun e -> match e with Block exprs -> exprs | _ -> [e]) |> Block +let mkTuple (exprs: Expr list): Expr = + assert (not exprs.IsEmpty) + if exprs.Length = 1 then exprs.Head + else Tuple exprs + +let tupleType (tps: Type list): Type = + assert (not tps.IsEmpty) + if tps.Length = 1 then tps.Head + else TupleType tps + +let rec substVars (vs: (Var * Expr) list) (inExpr: Expr): Expr = + let rec loop (inExpr: Expr): Expr = + let substInLetGeneric (bdgs: Var list) (e: Expr) (body: Expr): Expr * Expr = + let newE = loop e + let newVs = vs |> List.filter (fun (v, _) -> not (bdgs |> List.contains v)) + let newBody = substVars newVs body + (newE, newBody) + + let substInLet (lt: Let): Let = + let newE, newBody = substInLetGeneric [lt.bdg] lt.e lt.body + {lt with e = newE; body = newBody} + + let substFd (fd: FunDefLike): FunDefLike = + let newVs = vs |> List.filter (fun (v, _) -> not (fd.prms |> List.contains v)) + {fd with body = substVars newVs fd.body} + + match inExpr with + | Var v2 -> + vs |> List.tryFind (fun (v, _) -> v = v2) + |> Option.map (fun (_, e) -> e) + |> Option.defaultValue inExpr + | Block stmts -> + mkBlock (stmts |> List.map loop) + | Ghost inExpr -> Ghost (loop inExpr) + | Locally inExpr -> Ghost (loop inExpr) + | Snapshot inExpr -> Ghost (loop inExpr) + | FreshCopy inExpr -> Ghost (loop inExpr) + | Unfold inExpr -> Ghost (loop inExpr) + | Let lt -> Let (substInLet lt) + | LetGhost lt -> LetGhost (substInLet lt) + | LetTuple lt -> + let newE, newBody = substInLetGeneric lt.bdgs lt.e lt.body + LetTuple {lt with e = newE; body = newBody} + | LetRec lrec -> + LetRec {fds = lrec.fds |> List.map substFd; body = loop lrec.body} + | Assert inExpr -> Assert (loop inExpr) + | Check inExpr -> Check (loop inExpr) + | FunctionCall call -> + FunctionCall {call with args = call.args |> List.map loop} + | ApplyLetRec call -> + ApplyLetRec {call with args = call.args |> List.map loop} + | MethodCall call -> + MethodCall {call with recv = loop call.recv; args = call.args |> List.map loop} + | Tuple tpls -> Tuple (tpls |> List.map loop) + | TupleSelect (recv, ix) -> TupleSelect (loop recv, ix) + | FieldSelect (recv, id) -> FieldSelect (loop recv, id) + | ArraySelect (arr, ix) -> ArraySelect (loop arr, loop ix) + | ArrayUpdate (arr, ix, newVal) -> ArrayUpdate (loop arr, loop ix, loop newVal) + | ArrayLength arr -> ArrayLength (loop arr) + | ClassCtor ct -> ClassCtor {ct with args = ct.args |> List.map loop} + | Old inExpr -> Old (loop inExpr) + | Return inExpr -> Return (loop inExpr) + | IfExpr ifExpr -> IfExpr {cond = loop ifExpr.cond; thn = loop ifExpr.thn; els = loop ifExpr.els} + | MatchExpr mtch -> + let cases = mtch.cases |> List.map (fun cse -> + let allBdgs = cse.pattern.allBindings + let newVs = vs |> List.filter (fun (v, _) -> not (allBdgs |> List.contains v)) + {cse with rhs = substVars newVs cse.rhs} + ) + MatchExpr {scrut = loop mtch.scrut; cases = cases} + | And conjs -> And (conjs |> List.map loop) + | SplitAnd conjs -> SplitAnd (conjs |> List.map loop) + | Or disjs -> Or (disjs |> List.map loop) + | Not inExpr -> Not (loop inExpr) + | Equals (lhs, rhs) -> Equals (loop lhs, loop rhs) + | Mult (lhs, rhs) -> Mult (loop lhs, loop rhs) + | Mod (lhs, rhs) -> Mod (loop lhs, loop rhs) + | 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 + if vs.IsEmpty then inExpr else loop inExpr + +let bitStreamId: Identifier = "BitStream" +let codecId: Identifier = "Codec" +let uperId: Identifier = "UPER" +let acnId: Identifier = "ACN" + +let listId: Identifier = "List" +let consId: Identifier = "Cons" +let nilId: Identifier = "Nil" + +let vecId: Identifier = "Vector" + +let optionId: Identifier = "Option" +let someId: Identifier = "Some" +let noneId: Identifier = "None" + +let optionMutId: Identifier = "OptionMut" +let someMutId: Identifier = "SomeMut" +let noneMutId: Identifier = "NoneMut" + +let eitherId: Identifier = "Either" +let leftId: Identifier = "Left" +let rightId: Identifier = "Right" + +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 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 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 someExpr (tpe: Type) (e: Expr): Expr = ClassCtor (some tpe e) +let none (tpe: Type): ClassCtor = {ct = noneTpe 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 someMutExpr (tpe: Type) (e: Expr): Expr = ClassCtor (someMut tpe e) +let noneMut (tpe: Type): ClassCtor = {ct = noneMutTpe tpe; args = []} +let noneMutExpr (tpe: Type): Expr = ClassCtor (noneMut tpe) + +let isDefinedExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "isDefined"; args = []} +let 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 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 leftExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (left l r e) +let right (l: Type) (r: Type) (e: Expr): ClassCtor = {ct = rightTpe l r; args = [e]} +let rightExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (right l r e) +let isRightExpr (recv: Expr): Expr = MethodCall {recv = recv; id = "isRight"; args = []} +let 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 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 rightMutExpr (l: Type) (r: Type) (e: Expr): Expr = ClassCtor (rightMut l r e) + +let listMatch (scrut: Expr) + (hdBdg: Var option) (tailBdg: Var option) (consBody: Expr) + (nilBody: Expr): MatchExpr = + { + scrut = scrut + cases = [ + { + pattern = ADTPattern {binder = None; id = consId; subPatterns = [Wildcard hdBdg; Wildcard tailBdg]} + rhs = consBody + } + { + pattern = ADTPattern {binder = None; id = nilId; subPatterns = []} + rhs = nilBody + } + ] + } + +let listMatchExpr (scrut: Expr) + (hdBdg: Var option) (tailBdg: Var option) (consBody: Expr) + (nilBody: Expr): Expr = + MatchExpr (listMatch scrut hdBdg tailBdg consBody nilBody) +let optionGenMatch (someId: Identifier) (noneId: Identifier) + (scrut: Expr) + (someBdg: Var option) (someBody: Expr) + (noneBody: Expr): MatchExpr = + { + scrut = scrut + cases = [ + { + pattern = ADTPattern {binder = None; id = someId; subPatterns = [Wildcard someBdg]} + rhs = someBody + } + { + pattern = ADTPattern {binder = None; id = noneId; subPatterns = []} + rhs = noneBody + } + ] + } +let optionMatch (scrut: Expr) + (someBdg: Var option) (someBody: Expr) + (noneBody: Expr): MatchExpr = + optionGenMatch someId noneId scrut someBdg someBody noneBody +let optionMatchExpr (scrut: Expr) + (someBdg: Var option) (someBody: Expr) + (noneBody: Expr): Expr = + MatchExpr (optionMatch scrut someBdg someBody noneBody) + +let optionMutMatch (scrut: Expr) + (someBdg: Var option) (someBody: Expr) + (noneBody: Expr): MatchExpr = + optionGenMatch someMutId noneMutId scrut someBdg someBody noneBody +let optionMutMatchExpr (scrut: Expr) + (someBdg: Var option) (someBody: Expr) + (noneBody: Expr): Expr = + MatchExpr (optionMutMatch scrut someBdg someBody noneBody) + +let eitherGenMatch (leftId: Identifier) (rightId: Identifier) + (scrut: Expr) + (leftBdg: Var option) (leftBody: Expr) + (rightBdg: Var option) (rightBody: Expr): MatchExpr = + { + scrut = scrut + cases = [ + { + pattern = ADTPattern {binder = None; id = leftId; subPatterns = [Wildcard leftBdg]} + rhs = leftBody + } + { + pattern = ADTPattern {binder = None; id = rightId; subPatterns = [Wildcard rightBdg]} + rhs = rightBody + } + ] + } + +let eitherMatch (scrut: Expr) + (leftBdg: Var option) (leftBody: Expr) + (rightBdg: Var option) (rightBody: Expr): MatchExpr = + eitherGenMatch leftId rightId scrut leftBdg leftBody rightBdg rightBody +let eitherMatchExpr (scrut: Expr) + (leftBdg: Var option) (leftBody: Expr) + (rightBdg: Var option) (rightBody: Expr): Expr = + MatchExpr (eitherMatch scrut leftBdg leftBody rightBdg rightBody) + +let eitherMutMatch (scrut: Expr) + (leftBdg: Var option) (leftBody: Expr) + (rightBdg: Var option) (rightBody: Expr): MatchExpr = + eitherGenMatch leftMutId rightMutId scrut leftBdg leftBody rightBdg rightBody +let eitherMutMatchExpr (scrut: Expr) + (leftBdg: Var option) (leftBody: Expr) + (rightBdg: Var option) (rightBody: Expr): Expr = + MatchExpr (eitherMutMatch scrut leftBdg leftBody rightBdg rightBody) + + + +let ubytelit (l: bigint): Expr = IntLit (UByte, l) + +let int32lit (l: bigint): Expr = IntLit (Int, l) + +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) + + let rec flattenAdd (e: Expr): Expr list = + match e with + | Plus terms -> terms |> List.collect flattenAdd + | _ -> [e] + + let terms = terms |> List.collect flattenAdd + let litTpe = terms |> List.tryFindMap (fun e -> + match e with + | IntLit (tpe, _) -> Some tpe + | _ -> None + ) + let cst, newTerms = + terms |> List.fold (fun (acc, newTerms) e -> + match e with + | IntLit (tpe, lit) -> + assert (Some tpe = litTpe) + let sz, unsigned = + match tpe with + | Byte -> 8, false + | Short -> 16, false + | Int -> 32, false + | Long -> 64, false + | UByte -> 8, true + | UShort -> 16, true + | UInt -> 32, true + | ULong -> 64, true + let min, max = + if unsigned then 0I, 2I ** sz + else -2I ** (sz - 1), 2I ** (sz - 1) - 1I + let nbits = max - min + 1I + let sum = acc + lit + let newAcc = + if unsigned then sum % nbits + else if min <= sum && sum <= max then sum + else if max < sum then -nbits + sum + else nbits + sum + newAcc, newTerms + | _ -> + acc, e :: newTerms + ) (0I, []) + let newTerms = List.rev newTerms + if cst = 0I then + if newTerms.IsEmpty then IntLit (litTpe.Value, 0I) + else Plus newTerms + else Plus (newTerms @ [IntLit (litTpe.Value, cst)]) + +let letTuple (bdgs: Var list) (e: Expr) (body: Expr): Expr = + assert (not bdgs.IsEmpty) + if bdgs.Length = 1 then Let {bdg = bdgs.Head; e = e; body = body} + else LetTuple {bdgs = bdgs; e = e; body = body} + +let letsIn (bdgs: (Var * Expr) list) (body: Expr): Expr = + List.foldBack (fun (v, e) body -> Let {bdg = v; e = e; body = body}) bdgs body + +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 selBitStream (recv: Expr): Expr = FieldSelect (selBase recv, "bitStream") + let selBuf (recv: Expr): Expr = FieldSelect (selBase recv, "buf") + let selBufLength (recv: Expr): Expr = ArrayLength (selBuf recv) -let selCurrentByte (recv: Expr): Expr = FieldSelect (selBitStream recv, "currentByte") -let selCurrentBit (recv: Expr): Expr = FieldSelect (selBitStream recv, "currentBit") -let callBitIndex (recv: Expr): Expr = BitStreamMethodCall { method = BitIndex; recv = selBitStream recv; args = [] } -let callInvariant (recv: Expr): Expr = BitStreamFunctionCall { fn = Invariant; args = [selCurrentBit recv; selCurrentByte recv; selBufLength recv] } -let callValidateOffsetBits (recv: Expr) (offset: Expr): Expr = BitStreamMethodCall { method = ValidateOffsetBits; recv = selBitStream recv; args = [offset] } +let selCurrentByteACN (recv: Expr): Expr = FieldSelect (selBitStream recv, "currentByte") -////////////////////////////////////////////////////////// +let selCurrentBitACN (recv: Expr): Expr = FieldSelect (selBitStream recv, "currentBit") -let runtimeCodecTypeFor (enc: Asn1Encoding): CodecClass = - match enc with - | UPER -> UperCodec - | ACN -> AcnCodec - | _ -> failwith $"Unsupported: {enc}" -let lemmaOwner (lemma: Lemma): RuntimeType option = - match lemma with - | ValidateOffsetBitsIneqLemma - | ValidateOffsetBitsWeakeningLemma - | ValidTransitiveLemma - | ValidReflexiveLemma -> Some BitStream - - | ArrayBitRangesEqReflexiveLemma - | ArrayBitRangesEqSlicedLemma -> None - - | ReadPrefixLemma t -> - match t with - | Some (AcnIntegerEncodingType int) -> Some (CodecClass AcnCodec) - | Some (Asn1IntegerEncodingType _) -> Some (CodecClass BaseCodec) - | Some (AcnBooleanEncodingType None) -> Some BitStream // TODO: Check this - | None -> failwith "TODO: Implement me" - | _ -> - None // TODO: Rest - -let lemmaStr (lemma: Lemma): string = - let name = - match lemma with - | ValidTransitiveLemma -> "validTransitiveLemma" - | ValidReflexiveLemma -> "validReflexiveLemma" - | ValidateOffsetBitsIneqLemma -> "validateOffsetBitsIneqLemma" - | ValidateOffsetBitsWeakeningLemma -> "validateOffsetBitsWeakeningLemma" - | ArrayBitRangesEqReflexiveLemma -> "arrayBitRangesEqReflexiveLemma" - | ArrayBitRangesEqSlicedLemma -> "arrayBitRangesEqSlicedLemma" - | ReadPrefixLemma t -> - match t with - | None -> failwith "TODO: Implement me" - | Some (AcnBooleanEncodingType None) -> "readBitPrefixLemma" // TODO: Check this - | Some (AcnIntegerEncodingType int) -> - let sign = - match int.signedness with - | Positive -> "PositiveInteger" - | TwosComplement -> "TwosComplement" - let endian, sz = - match int.endianness with - | IntegerEndianness.Byte -> None, Some "8" - | Unbounded -> None, None - | LittleEndian sz -> Some "little_endian", Some (sz.bitSize.ToString()) - | BigEndian sz -> Some "big_endian", Some (sz.bitSize.ToString()) - ([Some "dec"; Some "Int"; Some sign; Some "ConstSize"; endian; sz; Some "prefixLemma"] |> List.choose id).StrJoin "_" - | Some (Asn1IntegerEncodingType (Some Unconstrained)) -> - "decodeUnconstrainedWholeNumber_prefixLemma" - | Some (Asn1IntegerEncodingType (Some (FullyConstrainedPositive _))) -> - "decodeConstrainedPosWholeNumber_prefixLemma" - | _ -> - "ACN.readPrefixLemma_TODO" // TODO - let owner = lemmaOwner lemma - ((owner |> Option.map (fun o -> o.companionObjectName) |> Option.toList) @ [name]).StrJoin "." +let bitIndexACN (recv: Expr): Expr = MethodCall { id = "bitIndex"; recv = selBitStream recv; args = [] } + +let resetAtACN (recv: Expr) (arg: Expr): Expr = MethodCall { id = "resetAt"; recv = recv; args = [arg] } + +let invariant (recv: Expr): Expr = FunctionCall { prefix = [bitStreamId]; id = "invariant"; tps = []; args = [selCurrentBitACN recv; selCurrentByteACN recv; selBufLength recv] } + +let getBitCountUnsigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetBitCountUnsigned"; tps = []; args = [arg] } + +let validateOffsetBitsACN (recv: Expr) (offset: Expr): Expr = MethodCall { id = "validate_offset_bits"; recv = selBitStream recv; args = [offset] } + +let isPrefixOfACN (recv: Expr) (other: Expr): Expr = MethodCall { id = "isPrefixOf"; recv = selBitStream recv; args = [selBitStream other] } + +let callSize (recv: Expr) (offset: Expr): Expr = MethodCall { id = "size"; recv = recv; args = [offset] } + +// let sizeRange (recv: Expr) (offset: Expr) (from: Expr) (tto: Expr): Expr = MethodCall { id = "sizeRange"; recv = recv; args = [offset; from; tto] } + +let getLengthForEncodingSigned (arg: Expr): Expr = FunctionCall { prefix = []; id = "GetLengthForEncodingSigned"; tps = []; args = [arg] } + +let stringLength (recv: Expr): Expr = FieldSelect (recv, "nCount") + +let indexOfOrLength (recv: Expr) (elem: Expr): Expr = MethodCall {recv = recv; id = "indexOfOrLength"; args = [elem]} + +let stringCapacity (recv: Expr): Expr = ArrayLength (FieldSelect (recv, "arr")) + +let alignedToByte (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToByte"; tps = []; args = [bits]} + +let alignedToWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToWord"; tps = []; args = [bits]} + +let alignedToDWord (bits: Expr): Expr = FunctionCall {prefix = []; id = "alignedToDWord"; tps = []; args = [bits]} + + + +let alignedTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr): Expr = + match alignment with + | None -> bits + | Some AcnGenericTypes.NextByte -> alignedToByte bits + | Some AcnGenericTypes.NextWord -> alignedToWord bits + | Some AcnGenericTypes.NextDWord -> alignedToDWord bits -let bsMethodCallStr (meth: BitStreamMethod): string = - match meth with - | ResetAt -> "resetAt" - | BitIndex -> "bitIndex" - | ValidateOffsetBits -> "validate_offset_bits" +let alignedSizeToByte (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToByte"; tps = []; args = [bits; offset]} -let rtFnCall (fn: RTFunction): string = - match fn with - | GetBitCountUnsigned -> "GetBitCountUnsigned" +let alignedSizeToWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToWord"; tps = []; args = [bits; offset]} -let bsFnCall (fn: BitStreamFunction): string = - match fn with - | Invariant -> "BitStream.invariant" +let alignedSizeToDWord (bits: Expr) (offset: Expr): Expr = FunctionCall {prefix = []; id = "alignedSizeToDWord"; tps = []; args = [bits; offset]} + +let alignedSizeTo (alignment: AcnGenericTypes.AcnAlignment option) (bits: Expr) (offset: Expr): Expr = + match alignment with + | None -> bits + | Some AcnGenericTypes.NextByte -> alignedSizeToByte bits offset + | 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 validTransitiveLemma (b1: Expr) (b2: Expr) (b3: Expr): Expr = + FunctionCall { prefix = [bitStreamId]; id = "validTransitiveLemma"; tps = []; args = [selBitStream b1; selBitStream b2; selBitStream b3] } + +let validateOffsetBitsIneqLemma (b1: Expr) (b2: Expr) (b1ValidateOffsetBits: Expr) (advancedAtMostBits: Expr): Expr = + FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsIneqLemma"; tps = []; args = [b1; b2; b1ValidateOffsetBits; advancedAtMostBits] } + +let validateOffsetBitsWeakeningLemma (b: Expr) (origOffset: Expr) (newOffset: Expr): Expr = + FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsWeakeningLemma"; tps = []; args = [b; origOffset; newOffset] } + +let validateOffsetBitsContentIrrelevancyLemma (b1: Expr) (buf: Expr) (bits: Expr): Expr = + FunctionCall { prefix = [bitStreamId]; id = "validateOffsetBitsContentIrrelevancyLemma"; tps = []; args = [b1; buf; bits] } + +let arrayRangesEqReflexiveLemma (arr: Expr): Expr = + FunctionCall { prefix = []; id = "arrayRangesEqReflexiveLemma"; tps = []; args = [arr] } + +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] } + +let arrayUpdatedAtPrefixLemma (arr: Expr) (at: Expr) (v: Expr): Expr = + FunctionCall { prefix = []; id = "arrayUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v] } + +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] } + +let arrayRangesEqImpliesEq (a1: Expr) (a2: Expr) (from: Expr) (at: Expr) (tto: Expr): Expr = + FunctionCall { prefix = []; id = "arrayRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto] } + +let arrayRangesEq (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr): Expr = + FunctionCall { prefix = []; id = "arrayRangesEq"; tps = []; args = [a1; a2; from; tto] } + +let arrayBitRangesEq (a1: Expr) (a2: Expr) (fromBit: Expr) (toBit: Expr): Expr = + FunctionCall { prefix = []; id = "arrayBitRangesEq"; tps = []; args = [a1; a2; fromBit; toBit] } + +let listRangesEqReflexiveLemma (arr: Expr): Expr = + FunctionCall { prefix = []; id = "listRangesEqReflexiveLemma"; tps = []; args = [arr] } + +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] } + +let listUpdatedAtPrefixLemma (arr: Expr) (at: Expr) (v: Expr): Expr = + FunctionCall { prefix = []; id = "listUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v] } + +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] } + +let listRangesEqImpliesEq (a1: Expr) (a2: Expr) (from: Expr) (at: Expr) (tto: Expr): Expr = + FunctionCall { prefix = []; id = "listRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto] } + +let listRangesEq (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr): Expr = + FunctionCall { prefix = []; id = "listRangesEq"; tps = []; args = [a1; a2; from; tto] } + +let listRangesAppendDropEq (a1: Expr) (a2: Expr) (v: Expr) (from: Expr) (tto: Expr): Expr = + FunctionCall { prefix = []; id = "listRangesAppendDropEq"; tps = []; args = [a1; a2; v; from; tto] } + +let isnocIndex (ls: Expr) (v: Expr) (i: Expr): Expr = + FunctionCall { prefix = ["ListSpecs"]; id = "isnocIndex"; tps = []; args = [ls; v; i] } + + +let listApplyEqVecApply (vec: Expr) (i: Expr): Expr = + FunctionCall { prefix = ["Vector"]; id = "listApplyEqVecApply"; tps = []; args = [vec; i] } + +let vecRangesEqReflexiveLemma (arr: Expr): Expr = + FunctionCall { prefix = []; id = "vecRangesEqReflexiveLemma"; tps = []; args = [arr] } + +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] } + +let vecUpdatedAtPrefixLemma (arr: Expr) (at: Expr) (v: Expr): Expr = + FunctionCall { prefix = []; id = "vecUpdatedAtPrefixLemma"; tps = []; args = [arr; at; v] } + +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] } + +let vecRangesEqImpliesEq (a1: Expr) (a2: Expr) (from: Expr) (at: Expr) (tto: Expr): Expr = + FunctionCall { prefix = []; id = "vecRangesEqImpliesEq"; tps = []; args = [a1; a2; from; at; tto] } + +let vecRangesEq (a1: Expr) (a2: Expr) (from: Expr) (tto: Expr): Expr = + FunctionCall { prefix = []; id = "vecRangesEq"; tps = []; args = [a1; a2; from; tto] } + +let vecRangesAppendDropEq (a1: Expr) (a2: Expr) (v: Expr) (from: Expr) (tto: Expr): Expr = + FunctionCall { prefix = []; id = "vecRangesAppendDropEq"; tps = []; args = [a1; a2; v; from; tto] } + + +let fromIntClass (cls: Asn1AcnAst.IntegerClass): IntegerType = + match cls with + | Asn1AcnAst.ASN1SCC_Int8 _ -> Byte + | Asn1AcnAst.ASN1SCC_Int16 _ -> Short + | Asn1AcnAst.ASN1SCC_Int32 _ -> Int + | Asn1AcnAst.ASN1SCC_Int64 _ | Asn1AcnAst.ASN1SCC_Int _ -> Long + | Asn1AcnAst.ASN1SCC_UInt8 _ -> UByte + | Asn1AcnAst.ASN1SCC_UInt16 _ -> UShort + | Asn1AcnAst.ASN1SCC_UInt32 _ -> UInt + | Asn1AcnAst.ASN1SCC_UInt64 _ | Asn1AcnAst.ASN1SCC_UInt _ -> ULong + +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.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.Real _ -> DoubleType + | t -> failwith $"TODO {t}" + +let fromAcnInsertedType (t: Asn1AcnAst.AcnInsertedType): Type = + match t with + | 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)) + +let fromAsn1AcnTypeKind (t: Asn1AcnAst.Asn1AcnTypeKind): Type = + match t with + | Asn1AcnAst.Asn1AcnTypeKind.Acn t -> fromAcnInsertedType t + | Asn1AcnAst.Asn1AcnTypeKind.Asn1 t -> fromAsn1TypeKind t + +let fromAsn1AcnChildInfo (t: Asn1AcnAst.SeqChildInfo): Type = + match t with + | Asn1AcnAst.SeqChildInfo.AcnChild t -> fromAcnInsertedType t.Type + | Asn1AcnAst.SeqChildInfo.Asn1Child t -> fromAsn1TypeKind t.Type.Kind + +let fromSequenceOfLike (t: SequenceOfLike): Type = + match t with + | SqOf t -> fromAsn1TypeKind (Asn1AcnAst.SequenceOf t) + | StrType t -> fromAsn1TypeKind (Asn1AcnAst.IA5String t) + +let fromSequenceOfLikeElemTpe (t: SequenceOfLike): Type = + match t with + | SqOf t -> fromAsn1TypeKind t.child.Kind + | StrType t -> IntegerType UByte + +let runtimeCodecTypeFor (enc: Asn1Encoding): ClassType = + match enc with + | UPER -> uperClsTpe + | ACN -> acnClsTpe + | _ -> failwith $"Unsupported: {enc}" ////////////////////////////////////////////////////////// type PrintCtx = { - curr: Expr - parents: Expr list + curr: Tree + parents: Tree list lvl: int } with member this.inc: PrintCtx = {this with lvl = this.lvl + 1} member this.parent = List.tryHead this.parents - member this.nest (e: Expr): PrintCtx = {this with curr = e; parents = this.curr :: this.parents} + member this.nest (t: Tree): PrintCtx = {this with curr = t; parents = this.curr :: this.parents} + + member this.nestExpr (e: Expr): PrintCtx = this.nest (ExprTree e) type Line = { txt: string @@ -251,32 +760,40 @@ type Line = { } with member this.inc: Line = {this with lvl = this.lvl + 1} -let isSimpleExpr (e: Expr): bool = +let isSimpleExpr (e: Tree): bool = match e with - | Let _ | LetGhost _ | Block _ | Assert _ -> false + | ExprTree (Let _ | LetGhost _ | LetTuple _ | Block _ | Assert _ | LetRec _) -> false | _ -> true // TODO: Match case? -let noBracesSub (e: Expr): Expr list = +let noBracesSub (e: Tree): Tree list = match e with - | Let l -> [l.body] - | LetGhost l -> [l.body] - | Ghost e -> [e] - | Locally e -> [e] + | ExprTree (Let l) -> [ExprTree l.body] + | ExprTree (LetGhost l) -> [ExprTree l.body] + | ExprTree (LetTuple l) -> [ExprTree l.body] + | ExprTree (Ghost e) -> [ExprTree e] + | ExprTree (Locally e) -> [ExprTree e] + | ExprTree (IfExpr ite) -> [ExprTree ite.els; ExprTree ite.thn] + | ExprTree (LetRec lr) -> [ExprTree lr.body] + // TODO: match case and not matchexpr... + | ExprTree (MatchExpr m) -> m.cases |> List.map (fun c -> ExprTree c.rhs) | _ -> [] -let requiresBraces (e: Expr) (within: Expr option): bool = - match within with - | _ when isSimpleExpr e -> false - | Some(Ghost _ | Locally _) -> false - | Some(within) when List.contains e (noBracesSub within) -> false - | Some(_) -> +let requiresBraces (e: Tree) (within: Tree option): bool = + match e, within with + | _, _ when isSimpleExpr e -> false + | _, Some (ExprTree (Ghost _ | Locally _)) -> false + | _, Some within when List.contains e (noBracesSub within) -> false + | ExprTree (LetRec _), Some (ExprTree (LetRec _)) -> false + | ExprTree (Block _), Some (ExprTree (Or _ | Not _ | And _)) -> true + | _, Some _ -> // TODO false - | _ -> false + | _, _ -> false let precedence (e: Expr): int = match e with + | Mod _ -> 0 | Or _ -> 1 | And _ | SplitAnd _ -> 3 | Leq _ -> 4 @@ -285,12 +802,14 @@ let precedence (e: Expr): int = | Mult _ -> 8 | _ -> 9 -let requiresParentheses (curr: Expr) (parent: Expr option): bool = +let requiresParentheses (curr: Tree) (parent: Tree option): bool = match curr, parent with - | (_, None) -> false - | (_, Some (Let _ | BitStreamFunctionCall _ | RTFunctionCall _ | Assert _ | Check _ | MatchExpr _)) -> false - | (_, Some (BitStreamMethodCall call)) -> not (List.contains curr call.args) - | (e1, Some (e2)) when precedence e1 > precedence e2 -> false + | _, None -> false + | _, Some (ExprTree (Let _ | LetGhost _ | LetTuple _ | FunctionCall _ | Assert _ | Check _ | IfExpr _ | MatchExpr _)) -> false + | _, Some (ExprTree (MethodCall call)) -> not (List.contains curr (call.args |> List.map ExprTree)) + | ExprTree (IfExpr _ | MatchExpr _), _ -> true + | ExprTree e1, Some (ExprTree e2) when precedence e1 > precedence e2 -> false + | _, Some (ExprTree (LetRec _)) -> false | _ -> true let joined (ctx: PrintCtx) (lines: Line list) (sep: string): Line = @@ -327,12 +846,38 @@ let rec joinN (ctx: PrintCtx) (sep: string) (liness: Line list list): Line list let rest = joinN ctx sep rest join ctx sep fst rest +let rec ppType (tpe: Type): string = + match tpe with + | IntegerType int -> int.ToString() + | BooleanType -> "Boolean" + | UnitType -> "Unit" + | DoubleType -> "Double" + | ArrayType at -> $"Array[{ppType at.tpe}]" + | ClassType ct -> ppClassType ct + | TupleType tps -> "(" + ((tps |> List.map ppType).StrJoin ", ") + ")" + +and ppClassType (ct: ClassType): string = + let tps = + if ct.tps.IsEmpty then "" + else "[" + ((ct.tps |> List.map ppType).StrJoin ", ") + "]" + ct.id + tps + +let ppAnnot (annot: Annot): string = + match annot with + | Opaque -> "@opaque" + | InlineOnce -> "@inlineOnce" + | GhostAnnot -> "@ghost" + | Pure -> "@pure" + // TODO: Maybe have ctx.nest here already? -let rec pp (ctx: PrintCtx) (e: Expr): Line list = - if requiresBraces e ctx.parent && ctx.parent <> Some e then - [{txt = "{"; lvl = ctx.lvl}] @ ppBody ctx.inc e @ [{txt = "}"; lvl = ctx.lvl}] - else ppBody ctx e +let rec pp (ctx: PrintCtx) (t: Tree): Line list = + if requiresBraces t ctx.parent && ctx.parent <> Some t then + [{txt = "{"; lvl = ctx.lvl}] @ ppBody ctx.inc t @ [{txt = "}"; lvl = ctx.lvl}] + else ppBody ctx t +and ppExpr (ctx: PrintCtx) (e: Expr): Line list = pp ctx (ExprTree e) + +// `prefix`(arg1, arg2, ..., argn) and joinCallLike (ctx: PrintCtx) (prefix: Line list) (argss: Line list list) (parameterless: bool): Line list = assert (not prefix.IsEmpty) if argss.IsEmpty && parameterless then @@ -349,12 +894,25 @@ and joinCallLike (ctx: PrintCtx) (prefix: Line list) (argss: Line list list) (pa else join ctx "(" prefix [{lvl = ctx.lvl; txt = ((List.concat argss) |> List.map (fun l -> l.txt)).StrJoin ", " + ")"}] -and ppLet (ctx: PrintCtx) (theLet: Expr) (lt: Let) (annot: string list): Line list = - let e2 = pp (ctx.nest theLet) lt.e - let body = pp (ctx.nest theLet) lt.body +// `prefix` { +// stmts +// } +and joinBraces (ctx: PrintCtx) (prefix: string) (stmts: Line list): Line list = + [{lvl = ctx.lvl; txt = $"{prefix} {{"}] @ + (stmts |> List.map (fun l -> l.inc)) @ + [{lvl = ctx.lvl; txt = $"}}"}] + +and ppLetGeneric (ctx: PrintCtx) (theLet: Expr) (ltBdgs: Var list) (ltE: Expr) (ltBody: Expr) (annot: string list): Line list = + let e2 = ppExpr (ctx.nestExpr theLet) ltE + let body = ppExpr (ctx.nestExpr theLet) ltBody let annot = if annot.IsEmpty then "" else (annot.StrJoin " ") + " " - let prepended = (prepend ctx $"{annot}val {lt.bdg.name} = " e2) + let bdgs = + if ltBdgs.Length = 1 then ltBdgs.Head.name + else "(" + ((ltBdgs |> List.map (fun v -> v.name)).StrJoin ", ") + ")" + let prepended = (prepend ctx $"{annot}val {bdgs} = " e2) prepended @ body +and ppLet (ctx: PrintCtx) (theLet: Expr) (lt: Let) (annot: string list): Line list = + ppLetGeneric ctx theLet [lt.bdg] lt.e lt.body annot and ppMatchExpr (ctx: PrintCtx) (mexpr: MatchExpr): Line list = let rec ppPattern (pat: Pattern): string = @@ -365,87 +923,187 @@ and ppMatchExpr (ctx: PrintCtx) (mexpr: MatchExpr): Line list = let bdg = pat.binder |> Option.map (fun bdg -> $"${bdg.name} @ ") |> Option.defaultValue "" let subpats = (pat.subPatterns |> List.map ppPattern).StrJoin ", " $"{bdg}{pat.id}({subpats})" + | TuplePattern pat -> + let bdg = pat.binder |> Option.map (fun bdg -> $"${bdg.name} @ ") |> Option.defaultValue "" + let subpats = (pat.subPatterns |> List.map ppPattern).StrJoin ", " + $"{bdg}({subpats})" let ppMatchCase (ctx: PrintCtx) (cse: MatchCase): Line list = let pat = {txt = $"case {ppPattern cse.pattern} =>"; lvl = ctx.lvl} - pat :: pp (ctx.inc) cse.rhs + pat :: ppExpr (ctx.inc.nestExpr cse.rhs) cse.rhs - let ctxNested = ctx.nest (MatchExpr mexpr) + let ctxNested = ctx.nestExpr (MatchExpr mexpr) let cases = mexpr.cases |> List.collect (ppMatchCase ctxNested.inc) - let scrut = pp ctxNested mexpr.scrut + let scrut = ppExpr ctxNested mexpr.scrut (append ctx " match {" scrut) @ cases @ [{txt = "}"; lvl = ctx.lvl}] +and ppIfExpr (ctx: PrintCtx) (ifexpr: IfExpr): Line list = + let ctxNested = ctx.nestExpr (IfExpr ifexpr) + let cond = ppExpr (ctxNested.nestExpr ifexpr.cond) ifexpr.cond + let thn = ppExpr (ctxNested.inc.nestExpr ifexpr.thn) ifexpr.thn + let els = ppExpr (ctxNested.inc.nestExpr ifexpr.els) ifexpr.els + (append ctx ") {" (prepend ctx "if (" cond)) @ thn @ [{txt = "} else {"; lvl = ctx.lvl}] @ els @ [{txt = "}"; lvl = ctx.lvl}] + +and ppFunDefLike (ctx: PrintCtx) (fd: FunDefLike): Line list = + // TODO: What about "nestExpr" ??? + let prms = + if fd.prms.IsEmpty then "" + else + let prms = (fd.prms |> List.map (fun v -> $"{v.name}: {ppType v.tpe}")).StrJoin ", " + $"({prms})" + let annots = + if fd.annots.IsEmpty then [] + else [{txt = (fd.annots |> List.map ppAnnot).StrJoin " "; lvl = ctx.lvl}] + let header = annots @ [{txt = $"def {fd.id}{prms}: {ppType fd.returnTpe} = {{"; lvl = ctx.lvl}] + let preSpecs = fd.specs |> List.collect (fun s -> + match s with + | Precond (Block stmts) -> + joinBraces ctx.inc "require" (stmts |> List.collect (fun s -> ppExpr ctx.inc s)) + | Precond e -> + joinCallLike ctx.inc [{txt = "require"; lvl = ctx.lvl + 1}] [ppExpr ctx.inc e] false + | Measure (Block stmts) -> + joinBraces ctx.inc "decreases" (stmts |> List.collect (fun s -> ppExpr ctx.inc s)) + | Measure e -> + joinCallLike ctx.inc [{txt = "decreases"; lvl = ctx.lvl + 1}] [ppExpr ctx.inc e] false + | LetSpec (v, e) -> (prepend ctx.inc $"val {v.name} = " (ppExpr ctx.inc e)) + ) + let hasBdgInSpec = fd.specs |> List.exists (fun s -> match s with LetSpec _ -> true | _ -> false) + + match fd.postcond, hasBdgInSpec with + | Some (resVar, postcond), true -> + let body = ppExpr ctx.inc.inc fd.body + let postcond = ppExpr ctx.inc.inc postcond + header @ + preSpecs @ + [{txt = ""; lvl = ctx.lvl}] @ // for Scala to avoid defining an anonymous class with bindings from above + [{txt = "{"; lvl = ctx.lvl + 1}] @ + body @ + // We type-annotate the result to avoid inference failure which may occur from time to time + [{txt = $"}}.ensuring {{ ({resVar.name}: {ppType resVar.tpe}) => "; lvl = ctx.lvl + 1}] @ + postcond @ + [{txt = "}"; lvl = ctx.lvl + 1}; {txt = "}"; lvl = ctx.lvl}] + | Some (resVar, postcond), false -> + let body = ppExpr ctx.inc fd.body + let postcond = ppExpr ctx.inc postcond + header @ + preSpecs @ + body @ + [{txt = $"}}.ensuring {{ ({resVar.name}: {ppType resVar.tpe}) => "; lvl = ctx.lvl}] @ + postcond @ + [{txt = "}"; lvl = ctx.lvl}] + | None, _ -> + let body = ppExpr ctx.inc fd.body + header @ preSpecs @ body @ [{txt = "}"; lvl = ctx.lvl}] + and optP (ctx: PrintCtx) (ls: Line list): Line list = if requiresParentheses ctx.curr ctx.parent then prepend ctx "(" (append ctx ")" ls) else ls -and ppBody (ctx: PrintCtx) (e: Expr): Line list = +and ppBody (ctx: PrintCtx) (t: Tree): Line list = + match t with + | ExprTree e -> ppExprBody ctx e + | FunDefTree fd -> ppFunDefLike ctx fd + | LocalFunDefTree fd -> ppFunDefLike ctx fd + +and ppExprBody (ctx: PrintCtx) (e: Expr): Line list = let line (str: string): Line = {txt = str; lvl = ctx.lvl} match e with | Var v -> [line v.name] | Block exprs -> - List.collect (fun e2 -> pp (ctx.nest e2) e2) exprs + List.collect (fun e2 -> ppExpr (ctx.nestExpr e2) e2) exprs | Ghost e2 -> - [line "ghostExpr {"] @ (pp (ctx.inc.nest e2) e2) @ [line "}"] + [line "ghostExpr {"] @ (ppExpr (ctx.inc.nestExpr e2) e2) @ [line "}"] | Locally e2 -> - [line "locally {"] @ (pp (ctx.inc.nest e2) e2) @ [line "}"] - - | AppliedLemma app -> - let args = app.args |> List.map (fun a -> pp (ctx.nest a) a) - joinCallLike ctx [line (lemmaStr app.lemma)] args true + [line "locally {"] @ (ppExpr (ctx.inc.nestExpr e2) e2) @ [line "}"] | Snapshot e2 -> - joinCallLike ctx [line "snapshot"] [pp (ctx.nest e2) e2] false + joinCallLike ctx [line "snapshot"] [ppExpr (ctx.nestExpr e2) e2] false + + | FreshCopy e2 -> + joinCallLike ctx [line "freshCopy"] [ppExpr (ctx.nestExpr e2) e2] false + + | Unfold e2 -> + joinCallLike ctx [line "unfold"] [ppExpr (ctx.nestExpr e2) e2] false | Let lt -> ppLet ctx e lt [] | LetGhost lt -> ppLet ctx e lt ["@ghost"] + | LetTuple lt -> ppLetGeneric ctx e lt.bdgs lt.e lt.body [] + | Assert pred -> - let pred = pp (ctx.nest pred) pred + let pred = ppExpr (ctx.nestExpr pred) pred joinCallLike ctx [line "assert"] [pred] false | Check pred -> - let pred = pp (ctx.nest pred) pred + let pred = ppExpr (ctx.nestExpr pred) pred joinCallLike ctx [line "check"] [pred] false - | BitStreamMethodCall call -> - let recv = pp (ctx.nest call.recv) call.recv - let meth = bsMethodCallStr call.method - let args = call.args |> List.map (fun a -> pp (ctx.nest a) a) - joinCallLike ctx (append ctx $".{meth}" recv) args true + | 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 - | BitStreamFunctionCall call -> - let meth = bsFnCall call.fn - let args = call.args |> List.map (fun a -> pp (ctx.nest a) a) - joinCallLike ctx [line meth] args true + | 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 - | RTFunctionCall call -> - let meth = rtFnCall call.fn - let args = call.args |> List.map (fun a -> pp (ctx.nest a) a) - joinCallLike ctx [line meth] args true + | LetRec lr -> + let fds = lr.fds |> List.collect (fun fd -> ppFunDefLike (ctx.nest (LocalFunDefTree fd)) fd) + let body = ppExpr (ctx.nestExpr lr.body) lr.body + fds @ body + + | ApplyLetRec call -> + let args = call.args |> List.map (fun a -> ppExpr (ctx.nestExpr a) a) + joinCallLike ctx [line call.id] args true + + | Tuple args -> + let args = args |> List.map (fun a -> ppExpr (ctx.nestExpr a) a) + joinCallLike ctx [line ""] args false | TupleSelect (recv, ix) -> - let recv = pp (ctx.nest recv) recv + let recv = ppExpr (ctx.nestExpr recv) recv append ctx $"._{ix}" recv | FieldSelect (recv, sel) -> - let recv = pp (ctx.nest recv) recv + let recv = ppExpr (ctx.nestExpr recv) recv append ctx $".{sel}" recv | ArraySelect (arr, ix) -> - let recv = pp (ctx.nest arr) arr - let ix = pp (ctx.nest ix) ix + let recv = ppExpr (ctx.nestExpr arr) arr + let ix = ppExpr (ctx.nestExpr ix) ix joinCallLike ctx recv [ix] false + | ArrayUpdate (arr, ix, newVal) -> + let recv = ppExpr (ctx.nestExpr arr) arr + let ix = ppExpr (ctx.nestExpr ix) ix + let newVal = ppExpr (ctx.nestExpr newVal) newVal + let sel = joinCallLike ctx recv [ix] false + join ctx " = " sel newVal + + | 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 + + | Old e2 -> + let e2 = ppExpr (ctx.nestExpr e2) e2 + joinCallLike ctx [line "old"] [e2] false + | ArrayLength arr -> - let arr = pp (ctx.nest arr) arr + let arr = ppExpr (ctx.nestExpr arr) arr append ctx $".length" arr + | Return ret -> + let ret = ppExpr (ctx.nestExpr ret) ret + prepend ctx $"return " ret + | IntLit (tpe, i) -> let i = i.ToString() let str = @@ -460,53 +1118,69 @@ and ppBody (ctx: PrintCtx) (e: Expr): Line list = | ULong -> $"ULong.fromRaw({i}L)" [line str] + | BoolLit b -> [line (if b then "true" else "false")] + + | UnitLit -> [line "()"] + // TODO: optP nestExpr? | Equals (lhs, rhs) -> - let lhs = pp (ctx.nest lhs) lhs - let rhs = pp (ctx.nest rhs) rhs + let lhs = ppExpr (ctx.nestExpr lhs) lhs + let rhs = ppExpr (ctx.nestExpr rhs) rhs optP ctx (join ctx " == " lhs rhs) | Leq (lhs, rhs) -> - let lhs = pp (ctx.nest lhs) lhs - let rhs = pp (ctx.nest rhs) rhs + let lhs = ppExpr (ctx.nestExpr lhs) lhs + let rhs = ppExpr (ctx.nestExpr rhs) rhs optP ctx (join ctx " <= " lhs rhs) | And conjs -> - let conjs = conjs |> List.map (fun c -> pp (ctx.nest c) c) + let conjs = conjs |> List.map (fun c -> ppExpr (ctx.nestExpr c) c) optP ctx (joinN ctx " && " conjs) | SplitAnd conjs -> - let conjs = conjs |> List.map (fun c -> pp (ctx.nest c) c) + let conjs = conjs |> List.map (fun c -> ppExpr (ctx.nestExpr c) c) optP ctx (joinN ctx " &&& " conjs) | Or disjs -> - let disjs = disjs |> List.map (fun d -> pp (ctx.nest d) d) + let disjs = disjs |> List.map (fun d -> ppExpr (ctx.nestExpr d) d) optP ctx (joinN ctx " || " disjs) | Not e2 -> - let e2 = pp (ctx.nest e2) e2 + let e2 = ppExpr (ctx.nestExpr e2) e2 optP ctx (prepend ctx "!" e2) - | Plus (lhs, rhs) -> - let lhs = pp (ctx.nest lhs) lhs - let rhs = pp (ctx.nest rhs) rhs - optP ctx (join ctx " + " lhs rhs) + | Plus terms -> + let terms = terms |> List.map (fun c -> ppExpr (ctx.nestExpr c) c) + optP ctx (joinN ctx " + " terms) | Minus (lhs, rhs) -> - let lhs = pp (ctx.nest lhs) lhs - let rhs = pp (ctx.nest rhs) rhs + let lhs = ppExpr (ctx.nestExpr lhs) lhs + let rhs = ppExpr (ctx.nestExpr rhs) rhs optP ctx (join ctx " - " lhs rhs) | Mult (lhs, rhs) -> - let lhs = pp (ctx.nest lhs) lhs - let rhs = pp (ctx.nest rhs) rhs + let lhs = ppExpr (ctx.nestExpr lhs) lhs + let rhs = ppExpr (ctx.nestExpr rhs) rhs optP ctx (join ctx " * " lhs rhs) - | MatchExpr mexpr -> ppMatchExpr ctx mexpr + | Mod (lhs, rhs) -> + let lhs = ppExpr (ctx.nestExpr lhs) lhs + let rhs = ppExpr (ctx.nestExpr rhs) rhs + optP ctx (join ctx " % " lhs rhs) + + | IfExpr ifexpr -> optP ctx (ppIfExpr ctx ifexpr) + + | MatchExpr mexpr -> optP ctx (ppMatchExpr ctx mexpr) | SelectionExpr sel -> [line sel] + | This -> [line "this"] + | EncDec stmt -> (stmt.Split [|'\n'|]) |> Array.toList |> List.map line -let show (e: Expr): string = - (pp {curr = e; parents = []; lvl = 0} e |> List.map (fun line -> (String.replicate line.lvl " ") + line.txt)).StrJoin "\n" + +let showLines (t: Tree): string list = + pp {curr = t; parents = []; lvl = 0} t |> List.map (fun line -> (String.replicate line.lvl " ") + line.txt) + +let show (t: Tree): string = + (showLines t).StrJoin "\n" diff --git a/StgScala/ProofGen.fs b/StgScala/ProofGen.fs index 6c975bc45..c4cb27e4e 100644 --- a/StgScala/ProofGen.fs +++ b/StgScala/ProofGen.fs @@ -6,54 +6,1083 @@ open CommonTypes open Language open Asn1AcnAst open Asn1AcnAstUtilFunctions +open AcnGenericTypes -let generateTransitiveLemmaApp (snapshots: Var list) (codec: Var): Expr = - assert (snapshots.Length >= 2) +type SizeProps = + | ExternalField + | BitsNullTerminated of string + | AsciiNullTerminated of byte list - let mkLemma (s1: Var) (s2: Var, s3: Var): Expr = - AppliedLemma {lemma = ValidTransitiveLemma; args = [selBitStream (Var s1); selBitStream (Var s2); selBitStream (Var s3)]} +let getAccess (acc: Accessor) = + match acc with + | 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 -> + match path with + | (MD _) :: (TA _) :: (PRM prmName) :: [] -> ToC prmName + | _ -> + let longName = id.AcnAbsPath.Tail |> Seq.StrJoin "_" + ToC (longName.Replace("#","elem")) - let helper (start: int): Expr list = - let s1 = snapshots.[start] - List.rep2 ((List.skip (start + 1) snapshots) @ [codec]) |> List.map (mkLemma s1) +let fromAcnSizeProps (sizeProps: AcnStringSizeProperty): SizeProps = + match sizeProps with + | StrExternalField _ -> ExternalField + | StrNullTerminated pat -> AsciiNullTerminated pat - [0 .. snapshots.Length - 2] |> List.collect helper |> mkBlock +let fromSizeableProps (sizeProps: AcnSizeableSizeProperty): SizeProps = + match sizeProps with + | SzExternalField _ -> ExternalField + | SzNullTerminated pat -> BitsNullTerminated pat.Value -let generateReadPrefixLemmaApp (snapshots: Var list) (children: TypeInfo list) (codec: Var) : Expr = - assert (children.Length = snapshots.Length) +let stringLikeSizeExpr (sizeProps: SizeProps option) (minNbElems: bigint) (maxNbElems: bigint) (charSize: bigint) (strLength: Expr): Expr = + // TODO: check if we need to consider the encoded size (determinant) or not + let vleSize, nbElemsInBits = + if minNbElems = maxNbElems then 0I, longlit (maxNbElems * charSize) + else 0I (*GetNumberOfBitsForNonNegativeInteger(maxNbElems - minNbElems)*), Mult (longlit charSize, strLength) + let patSize = + match sizeProps with + | Some ExternalField | None -> 0I + | Some (BitsNullTerminated pat) -> (bigint pat.Length) * 8I + | Some (AsciiNullTerminated pat) -> bigint pat.Length + plus [longlit (vleSize + patSize); nbElemsInBits] - let rec extraArgsForType (tpe: TypeEncodingKind option): Expr list = - match tpe with - | Some (OptionEncodingType tpe) -> extraArgsForType (Some tpe) - | Some (Asn1IntegerEncodingType (Some encodingTpe)) -> - match encodingTpe with - | FullyConstrainedPositive (min, max) -> [IntLit (ULong, min); IntLit (ULong, max)] - | FullyConstrained (min, max) -> [IntLit (Long, min); IntLit (Long, max)] - | SemiConstrainedPositive min -> [IntLit (ULong, min)] - | SemiConstrained max -> [IntLit (Long, max)] - | UnconstrainedMax max -> [IntLit (Long, max)] - | Unconstrained -> [] - | _ -> [] // TODO: Rest - - let mkLemma (bs1: Var, bs2: Var, tpe: TypeInfo): Expr = - let var = {Var.name = $"{bs2.name}_reset"; tpe = bs2.tpe} - let rst = BitStreamMethodCall {method = ResetAt; recv = Var bs2; args = [Var bs1]} - let tpeNoOpt = - match tpe.typeKind with - | Some (OptionEncodingType tpe) -> Some tpe - | _ -> tpe.typeKind - let varArg, codecArg = - match lemmaOwner (ReadPrefixLemma tpeNoOpt) with - | Some (CodecClass BaseCodec) -> selBase (Var var), selBase (Var codec) - | Some BitStream -> selBitStream (Var var), selBitStream (Var codec) - | _ -> Var var, Var codec - let extraArgs = extraArgsForType tpeNoOpt - let app = AppliedLemma {lemma = ReadPrefixLemma tpeNoOpt; args = [varArg; codecArg] @ extraArgs} - Let {bdg = var; e = rst; body = app} - - List.zip3 (List.skipLast 1 snapshots) snapshots.Tail (List.skipLast 1 children) |> List.map mkLemma |> Block - -let wrapEncDecStmts (enc: Asn1Encoding) (snapshots: Var list) (cdc: Var) (oldCdc: Var) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec) (rest: Expr): Expr = +let intSizeExpr (int: Asn1AcnAst.Integer) (obj: Expr): Expr = + match int.acnProperties.encodingProp, int.acnProperties.sizeProp, int.acnProperties.endiannessProp with + | None, None, None -> + match int.uperRange with + | Full -> + plus [longlit 8I; Mult (longlit 8I, getLengthForEncodingSigned obj)] + | NegInf _ | PosInf _ -> getBitCountUnsigned obj + | Concrete _ -> + assert (int.acnMinSizeInBits = int.acnMaxSizeInBits) + assert (int.uperMinSizeInBits = int.uperMinSizeInBits) + assert (int.acnMaxSizeInBits = int.uperMaxSizeInBits) + longlit int.acnMaxSizeInBits + | _ -> + assert (int.acnMinSizeInBits = int.acnMaxSizeInBits) // TODO: Not quite true, there is ASCII encoding that is variable... + longlit int.acnMaxSizeInBits + +// TODO: Expliquer ce que cela fait et diff avec les autre +let acnChildren (tpe: Asn1AcnAst.Asn1TypeKind): Asn1AcnAst.AcnChild list = + match tpe.ActualType with + | Sequence sq -> + sq.children |> List.collect (fun c -> + match c with + | AcnChild c -> [c] + | Asn1Child _ -> [] + ) + | _ -> [] + +let rec collectNestedAcnChildren (tpe: Asn1AcnAst.Asn1TypeKind): Asn1AcnAst.AcnChild list = + match tpe.ActualType with + | Sequence sq -> + sq.children |> List.collect (fun c -> + match c with + | AcnChild c -> [c] + | Asn1Child c -> collectNestedAcnChildren c.Type.Kind + ) + | _ -> [] + +let rec collectAllAcnChildren (tpe: Asn1AcnAst.Asn1TypeKind): Asn1AcnAst.AcnChild list = + match tpe.ActualType with + | Sequence sq -> + sq.children |> List.collect (fun c -> + match c with + | AcnChild c -> [c] + | Asn1Child c -> collectAllAcnChildren c.Type.Kind + ) + | Choice ch -> ch.children |> List.collect (fun c -> collectAllAcnChildren c.Type.Kind) + | SequenceOf sqf -> collectAllAcnChildren sqf.child.Kind + | _ -> [] + + +// TODO: ALIGN??? +let acnTypeSizeExpr (acn: AcnInsertedType): Expr = + match acn with + | AcnInteger int-> + if int.acnMinSizeInBits <> int.acnMaxSizeInBits then failwith "TODO" + else longlit int.acnMaxSizeInBits + + | AcnNullType nll -> + assert (nll.acnMinSizeInBits = nll.acnMaxSizeInBits) + longlit nll.acnMaxSizeInBits + + | AcnBoolean b -> + assert (b.acnMinSizeInBits = b.acnMaxSizeInBits) + longlit b.acnMaxSizeInBits + + | AcnReferenceToEnumerated e -> + if e.enumerated.acnMinSizeInBits <> e.enumerated.acnMaxSizeInBits then failwith "TODO" + else longlit e.enumerated.acnMaxSizeInBits + + | AcnReferenceToIA5String s -> + if s.str.acnMinSizeInBits <> s.str.acnMaxSizeInBits then failwith "TODO" + else longlit s.str.acnMaxSizeInBits + +let maxAlignmentOf (aligns: AcnAlignment option list): AcnAlignment option = + assert (not aligns.IsEmpty) + aligns |> List.maxBy (fun a -> a |> Option.map (fun a -> a.nbBits) |> Option.defaultValue 0I) + +let rec maxAlignment (tp: Asn1AcnAst.Asn1Type): AcnAlignment option = + match tp.Kind.ActualType with + | Asn1AcnAst.Sequence sq -> + maxAlignmentOf (tp.acnAlignment :: (sq.children |> List.map (fun c -> + match c with + | Asn1Child c -> maxAlignment c.Type + | AcnChild c -> c.Type.acnAlignment + ))) + | Choice ch -> + maxAlignmentOf (tp.acnAlignment :: (ch.children |> List.map (fun c -> maxAlignment c.Type))) + | SequenceOf sqf -> + maxAlignmentOf [tp.acnAlignment; maxAlignment sqf.child] + | _ -> tp.acnAlignment + +let sizeLemmaId(align: AcnAlignment option): string = + match align with + | None -> "sizeLemmaAnyOffset" + | Some NextByte -> "sizeLemmaNextByte" + | Some NextWord -> "sizeLemmaNextWord" + | Some NextDWord -> "sizeLemmaNextDWord" + +let sizeLemmaIdForType (tp: Asn1AcnAst.Asn1TypeKind) (align: AcnAlignment option): string option = + match tp.ActualType with + | Sequence _ | Choice _ | SequenceOf _ -> Some (sizeLemmaId align) + | _ -> 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]}) + +let stringInvariants (minSize: bigint) (maxSize: bigint) (recv: Expr): Expr = + // TODO: If minSize = maxSize, we can still have '\0' before `maxSize`, right? + // TODO: Can we have an `\0` before `minSize` as well? + let arrayLen = ArrayLength recv + let nullCharIx = indexOfOrLength recv (IntLit (UByte, 0I)) + And [Equals (int32lit (maxSize + 1I), arrayLen); Leq (nullCharIx, int32lit maxSize)] + (* + if minSize = maxSize then And [Leq (int32lit (maxSize + 1I), arrayLen); Equals (nullCharIx, int32lit maxSize)] + else + And [Leq (int32lit (maxSize + 1I), arrayLen); Leq (int32lit minSize, nullCharIx); Leq (nullCharIx, int32lit maxSize)] + *) + +let octetStringInvariants (t: Asn1AcnAst.Asn1Type) (os: Asn1AcnAst.OctetString) (recv: Expr): Expr = + let len = ArrayLength (FieldSelect (recv, "arr")) + if os.minSize.acn = os.maxSize.acn then Equals (len, int32lit os.maxSize.acn) + else + let nCount = FieldSelect (recv, "nCount") + And [Leq (len, int32lit os.maxSize.acn); Leq (int32lit os.minSize.acn, nCount); Leq (nCount, len)] + +let bitStringInvariants (t: Asn1AcnAst.Asn1Type) (bs: Asn1AcnAst.BitString) (recv: Expr): Expr = + let len = ArrayLength (FieldSelect (recv, "arr")) + if bs.minSize.acn = bs.maxSize.acn then Equals (len, int32lit (bigint bs.MaxOctets)) + else + let nCount = FieldSelect (recv, "nCount") + And [Leq (len, int32lit (bigint bs.MaxOctets)); Leq (longlit bs.minSize.acn, nCount); Leq (nCount, Mult (len, longlit 8I))] // TODO: Cast en long explicite + +let sequenceInvariantsCommon (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (children: (DAst.Asn1Child * Expr) list): Expr option = + let conds = children |> List.collect (fun (child, field) -> + let isDefined = isDefinedMutExpr field + let opt = + match child.Optionality with + | Some AlwaysPresent -> [isDefined] + | Some AlwaysAbsent -> [Not isDefined] + | _ -> [] + // StringType is a type alias and has therefore no associated class invariant; we need to explicitly add them + let strType = + match child.Type.Kind.baseKind.ActualType with + | IA5String st -> [stringInvariants st.minSize.acn st.maxSize.acn field] + | _ -> [] + opt @ strType + ) + if conds.IsEmpty then None + else if conds.Tail.IsEmpty then Some conds.Head + else Some (And conds) + +let sequenceInvariants (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (children: DAst.Asn1Child list) (recv: Expr): Expr option = + sequenceInvariantsCommon t sq (children |> List.map (fun c -> c, FieldSelect (recv, c._scala_name))) + +let sequenceOfInvariants (sqf: Asn1AcnAst.SequenceOf) (recv: Expr): Expr = + let len = vecSize (FieldSelect (recv, "arr")) + if sqf.minSize.acn = sqf.maxSize.acn then Equals (len, int32lit sqf.maxSize.acn) + else + let nCount = FieldSelect (recv, "nCount") + And [Leq (len, int32lit sqf.maxSize.acn); Leq (int32lit sqf.minSize.acn, nCount); Leq (nCount, len)] + +let private offsetConds (offset :Var) (maxSize: bigint) = + And [ + Leq (longlit 0I, Var offset) + Leq (Var offset, longlit (2I ** 63 - 1I - maxSize)) + ] + +let private implyingAlignments (align: AcnAlignment option): AcnAlignment option list = + match align with + | None -> [None; Some NextByte; Some NextWord; Some NextDWord] + | Some NextByte -> [Some NextByte; Some NextWord; Some NextDWord] + | Some NextWord -> [Some NextWord; Some NextDWord] + | Some NextDWord -> [Some NextDWord] + +let private sizeLemmaTemplate (maxSize: bigint) (align: AcnAlignment option): FunDef = + let id = sizeLemmaId align + let offset = {Var.name = "offset"; tpe = IntegerType Long} + let otherOffset = {Var.name = "otherOffset"; tpe = IntegerType Long} + let res = {name = "res"; tpe = UnitType} + let additionalPrecond = + match align with + | None -> [] + | Some align -> + let modOffset = Mod (Var offset, longlit align.nbBits) + let modOtherOffset = Mod (Var otherOffset, longlit align.nbBits) + [Precond (Equals (modOffset, modOtherOffset))] + let postcond = Equals (callSize This (Var offset), callSize This (Var otherOffset)) + { + id = id + prms = [offset; otherOffset] + specs = [Precond (offsetConds offset maxSize); Precond (offsetConds otherOffset maxSize)] @ additionalPrecond + annots = [GhostAnnot; Opaque; InlineOnce] + postcond = Some (res, postcond) + returnTpe = UnitType + body = UnitLit + } + +let countNbPresenceBits (sq: Sequence): int = + 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 + ) + +// TODO: UPER/ACN + +type SizeExprRes = { + bdgs: (Var * Expr) list + resSize: Expr +} +type SeqSizeExprChildRes = { + extraBdgs: (Var * Expr) list + childVar: Var + childSize: Expr +} +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 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 renameBindingsSizeRes (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) + let renamedVarFor (old: Var): Var = + renamedVars.[allVars |> List.findIndex (fun v -> v = old)] + let subst (res: SeqSizeExprChildRes): SeqSizeExprChildRes = + { + extraBdgs = res.extraBdgs |> List.map (fun (v, e) -> renamedVarFor v, substVars mapping e) + childVar = renamedVarFor res.childVar + childSize = substVars mapping res.childSize + } + res |> List.map subst + +let rec asn1SizeExpr (align: AcnAlignment option) + (tp: Asn1AcnAst.Asn1TypeKind) + (obj: Expr) + (offset: Expr) + (nestingLevel: bigint) + (nestingIx: bigint): SizeExprRes = + let aligned (res: SizeExprRes): SizeExprRes = + {res with resSize = alignedSizeTo align res.resSize offset} + + match tp with + | Integer int -> + aligned {bdgs = []; resSize = intSizeExpr int obj} + | Enumerated enm -> + assert (enm.acnMinSizeInBits = enm.acnMaxSizeInBits) + aligned {bdgs = []; resSize = longlit enm.acnMaxSizeInBits} + | IA5String st -> + let szProps = st.acnProperties.sizeProp |> Option.map fromAcnSizeProps + let charSize = GetNumberOfBitsForNonNegativeInteger (bigint (st.uperCharSet.Length - 1)) + aligned {bdgs = []; resSize = stringLikeSizeExpr szProps st.minSize.acn st.maxSize.acn charSize (indexOfOrLength obj (IntLit (UByte, 0I)))} + | OctetString ot -> + let szProps = ot.acnProperties.sizeProp |> Option.map fromSizeableProps + aligned {bdgs = []; resSize = stringLikeSizeExpr szProps ot.minSize.acn ot.maxSize.acn 8I (stringLength obj)} + | BitString bt -> + let szProps = bt.acnProperties.sizeProp |> Option.map fromSizeableProps + aligned {bdgs = []; resSize = stringLikeSizeExpr szProps bt.minSize.acn bt.maxSize.acn 1I (stringLength obj)} + | NullType nt -> + assert (nt.acnMinSizeInBits = nt.acnMaxSizeInBits) + aligned {bdgs = []; resSize = longlit nt.acnMaxSizeInBits} + | Boolean bt -> + assert (bt.acnMinSizeInBits = bt.acnMaxSizeInBits) + aligned {bdgs = []; resSize = longlit bt.acnMaxSizeInBits} + | Real rt -> + // TODO: We don't support these anyway + // assert (rt.acnMinSizeInBits = rt.acnMaxSizeInBits) + aligned {bdgs = []; resSize = longlit rt.acnMaxSizeInBits} + | Sequence sq -> + // Alignment done there + seqSizeExpr sq align obj offset (nestingLevel + 1I) nestingIx + | Choice ch -> + // Ditto + choiceSizeExpr ch align obj offset (nestingLevel + 1I) nestingIx + | SequenceOf _ -> + // seqOfSizeRangeExpr sqf obj offset (nestingLevel + 1I) nestingIx + // TODO: dire pk + aligned {bdgs = []; resSize = callSize obj offset} + | ReferenceType rt -> + let isComposite = + match rt.resolvedType.ActualType.Kind with + | Sequence _ | SequenceOf _ | Choice _ -> true + | _ -> false + if rt.hasExtraConstrainsOrChildrenOrAcnArgs || not isComposite then + // Alignment done there + asn1SizeExpr rt.resolvedType.acnAlignment rt.resolvedType.Kind obj offset nestingLevel nestingIx + else + {bdgs = []; resSize = alignedSizeTo rt.resolvedType.acnAlignment (callSize obj offset) offset} + | _ -> aligned {bdgs = []; resSize = callSize obj offset} + +and seqSizeExprHelperChild (child: SeqChildInfo) + (ix: bigint) + (recv: Expr option) + (offset: Expr) + (nestingLevel: bigint) + (nestingIx: bigint): SizeExprRes = + match child with + | AcnChild acn -> + {bdgs = []; resSize = acnTypeSizeExpr acn.Type} + | Asn1Child asn1 -> + match asn1.Optionality with + | Some _ -> + let someBdg = {Var.name = "v"; tpe = fromAsn1TypeKind asn1.Type.Kind} + let childRes = asn1SizeExpr asn1.Type.acnAlignment asn1.Type.Kind (Var someBdg) offset nestingLevel (nestingIx + ix) + let resSize = optionMutMatchExpr recv.Value (Some someBdg) childRes.resSize (longlit 0I) + {bdgs = childRes.bdgs; resSize = resSize} + | None -> + asn1SizeExpr asn1.Type.acnAlignment asn1.Type.Kind recv.Value offset nestingLevel (nestingIx + ix) + +and seqSizeExprHelper (sq: Sequence) + (obj: Expr) + (offset: Expr) + (nestingLevel: bigint) + (nestingIx: bigint): SeqSizeExprChildRes list = + let nbPresenceBits = countNbPresenceBits sq + + let childSize (acc: SeqSizeExprChildRes list) (ix0: int, child: SeqChildInfo): SeqSizeExprChildRes list = + let ix = bigint (nbPresenceBits + ix0) + let varName = + if nestingLevel = 0I then $"size_{nestingIx + ix}" + else $"size_{nestingLevel}_{nestingIx + ix}" + let resVar = {Var.name = varName; tpe = IntegerType Long} + let accOffset = plus (offset :: (acc |> List.map (fun res -> Var res.childVar))) + let recv = + match child with + | AcnChild _ -> None + | Asn1Child child -> Some (FieldSelect (obj, child._scala_name)) + let childResSize = seqSizeExprHelperChild child ix recv accOffset nestingLevel nestingIx + acc @ [{extraBdgs = childResSize.bdgs; childVar = resVar; childSize = childResSize.resSize}] + + let presenceBitsVars = [0 .. nbPresenceBits - 1] |> List.map (fun i -> + let varName = + if nestingLevel = 0I then $"size_{nestingIx + bigint i}" + else $"size_{nestingLevel}_{nestingIx + bigint i}" + {extraBdgs = []; childVar = {name = varName; tpe = IntegerType Long}; childSize = longlit 1I} + ) + sq.children |> List.indexed |> (List.fold childSize presenceBitsVars) + +and seqSizeExpr (sq: Sequence) + (align: AcnAlignment option) + (obj: Expr) + (offset: Expr) + (nestingLevel: bigint) + (nestingIx: bigint): SizeExprRes = + if sq.children.IsEmpty then {bdgs = []; resSize = longlit 0I} + else + let childrenSizes = seqSizeExprHelper sq obj offset nestingLevel nestingIx + let allBindings = childrenSizes |> List.collect (fun s -> s.extraBdgs @ [(s.childVar, s.childSize)]) + let childrenVars = childrenSizes |> List.map (fun s -> s.childVar) + let resultSize = childrenVars |> List.map Var |> plus + let resultSize = alignedSizeTo align resultSize offset + {bdgs = allBindings; resSize = resultSize} + +and choiceSizeExpr (choice: Asn1AcnAst.Choice) + (align: AcnAlignment option) + (obj: Expr) + (offset: Expr) + (nestingLevel: bigint) + (nestingIx: bigint): SizeExprRes = + let cases = choice.children |> List.map (fun child -> + let tpeId = (ToC choice.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)]} + let res = asn1SizeExpr child.Type.acnAlignment child.Type.Kind (Var binder) offset nestingLevel nestingIx + let resSize = alignedSizeTo align res.resSize offset + let res = letsIn res.bdgs resSize + {MatchCase.pattern = pat; rhs = res} + ) + {bdgs = []; resSize = MatchExpr {scrut = obj; cases = cases}} + + + +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) + let offset = {Var.name = "offset"; tpe = IntegerType Long} + let res = seqSizeExpr sq t.acnAlignment This (Var offset) 0I 0I + let finalSize = letsIn res.bdgs res.resSize + let res = {name = "res"; tpe = IntegerType Long} + let postcond = + if sq.acnMinSizeInBits = sq.acnMaxSizeInBits then Equals (Var res, longlit sq.acnMaxSizeInBits) + else And [Leq (longlit 0I, Var res); Leq (Var res, longlit sq.acnMaxSizeInBits)] + + let sizeLemmas (align: AcnAlignment option): FunDef = + let template = sizeLemmaTemplate sq.acnMaxSizeInBits align + let offset = template.prms.[0] + let otherOffset = template.prms.[1] + + let allResWithOffset = seqSizeExprHelper sq This (Var offset) 0I 0I + let allResWithOffset = renameBindingsSizeRes allResWithOffset "_offset" + let allResWithOtherOffset = seqSizeExprHelper sq This (Var otherOffset) 0I 0I + let allResWithOtherOffset = renameBindingsSizeRes allResWithOtherOffset "_otherOffset" + + let proofSubcase (ix: int, (resWithOffset: SeqSizeExprChildRes, resWithOtherOffset: SeqSizeExprChildRes, child: SeqChildInfo option)) (rest: Expr): Expr = + let withBindingsPlugged (expr: Expr option): Expr = + let allBdgs = + resWithOffset.extraBdgs @ + [(resWithOffset.childVar, resWithOffset.childSize)] @ + resWithOtherOffset.extraBdgs @ + [(resWithOtherOffset.childVar, resWithOtherOffset.childSize)] + match expr with + | Some expr -> letsIn allBdgs (mkBlock [expr; rest]) + | None -> letsIn allBdgs rest + + match child with + | Some (Asn1Child child) -> + let accOffset = Var offset :: (allResWithOffset |> List.take ix |> List.map (fun res -> Var res.childVar)) + let accOtherOffset = Var otherOffset :: (allResWithOtherOffset |> List.take ix |> List.map (fun res -> Var res.childVar)) + match child.Optionality with + | Some _ -> + let scrut = FieldSelect (This, child._scala_name) + let someBdg = {Var.name = "v"; tpe = fromAsn1TypeKind child.Type.Kind} + let lemmaCall = sizeLemmaCall child.Type.Kind align (Var someBdg) (plus accOffset) (plus accOtherOffset) + let mtchExpr = lemmaCall |> Option.map (fun call -> optionMutMatchExpr scrut (Some someBdg) call UnitLit) + withBindingsPlugged mtchExpr + | None -> + let lemmaCall = sizeLemmaCall child.Type.Kind align (FieldSelect (This, child._scala_name)) (plus accOffset) (plus accOtherOffset) + withBindingsPlugged lemmaCall + | _ -> withBindingsPlugged None + + let nbPresenceBits = countNbPresenceBits sq + assert (allResWithOffset.Length = allResWithOtherOffset.Length) + assert (allResWithOffset.Length = sq.children.Length + nbPresenceBits) + let sqChildren = (List.replicate nbPresenceBits None) @ (sq.children |> List.map Some) + let proofBody = (List.foldBack proofSubcase ((List.zip3 allResWithOffset allResWithOtherOffset sqChildren) |> List.indexed) UnitLit) + + {template with body = proofBody} + + let sizeFd = { + id = "size" + prms = [offset] + specs = [Precond (offsetConds offset sq.acnMaxSizeInBits)] + annots = [] + postcond = Some (res, postcond) + returnTpe = IntegerType Long + body = finalSize + } + let maxAlign = maxAlignment t + let implyingAligns = implyingAlignments maxAlign + let lemmas = implyingAligns |> List.map sizeLemmas + sizeFd :: lemmas + +let choiceSizeFunDefs (t: Asn1AcnAst.Asn1Type) (choice: Asn1AcnAst.Choice): FunDef list = + let offset = {Var.name = "offset"; tpe = IntegerType Long} + let sizeRes = choiceSizeExpr choice t.acnAlignment This (Var offset) 0I 0I + assert sizeRes.bdgs.IsEmpty + let sizeLemmas (align: AcnAlignment option): FunDef = + let template = sizeLemmaTemplate choice.acnMaxSizeInBits align + let offset = template.prms.[0] + let otherOffset = template.prms.[1] + let proofCases = choice.children |> List.map (fun child -> + let tpeId = (ToC choice.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)]} + let subcaseProof = sizeLemmaCall child.Type.Kind align (Var binder) (Var offset) (Var otherOffset) + {MatchCase.pattern = pat; rhs = subcaseProof |> Option.defaultValue UnitLit} + ) + let proof = MatchExpr {scrut = This; cases = proofCases} + {template with body = proof} + + let res = {name = "res"; tpe = IntegerType Long} + let postcond = + if choice.acnMinSizeInBits = choice.acnMaxSizeInBits then Equals (Var res, longlit choice.acnMaxSizeInBits) + else And [Leq (longlit 0I, Var res); Leq (Var res, longlit choice.acnMaxSizeInBits)] + let sizeFd = { + id = "size" + prms = [offset] + specs = [Precond (offsetConds offset choice.acnMaxSizeInBits)] + annots = [] + postcond = Some (res, postcond) + returnTpe = IntegerType Long + body = sizeRes.resSize + } + let maxAlign = maxAlignment t + let implyingAligns = implyingAlignments maxAlign + let lemmas = implyingAligns |> List.map sizeLemmas + sizeFd :: lemmas + +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 res = {name = "res"; tpe = IntegerType Long} + + let callSizeRangeObj (ls: Expr) (offset: Expr) (from: Expr) (tto: Expr): Expr = + FunctionCall { + prefix = [td] + id = "sizeRange" + tps = [] + args = [ls; offset; from; tto] + } + + let offsetCondHelper (offset: Var) (from: Var) (tto: Var): Expr = + let overhead = sq.acnMaxSizeInBits - sq.maxSize.acn * sq.child.Kind.acnMaxSizeInBits + And [ + Leq (longlit 0I, Var offset) + Leq (Var offset, Minus (longlit (2I ** 63 - 1I - overhead), Mult (longlit sq.child.Kind.acnMaxSizeInBits, Minus (Var tto, Var from)))) + ] + let rangeVarsCondHelper (ls: Var) (from: Var) (tto: Var): Expr = And [Leq (int32lit 0I, Var from); Leq (Var from, Var tto); Leq (Var tto, vecSize (Var ls)); Leq (vecSize (Var ls), int32lit sq.maxSize.acn)] + + let sizeRangeObjFd = + let ls = {name = "ls"; tpe = lsTpe} + let offset = {Var.name = "offset"; tpe = IntegerType Long} + let from = {name = "from"; tpe = IntegerType Int} + let tto = {name = "to"; tpe = IntegerType Int} + let measure = Minus (Var tto, Var from) + let offsetCond = offsetCondHelper offset from tto + let rangeVarsConds = rangeVarsCondHelper ls from tto + let elem = vecApply (Var ls) (Var from) + let elemSizeVar = {name = "elemSize"; tpe = IntegerType Long} + let elemSize = asn1SizeExpr sq.child.acnAlignment sq.child.Kind elem (Var offset) 0I 0I + let elemSizeAssert = + if sq.child.Kind.acnMinSizeInBits = sq.child.Kind.acnMaxSizeInBits then + Assert (Equals (Var elemSizeVar, longlit sq.child.Kind.acnMinSizeInBits)) + else + Assert (And [ + Leq (longlit 0I, Var elemSizeVar) + Leq (Var elemSizeVar, longlit sq.child.Kind.acnMaxSizeInBits) + ]) + let reccall = callSizeRangeObj (Var ls) (plus [Var offset; Var elemSizeVar]) (plus [Var from; int32lit 1I]) (Var tto) + let resSize = alignedSizeTo t.acnAlignment (plus [Var elemSizeVar; reccall]) (Var offset) + let elseBody = letsIn (elemSize.bdgs @ [elemSizeVar, elemSize.resSize]) (mkBlock [elemSizeAssert; resSize]) + let body = + IfExpr { + cond = Equals (Var from, Var tto) + thn = longlit 0I + els = elseBody + } + + let postcondRange = + let nbElems = {Var.name = "nbElems"; tpe = IntegerType Int} // TODO: Add explicit cast to Long + let sqUpperBound = Mult (longlit sq.child.Kind.acnMaxSizeInBits, Var nbElems) + Let { + bdg = nbElems + e = Minus (Var tto, Var from) // TODO: Add explicit cast to Long + body = And [ + Leq (longlit 0I, Var res) + Leq (Var res, sqUpperBound) + ] + } + { + id = "sizeRange" + prms = [ls; offset; from; tto] + specs = [Precond rangeVarsConds; Precond offsetCond; Measure measure] + annots = [] + postcond = Some (res, postcondRange) + returnTpe = IntegerType Long + body = body + } + + let sizeLemmas (align: AcnAlignment option): FunDef * FunDef = + let elemSizeAssert (elemSizeVar: Var): Expr = + if sq.child.Kind.acnMinSizeInBits = sq.child.Kind.acnMaxSizeInBits then + Assert (Equals (Var elemSizeVar, longlit sq.child.Kind.acnMinSizeInBits)) + else + Assert (And [ + Leq (longlit 0I, Var elemSizeVar) + Leq (Var elemSizeVar, longlit sq.child.Kind.acnMaxSizeInBits) + ]) + + let template = sizeLemmaTemplate sq.acnMaxSizeInBits align + let offset = template.prms.[0] + let otherOffset = template.prms.[1] + let ls = {name = "ls"; tpe = lsTpe} + let from = {name = "from"; tpe = IntegerType Int} + let tto = {name = "to"; tpe = IntegerType Int} + let additionalPrecond = + match align with + | None -> [] + | Some align -> + let modOffset = Mod (Var offset, longlit align.nbBits) + let modOtherOffset = Mod (Var otherOffset, longlit align.nbBits) + [Precond (Equals (modOffset, modOtherOffset))] + let postcond = + Equals ( + callSizeRangeObj (Var ls) (Var offset) (Var from) (Var tto), + callSizeRangeObj (Var ls) (Var otherOffset) (Var from) (Var tto) + ) + let elemSel = vecApply (Var ls) (Var from) + let elemSizeOffVar = {Var.name = "elemSizeOff"; tpe = IntegerType Long} + let elemSizeOtherOffVar = {Var.name = "elemSizeOtherOff"; tpe = IntegerType Long} + let elemSizeOffRes = asn1SizeExpr align sq.child.Kind elemSel (Var offset) 0I 0I + let elemSizeOtherOffRes = asn1SizeExpr align sq.child.Kind elemSel (Var otherOffset) 0I 0I + let elemSizesBdgs = + elemSizeOffRes.bdgs @ + [(elemSizeOffVar, elemSizeOffRes.resSize)] @ + elemSizeOtherOffRes.bdgs @ + [(elemSizeOtherOffVar, elemSizeOtherOffRes.resSize)] + let elemLemmaCall = sizeLemmaCall sq.child.Kind align elemSel (Var offset) (Var otherOffset) + let inductiveStep = FunctionCall { + prefix = [td] + id = template.id + tps = [] + args = [ + Var ls + plus [Var offset; Var elemSizeOffVar] + plus [Var otherOffset; Var elemSizeOtherOffVar] + plus [Var from; int32lit 1I] + Var tto + ] + } + let proofElsePart = mkBlock ([ + elemSizeAssert elemSizeOffVar + elemSizeAssert elemSizeOtherOffVar + ] @ (elemLemmaCall |> Option.toList) @ [inductiveStep]) + let proofElsePart = letsIn elemSizesBdgs proofElsePart + let proofBody = + IfExpr { + cond = Equals (Var from, Var tto) + thn = UnitLit + els = proofElsePart + } + let proofSpecs = + [ + Precond (rangeVarsCondHelper ls from tto) + Precond (offsetCondHelper offset from tto) + Precond (offsetCondHelper otherOffset from tto) + ] @ additionalPrecond @ [Measure (Minus (Var tto, Var from))] + let objFd = { + id = template.id + prms = [ls; offset; otherOffset; from; tto] + annots = [GhostAnnot; Opaque; InlineOnce] + specs = proofSpecs + postcond = Some ({name = "_"; tpe = UnitType}, postcond) + 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 clsFd = {template with body = objCall} + clsFd, objFd + + let sizeClsFd = + let offset = {Var.name = "offset"; tpe = IntegerType Long} + let sizeField = + match sq.acnEncodingClass with + | SZ_EC_LENGTH_EMBEDDED sz -> sz + | _ -> 0I // TODO: Pattern? + let postcond = + if sq.acnMinSizeInBits = sq.acnMaxSizeInBits then Equals (Var res, longlit sq.acnMaxSizeInBits) + else And [Leq (longlit 0I, Var res); Leq (Var res, longlit sq.acnMaxSizeInBits)] + let finalSize = (plus [ + longlit sizeField + callSizeRangeObj (FieldSelect (This, "arr")) (Var offset) (int32lit 0I) (FieldSelect (This, "nCount")) + ]) + { + id = "size" + prms = [offset] + specs = [Precond (offsetConds offset sq.acnMaxSizeInBits)] + annots = [] + postcond = Some (res, postcond) + returnTpe = IntegerType Long + body = finalSize + } + + let maxAlign = maxAlignment t + let implyingAligns = implyingAlignments maxAlign + let clsLemmas, objLemmas = implyingAligns |> List.map sizeLemmas |> List.unzip + sizeClsFd :: clsLemmas, sizeRangeObjFd :: objLemmas + + +let generateSequenceSizeDefinitions (t: Asn1AcnAst.Asn1Type) (sq: Asn1AcnAst.Sequence) (children: DAst.SeqChildInfo list): string list = + let fds = seqSizeFunDefs t sq + fds |> List.map (fun fd -> show (FunDefTree fd)) + +let generateChoiceSizeDefinitions (t: Asn1AcnAst.Asn1Type) (choice: Asn1AcnAst.Choice) (children: DAst.ChChildInfo list): string list = + let fds = choiceSizeFunDefs t choice + fds |> List.map (fun fd -> show (FunDefTree fd)) + +let generateSequenceOfSizeDefinitions (t: Asn1AcnAst.Asn1Type) (sqf: Asn1AcnAst.SequenceOf) (elemTpe: DAst.Asn1Type): string list * string list = + let fdsCls, fdsObj = seqOfSizeFunDefs t sqf + fdsCls |> List.map (fun fd -> show (FunDefTree fd)), fdsObj |> List.map (fun fd -> show (FunDefTree fd)) + +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 reqs = sequenceInvariantsCommon t sq (List.zip children (prms |> List.map Var)) + let fd = { + FunDef.id = "apply" + prms = prms + annots = [] + specs = reqs |> Option.map Precond |> Option.toList + postcond = None + returnTpe = retTpe + body = body + } + [show (FunDefTree fd)] + + +let generateEncodePostcondExprCommon (tpe: Type) + (maxSize: bigint) + (pVal: Selection) + (resPostcond: Var) + (sz: SizeExprRes) + (extraCondsPre: Expr list) + (decodePureId: string) + (decodeExtraArgs: Expr list): Expr = + let codecTpe = runtimeCodecTypeFor ACN + 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 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] + + // TODO: Put back invertibility + let rightBody = And (extraCondsPre @ [ + Equals (selBufLength oldCdc, selBufLength (Var cdc)) + Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) + ] (*@ invertibility*)) + let rightBody = letsIn sz.bdgs rightBody + eitherMatchExpr (Var resPostcond) None (BoolLit true) None rightBody + +let generatePrecond (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 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 (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 codecTpe = runtimeCodecTypeFor ACN + let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} + let oldCdc = Old (Var cdc) + let tpe = fromAsn1TypeKind t.Kind + let szRecv = {Var.name = pVal.asLastOrSelf.receiverId; tpe = tpe} + let sz = + match t.Kind with + | Choice _ | Sequence _ | SequenceOf _ -> + // 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 [] + +let generateDecodePostcondExpr (t: Asn1AcnAst.Asn1Type) (resPostcond: Var): Expr = + let codecTpe = runtimeCodecTypeFor ACN + let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} + let oldCdc = Old (Var cdc) + let tpe = fromAsn1TypeKind t.Kind + let szRecv = {Var.name = "resVal"; tpe = tpe} + let sz = + match t.Kind with + | Choice _ | Sequence _ | SequenceOf _ -> + // 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 + let strSize = + match t.ActualType.Kind with + | IA5String str -> [Equals (vecSize (Var szRecv), int32lit (str.maxSize.acn + 1I))] // +1 for the null terminator + | _ -> [] + let cstrIsValid = + match t.ActualType.Kind with + | NullType _ -> [] + | _ -> + let isValidFuncName = $"{t.FT_TypeDefinition.[Scala].typeName}_IsConstraintValid" + [isRightExpr (FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var szRecv]})] + generateDecodePostcondExprCommon resPostcond szRecv sz [] (strSize @ cstrIsValid) + +let rec tryFindFirstParentACNDependency (parents: Asn1AcnAst.Asn1Type list) (dep: RelativePath): (Asn1AcnAst.Asn1Type * Asn1AcnAst.AcnChild) option = + match parents with + | [] -> None + | parent :: rest -> + match parent.ActualType.Kind with + | Sequence _ -> + let directAcns = collectNestedAcnChildren parent.Kind + directAcns |> List.tryFind (fun acn -> List.endsWith acn.id.fieldPath dep.asStringList) |> + Option.map (fun acn -> parent, acn) |> + Option.orElse (tryFindFirstParentACNDependency rest dep) + | _ -> tryFindFirstParentACNDependency rest dep + +let rec firstOutermostSeqParent (parents: Asn1AcnAst.Asn1Type list): Asn1AcnAst.Asn1Type option = + match parents with + | [] -> None + | parent :: rest -> + 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 = + t.externalDependencies |> List.map (fun dep -> + let acnDep = tryFindFirstParentACNDependency (nestingScope.parents |> List.map snd) dep + assert acnDep.IsSome + let _, acnParam = acnDep.Value + let nme = ToC (acnParam.id.dropModule.AcnAbsPath.StrJoin "_") + let tpe = fromAcnInsertedType acnParam.Type + {Var.name = nme; tpe = tpe} + ) + +// 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. +// We can do so in two ways: +// * 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). +let acnExternDependenciesVariableEncode (t: Asn1AcnAst.Asn1Type) (nestingScope: NestingScope): Var option = + let rec allDependenciesExcept (t: Asn1AcnAst.Asn1Type) (avoid: ReferenceToType): RelativePath list = + if t.id = avoid then [] + else + match t.Kind with + | ReferenceType tp -> allDependenciesExcept tp.resolvedType avoid + | Sequence sq -> + sq.acnArgs @ (sq.children |> List.collect (fun c -> + match c with + | Asn1Child c -> allDependenciesExcept c.Type avoid + | AcnChild _ -> [] + )) + | Choice ch -> ch.acnArgs + | SequenceOf sqf -> sqf.acnArgs + | _ -> [] + match firstOutermostSeqParent (nestingScope.parents |> List.map snd) with + | None -> None + | Some seqParent -> + match seqParent.id.ToScopeNodeList with + | MD _ :: TA _ :: [] -> + // This is the outermost parent, the "pVal" that we always include in auxiliary encoding functions from `wrapAcnFuncBody` + None + | _ -> + let acnChildren = collectNestedAcnChildren t.Kind |> List.map (fun acn -> + assert List.isPrefixOf seqParent.id.fieldPath acn.id.fieldPath + acn.id.fieldPath |> List.skip seqParent.id.fieldPath.Length + ) + // We check whether this `t` is an external dependency to a child of the parent (other than itself, hence the "except") + let allDeps = allDependenciesExcept seqParent t.id + let isAnExternalDependency = allDeps |> List.exists (fun dep -> + acnChildren |> List.exists (fun acn -> List.isPrefixOf acn dep.asStringList) + ) + if not isAnExternalDependency then None + else + let tpe = fromAsn1TypeKind seqParent.Kind + let nme = seqParent.id.lastItem + Some {Var.name = nme; tpe = tpe} + +let wrapAcnFuncBody (t: Asn1AcnAst.Asn1Type) + (body: string) + (codec: Codec) + (nestingScope: NestingScope) + (outerSel: CallerScope) + (recSel: CallerScope): FunDef * Expr = + assert recSel.arg.path.IsEmpty + let codecTpe = runtimeCodecTypeFor ACN + let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} + let oldCdc = {Var.name = "oldCdc"; tpe = ClassType codecTpe} + let tpe = fromAsn1TypeKind t.Kind + let errTpe = IntegerType Int + 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" + + match codec with + | Encode -> + let retTpe = IntegerType Int + let outerPVal = SelectionExpr (joinedSelection outerSel.arg) + let cstrCheck = + let scrut = FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var recPVal]} + let leftBdg = {Var.name = "l"; tpe = errTpe} + let leftBody = Return (leftExpr errTpe retTpe (Var leftBdg)) + eitherMatchExpr scrut (Some leftBdg) leftBody None (mkBlock []) + + let body = letsGhostIn [oldCdc, Snapshot (Var cdc)] (mkBlock ([ + cstrCheck + EncDec body + ClassCtor (right errTpe retTpe (int32lit 0I)) + ])) + + 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 szRecv = {Var.name = recSel.arg.asLastOrSelf.receiverId; tpe = tpe} + let sz = + match t.Kind with + | Choice _ | SequenceOf _ -> {bdgs = []; resSize = callSize (Var szRecv) (bitIndexACN (Old (Var cdc)))} + | _ -> + // TODO: For Sequence, we don't know whether we have extra ACN fields or not. + // 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 fd = { + id = $"{ToC t.id.dropModule.AsString}_ACN_Encode" + prms = [cdc; outermostPVal] @ acnVars @ [recPVal] + specs = precond + annots = [Opaque; InlineOnce] + postcond = Some (resPostcond, postcondExpr) + returnTpe = ClassType (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 leftBdg = {Var.name = "l"; tpe = errTpe} + let leftBody = Return (leftExpr errTpe (IntegerType Int) (Var leftBdg)) + eitherMatchExpr scrut (Some leftBdg) leftBody None UnitLit + + fd, call + | Decode -> + // Computing external ACN dependencies + let paramsAcn = acnExternDependenciesVariableDecode t nestingScope + + // All ACN fields present in this SEQUENCE, including nested ones + let acns = collectNestedAcnChildren t.Kind + let acnsVars = acns |> List.map (fun c -> {Var.name = getAcnDeterminantName c.id; tpe = fromAcnInsertedType c.Type}) + let acnTps = acnsVars |> List.map (fun v -> v.tpe) + let retTpe = tupleType (tpe :: acnTps) + let outerPVal = {Var.name = outerSel.arg.asIdentifier; tpe = tpe} + let retInnerFd = + let retVal = mkTuple (Var recPVal :: (acnsVars |> List.map Var)) + let scrut = FunctionCall {prefix = []; id = isValidFuncName; tps = []; args = [Var recPVal]} + 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 szRecv = {Var.name = "resVal"; tpe = tpe} + let sz = + match t.Kind with + | Choice _ | SequenceOf _ -> {bdgs = []; resSize = callSize (Var szRecv) (bitIndexACN (Old (Var cdc)))} + | _ -> + // TODO: For Sequence, we don't know whether we have extra ACN fields or not. + // 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 postcondExpr = + if acns.IsEmpty then + generateDecodePostcondExprCommon resPostcond szRecv sz [] [cstrIsValid] + else + assert (match t.Kind with Sequence _ -> true | _ -> false) + let codecTpe = runtimeCodecTypeFor ACN + let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} + let oldCdc = Old (Var cdc) + let rightBody = letsIn sz.bdgs (And [ + Equals (selBuf oldCdc, selBuf (Var cdc)) + Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz.resSize]) + cstrIsValid + ]) + MatchExpr { + scrut = Var resPostcond + cases = [ + { + pattern = ADTPattern {binder = None; id = leftMutId; subPatterns = [Wildcard None]} + rhs = BoolLit true + } + { + pattern = ADTPattern { + binder = None + id = rightMutId + subPatterns = [TuplePattern { + binder = None + subPatterns = Wildcard (Some szRecv) :: (List.replicate acns.Length (Wildcard None)) + }] + } + rhs = rightBody + } + ] + } + + let fd = { + id = $"{ToC t.id.dropModule.AsString}_ACN_Decode" + prms = [cdc] @ paramsAcn + specs = precond + annots = [Opaque; InlineOnce] + postcond = Some (resPostcond, postcondExpr) + returnTpe = ClassType (eitherMutTpe errTpe retTpe) + body = body + } + + let call = + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (paramsAcn |> List.map Var)} + let leftBdg = {Var.name = "l"; tpe = errTpe} + // TODO: FIXME: the right type must be the outside type!!! + let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} + 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 + eitherMutMatchExpr scrut (Some leftBdg) leftBody (Some rightBdg) rightBody + // The rest of the backend expects a `val outerPVal = result` + // Note: we cannot use tuple destructuring because the `acnsVars` may start with a capital letter, which is interpreted as a type + let ret = + if acnsVars.IsEmpty then Let {bdg = outerPVal; e = call; body = mkBlock []} + else + 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 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) @@ -65,10 +1094,10 @@ let wrapEncDecStmts (enc: Asn1Encoding) (snapshots: Var list) (cdc: Var) (oldCdc match encodingTpe with | FullyConstrainedPositive (min, max) | FullyConstrained (min, max) -> // TODO: The RT library does not add 1, why? - let call = RTFunctionCall {fn = GetBitCountUnsigned; args = [IntLit (ULong, max - min)]} + 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, IntLit (Int, nBits)) + let cond = Equals (call, int32lit nBits) Some cond | _ -> None | _ -> None @@ -81,171 +1110,773 @@ let wrapEncDecStmts (enc: Asn1Encoding) (snapshots: Var list) (cdc: Var) (oldCdc let thisMaxSize = pg.maxSize enc let fstSnap = snapshots.Head let isNested = pg.nestingLevel > 0I - assert (isNested || fstSnap = oldCdc) - let wrap (ix: int, (snap: Var, child: SequenceChildProps, stmt: string option)) (offsetAcc: bigint, rest: Expr): bigint * Expr = + let sizeRess = + pg.children |> + List.indexed |> + List.map (fun (ix, c) -> + let childVar = {Var.name = $"size_{pg.nestingIx + bigint ix}"; tpe = IntegerType Long} + match c.info 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 + {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 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 - //assert (thisMaxSize <= (pg.siblingMaxSize enc |> Option.defaultValue thisMaxSize)) // TODO: Somehow does not always hold with UPER? let relativeOffset = offsetAcc - (pg.maxOffset enc) - let offsetCheckOverall = Check (Leq (callBitIndex (Var cdc), Plus ((callBitIndex (Var oldCdc)), (IntLit (Long, offsetAcc))))) + let offsetCheckOverall = Check (Leq (bitIndexACN (Var cdc), plus [bitIndexACN (Var oldCdc); (longlit offsetAcc)])) let offsetCheckNested = - if isNested then [Check (Leq (callBitIndex (Var cdc), Plus ((callBitIndex (Var fstSnap)), (IntLit (Long, relativeOffset)))))] + if isNested then [Check (Leq (bitIndexACN (Var cdc), plus [bitIndexACN (Var fstSnap); longlit relativeOffset]))] else [] let bufCheck = match codec with - | Encode -> [] + | Encode -> [Check ((Equals (selBufLength (Var cdc), selBufLength (Var oldCdc))))] | Decode -> [Check ((Equals (selBuf (Var cdc), selBuf (Var oldCdc))))] let offsetWidening = match pg.siblingMaxSize enc with | Some siblingMaxSize when ix = nbChildren - 1 && siblingMaxSize <> thisMaxSize -> let diff = siblingMaxSize - thisMaxSize [ - Check (Leq (callBitIndex (Var cdc), Plus ((callBitIndex (Var oldCdc)), (IntLit (Long, offsetAcc + diff))))); - Check (Leq (callBitIndex (Var cdc), Plus ((callBitIndex (Var fstSnap)), (IntLit (Long, relativeOffset + diff))))); + Check (Leq (bitIndexACN (Var cdc), plus [bitIndexACN (Var oldCdc); longlit (offsetAcc + diff)])) + Check (Leq (bitIndexACN (Var cdc), plus [bitIndexACN (Var fstSnap); longlit (relativeOffset + diff)])) ] | _ -> [] let checks = offsetCheckOverall :: offsetCheckNested @ bufCheck @ offsetWidening - let body = - match stmt with - | Some stmt when true || ix < nbChildren - 1 -> - let lemma = AppliedLemma { - lemma = ValidateOffsetBitsIneqLemma; - args = [selBitStream (Var snap); selBitStream (Var cdc); IntLit (Long, outerMaxSize - offsetAcc + sz); IntLit (Long, sz)] } - mkBlock ((addAssert child.typeInfo.typeKind) :: [EncDec stmt; Ghost (mkBlock (lemma :: checks)); rest]) - - | Some stmt -> - mkBlock ((addAssert child.typeInfo.typeKind) :: ([EncDec stmt; Ghost (mkBlock checks); rest])) - - | _ -> mkBlock [Ghost (mkBlock checks); rest] + let validateOffsetLemma = + if stmt.IsSome && ix < nbChildren - 1 then + [validateOffsetBitsIneqLemma (selBitStream (Var snap)) (selBitStream (Var cdc)) (longlit (outerMaxSize - offsetAcc + sz)) (longlit sz)] + else [] + let preciseSize = annotatePostPreciseSize ix snap child + mkBlock [Ghost (mkBlock (validateOffsetLemma @ checks)); preciseSize] - (offsetAcc - sz, LetGhost {bdg = snap; e = Snapshot (Var cdc); body = body}) + let annotate (ix: int, (snap: Var, child: SequenceChildProps, stmt: string option)) (offsetAcc: bigint, rest: Expr): bigint * Expr = + let sz = child.typeInfo.maxSize enc + //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 postAnnots = annotatePost ix snap child stmt offsetAcc + let encDec = stmt |> Option.map EncDec |> Option.toList + let body = mkBlock (preAnnots @ encDec @ [postAnnots; rest]) + offsetAcc - sz, LetGhost {bdg = snap; e = Snapshot (Var cdc); body = body} let stmts = List.zip3 snapshots pg.children stmts |> List.indexed - List.foldBack wrap stmts ((pg.maxOffset enc) + thisMaxSize, rest) |> snd + List.foldBack annotate stmts ((pg.maxOffset enc) + thisMaxSize, rest) |> snd let generateSequenceChildProof (enc: Asn1Encoding) (stmts: string option list) (pg: SequenceProofGen) (codec: Codec): string list = - if stmts.IsEmpty then [] + if stmts.IsEmpty then stmts |> List.choose id else let codecTpe = runtimeCodecTypeFor enc - let cdc = {Var.name = $"codec"; tpe = RuntimeType (CodecClass codecTpe)} - let oldCdc = {Var.name = $"codec_0_1"; tpe = RuntimeType (CodecClass codecTpe)} - let snapshots = [1 .. pg.children.Length] |> List.map (fun i -> {Var.name = $"codec_{pg.nestingLevel}_{pg.nestingIx + bigint i}"; tpe = RuntimeType (CodecClass codecTpe)}) + 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 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)]) + Ghost (Check cond) + let expr = wrappedStmts (mkBlock [postCondLemmas]) + let exprStr = show (ExprTree expr) + [exprStr] + else + let expr = mkBlock (stmts |> List.choose id |> List.map EncDec) + let exprStr = show (ExprTree expr) + [exprStr] - let wrappedStmts = wrapEncDecStmts enc snapshots cdc oldCdc stmts pg codec - let postCondLemmas = - let cond = Leq (callBitIndex (Var cdc), Plus ((callBitIndex (Var snapshots.Head)), (IntLit (Long, pg.outerMaxSize enc)))) - Ghost (Check cond) - let expr = wrappedStmts (mkBlock [postCondLemmas]) - let exprStr = show 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 = + if sq.children.IsEmpty then None + else + let codecTpe = runtimeCodecTypeFor enc + let oldCdc = {Var.name = "oldCdc"; tpe = ClassType codecTpe} + let recv = + match codec with + | Encode -> SelectionExpr (joinedSelection sel) + | Decode -> SelectionExpr sel.asIdentifier + + // 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 + 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 = + 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)) + ]) + ]) + ]) + Some (Ghost (mkBlock (transitiveLemmas @ presenceBitsPrefixLemmaApps @ childrenPrefixLemmaApps @ [proof]))) + *) let generateSequenceOfLikeProof (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): SequenceOfLikeProofGenResult option = - let lvl = max 0I (pg.nestingLevel - 1I) - let nestingIx = pg.nestingIx + 1I + None - let nbItemsMin, nbItemsMax = sqf.nbElems enc - let accountForSize = - match enc, sqf with - | UPER, _ -> true - | ACN, SqOf sqf -> - match sqf.acnEncodingClass with - | SZ_EC_FIXED_SIZE | SZ_EC_LENGTH_EMBEDDED _ -> not sqf.isFixedSize // TODO: Check if we can have SZ_EC_FIXED_SIZE with not sqf.isFixedSize (copying logic from DAstACN) - | SZ_EC_ExternalField _ -> false // The external field is encoded/decoded as an ACN field, it therefore has the bitstream index offset already taken care of - | _ -> true - | ACN, StrType str -> - true // TODO - | _ -> failwith $"Unexpected encoding: {enc}" - - let sizeInBits = - if accountForSize then GetNumberOfBitsForNonNegativeInteger (nbItemsMax - nbItemsMin) - else 0I +let generateSequenceOfLikeAuxiliaries (enc: Asn1Encoding) (sqf: SequenceOfLike) (pg: SequenceOfLikeProofGen) (codec: Codec): FunDef list * Expr = + let sqfTpe = fromSequenceOfLike sqf + let elemTpe = fromSequenceOfLikeElemTpe sqf + let codecTpe = runtimeCodecTypeFor enc + let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} + let oldCdc = {Var.name = "oldCdc"; tpe = ClassType codecTpe} + let cdcBeforeLoop = {Var.name = $"codecBeforeLoop_{pg.nestingIx}"; tpe = ClassType codecTpe} + let cdcSnap1 = {Var.name = "codecSnap1"; tpe = ClassType codecTpe} + let cdcSnap2 = {Var.name = "codecSnap2"; tpe = ClassType codecTpe} + let from = {Var.name = pg.ixVariable; tpe = IntegerType Int} + let sqfVar = {Var.name = pg.cs.arg.asIdentifier; tpe = sqfTpe} + let count = {Var.name = "nCount"; tpe = IntegerType Int} + let outerSqf = + if enc = ACN || codec = Decode then Var sqfVar + else SelectionExpr (joinedSelection pg.cs.arg) + let td = + match sqf with + | SqOf sqf -> sqf.typeDef.[Scala].typeName + | StrType str -> str.typeDef.[Scala].typeName + + let callSizeRangeObj (ls: Expr) (offset: Expr) (from: Expr) (tto: Expr): Expr = + FunctionCall { + prefix = [td] + id = "sizeRange" + tps = [] + args = [ls; offset; from; tto] + } + + let fnid = + let prefix = pg.nestingScope.parents |> List.tryHead |> Option.map (fun (cs, _) -> $"{cs.arg.asIdentifier}_") |> Option.defaultValue "" + 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" + let nbItemsMin, nbItemsMax = sqf.nbElems enc let nbItems = - if sqf.isFixedSize then IntLit (Int, nbItemsMin) - else SelectionExpr $"{pg.sel}.nCount" // TODO: Not ideal... - let elemSz = sqf.maxElemSizeInBits enc - let elemSzExpr = IntLit (Long, elemSz) - let sqfMaxSizeInBits = sqf.maxSizeInBits enc - let offset = pg.maxOffset enc - let remainingBits = pg.outerMaxSize enc - sqfMaxSizeInBits - offset - let remainingBitsExpr = IntLit (Long, remainingBits) + if sqf.isFixedSize then int32lit nbItemsMin + else + if codec = Encode then + match sqf with + | SqOf _ -> FieldSelect (Var sqfVar, "nCount") + | StrType _ -> Var count + else Var count + let maxElemSz = sqf.maxElemSizeInBits enc - let codecTpe = runtimeCodecTypeFor enc - let cdc = {Var.name = $"codec"; tpe = RuntimeType (CodecClass codecTpe)} - // The codec snapshot before encoding/decoding the whole SequenceOf (i.e. snapshot before entering the while loop) - let cdcSnap = {Var.name = $"codec_{lvl}_{nestingIx}"; tpe = RuntimeType (CodecClass codecTpe)} - // The codec snapshot before encoding/decoding one item (snapshot local to the loop, taken before enc/dec one item) - let cdcLoopSnap = {Var.name = $"codecLoop_{lvl}_{nestingIx}"; tpe = RuntimeType (CodecClass codecTpe)} - let oldCdc = {Var.name = $"codec_0_1"; tpe = RuntimeType (CodecClass codecTpe)} - let ix = {name = pg.ixVariable; tpe = IntegerType Int} - let ixPlusOne = Plus (Var ix, IntLit (Int, 1I)) - - let preSerde = - LetGhost ({ - bdg = cdcLoopSnap - e = Snapshot (Var cdc) - body = Ghost (AppliedLemma { - lemma = ValidateOffsetBitsWeakeningLemma - args = [ - selBitStream (Var cdc); - Plus (remainingBitsExpr, Mult (elemSzExpr, Minus (nbItems, Var ix))) - elemSzExpr - ] - }) - }) + let fromBounds = And [Leq (int32lit 0I, Var from); Leq (Var from, nbItems)] + let validateOffset = + validateOffsetBitsACN (Var cdc) (Mult (longlit maxElemSz, Minus (nbItems, Var from))) + let decreasesExpr = Minus (nbItems, Var from) + + 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 postSerde = Ghost (mkBlock [ Check (Equals ( - Mult (elemSzExpr, Plus (Var ix, IntLit (Int, 1I))), - Plus (Mult (elemSzExpr, Var ix), elemSzExpr) + Mult (longlit maxElemSz, plus [Var from; int32lit 1I]), + plus [Mult (longlit maxElemSz, Var from); longlit maxElemSz] )) - Check (Leq ( - callBitIndex (Var cdc), - Plus (callBitIndex (Var cdcSnap), Plus (IntLit (Long, sizeInBits), Mult (elemSzExpr, ixPlusOne))) - )) - AppliedLemma { - lemma = ValidateOffsetBitsIneqLemma - args = [ - selBitStream (Var cdcLoopSnap) - selBitStream (Var cdc) - Plus (remainingBitsExpr, Mult (elemSzExpr, Minus (nbItems, Var ix))) - elemSzExpr - ] - } - Check (callValidateOffsetBits (Var cdc) (Plus (remainingBitsExpr, Mult (elemSzExpr, Minus (nbItems, ixPlusOne))))) + validateOffsetBitsIneqLemma (selBitStream (Var cdcSnap1)) (selBitStream (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])))) ]) - let invariants = - let bufInv = - if codec = Encode then - Equals (selBufLength (Var cdc), selBufLength (Var cdcSnap)) - else - Equals (selBuf (Var cdc), selBuf (Var cdcSnap)) - let cdcInv = callInvariant (Var cdc) - let boundsInv = - if sqf.isFixedSize then [] - else [And [Leq (IntLit (Int, nbItemsMin), nbItems); Leq (nbItems, (IntLit (Int, nbItemsMax)))]] - let bixInv = Leq ( - callBitIndex (Var cdc), - Plus (callBitIndex (Var cdcSnap), Plus (IntLit (Long, sizeInBits), Mult (elemSzExpr, Var ix))) - ) - let bixInvOldCdc = Leq ( - callBitIndex (Var cdc), - Plus (callBitIndex (Var oldCdc), Plus (IntLit (Long, offset + sizeInBits), Mult (elemSzExpr, Var ix))) + // TODO: ALIGNMENT + let sizeLemmaCall = + match sqf with + | SqOf _ -> Some (MethodCall {recv = outerSqf; id = sizeLemmaId None; args = [bitIndexACN (Var cdcBeforeLoop); bitIndexACN (Var oldCdc)]}) + | StrType _ -> None + + match codec with + | Encode -> + 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 checkRange = + match sqf with + | StrType _ -> + let elem = vecApply (Var sqfVar) (Var from) + [ + IfExpr { + cond = Not (And [Leq (ubytelit 0I, elem); Leq (elem, ubytelit 127I)]) + thn = Return (leftExpr (IntegerType Int) (IntegerType Int) (int32lit 1I)) + els = UnitLit + } + ] + | SqOf _ -> [] + let elseBody = + let reccallRes = {Var.name = "res"; tpe = fnRetTpe} + let sizeRangeProof = + match sqf with + | StrType _ -> [] + | SqOf sq -> + let selArr = FieldSelect (Var sqfVar, "arr") + let cIx = bitIndexACN (Var cdc) + let c1Ix = bitIndexACN (Var cdcSnap1) + let c2Ix = bitIndexACN (Var cdcSnap2) + let elemSz = asn1SizeExpr sq.child.acnAlignment sq.child.Kind (vecApply selArr (Var from)) c1Ix 0I 0I + let szRangeRec = callSizeRangeObj selArr c2Ix (plus [Var from; int32lit 1I]) nbItems + let szRangePost = callSizeRangeObj selArr c1Ix (Var from) nbItems + let proof = + letsIn elemSz.bdgs (mkBlock [ + Assert (Equals (cIx, plus [c2Ix; szRangeRec])) + Assert (Equals (c2Ix, plus [c1Ix; elemSz.resSize])) + Assert (Equals (szRangePost, plus [elemSz.resSize; szRangeRec])) + Check (Equals (cIx, plus [c1Ix; szRangePost])) + ]) + [Ghost (eitherMatchExpr (Var reccallRes) None UnitLit None proof)] + letsGhostIn [cdcSnap1, Snapshot (Var cdc)] ( + mkBlock ( + checkRange @ + preSerde :: + encDec @ + [letsGhostIn [cdcSnap2, Snapshot (Var cdc)] ( + mkBlock [ + postSerde + letsIn [reccallRes, reccall] (mkBlock ( + sizeRangeProof @ [Var reccallRes] + )) + ])] + )) + let body = IfExpr { + cond = Equals (Var from, nbItems) + thn = rightExpr (IntegerType Int) (IntegerType Int) (int32lit 0I) + els = elseBody + } + let postcondRes = {Var.name = "res"; tpe = fnRetTpe} + let postcond = + let oldCdc = Old (Var cdc) + let sz = + match sqf with + | 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 (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz]) + ] + eitherMatchExpr (Var postcondRes) None (BoolLit true) (Some postcondRes) rightBody + let invPrecond = + match sqf with + | SqOf sq when not sqf.isFixedSize -> + // These preconds are trivial since they come from the class invariant, it however helps the solver since it does not need to unfold the class invariant + let selArrSize = vecSize (FieldSelect (Var sqfVar, "arr")) + [Precond (And [Leq (int32lit sq.minSize.acn, nbItems); Leq (nbItems, selArrSize); Leq (selArrSize, int32lit sq.maxSize.acn)])] + | _ -> [] + let sizePrecond = + match sqf with + | StrType _ -> [Precond (Equals (vecSize (Var sqfVar), plus [nbItems; int32lit 1I]))] // +1 for the null terminator + | SqOf _ -> [] + let fd = { + FunDef.id = fnid + prms = [cdc] @ countParam @ [sqfVar; from] + annots = [Opaque; InlineOnce] + specs = if enc = ACN then [Precond fromBounds] @ invPrecond @ sizePrecond @ [Precond validateOffset; Measure decreasesExpr] else [] + postcond = if enc = ACN then Some (postcondRes, postcond) else None + returnTpe = fnRetTpe + body = body + } + + let call = + let count = + 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 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 + eitherMatchExpr scrut (Some leftBdg) leftBody None rightBody + let call = letsGhostIn [cdcBeforeLoop, Snapshot (Var cdc)] call + [fd], call + | Decode -> + let countParam = if sqf.isFixedSize then [] else [count] + let collTpe = ClassType (vecTpe elemTpe) + let fnRetTpe = ClassType (eitherMutTpe (IntegerType Int) collTpe) + let sqfVecVar = {Var.name = pg.cs.arg.asIdentifier; tpe = collTpe} + let thnCase = + let ret = + match sqf with + | SqOf _ -> Var sqfVecVar + | StrType _ -> vecAppend (Var sqfVecVar) (IntLit (UByte, 0I)) + mkBlock [ + Ghost (mkBlock [ + vecRangesEqReflexiveLemma ret + vecRangesEqSlicedLemma ret ret (int32lit 0I) (vecSize ret) (int32lit 0I) (Var from) + ]) + rightMutExpr (IntegerType Int) collTpe ret + ] + let elseCase = + let reccallRes = {Var.name = "res"; tpe = fnRetTpe} + let newVec = {Var.name = "newVec"; tpe = collTpe} + let decodedElemVar = {Var.name = $"{pg.cs.arg.asIdentifier}_arr_{pg.ixVariable}_"; tpe = elemTpe} + let appended = vecAppend (Var sqfVecVar) (Var decodedElemVar) + let postrecProofSuccess = mkBlock ([ + vecRangesAppendDropEq (Var sqfVecVar) (Var newVec) (Var decodedElemVar) (int32lit 0I) (Var from) + vecRangesEqImpliesEq appended (Var newVec) (int32lit 0I) (Var from) (plus [Var from; int32lit 1I]) + isnocIndex (vecList (Var sqfVecVar)) (Var decodedElemVar) (Var from) + 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 postrecProof = Ghost (eitherMutMatchExpr (Var reccallRes) None UnitLit (Some newVec) postrecProofSuccess) + mkBlock ((preSerde :: encDec) @ [ + letsGhostIn [cdcSnap2, Snapshot (Var cdc)] ( + mkBlock [ + postSerde + letsIn [reccallRes, reccall] (mkBlock [postrecProof; Var reccallRes]) + ])]) + let ite = IfExpr { + cond = Equals (Var from, nbItems) + thn = thnCase + els = elseCase + } + let body = letsGhostIn [cdcSnap1, Snapshot (Var cdc)] ite + let postcondRes = {Var.name = "res"; tpe = fnRetTpe} + let postcond = + let newVec = {Var.name = "newVec"; tpe = collTpe} + let oldCdc = Old (Var cdc) + let sz, nbEffectiveElems = + match sqf with + | 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 (vecSize (Var newVec), nbEffectiveElems) + vecRangesEq (Var sqfVecVar) (Var newVec) (int32lit 0I) (Var from) + Equals (bitIndexACN (Var cdc), plus [bitIndexACN oldCdc; sz]) + ]) + eitherMutMatchExpr (Var postcondRes) None (BoolLit true) (Some newVec) rightBody + let countPrecond = + match sqf with + | SqOf sq when not sqf.isFixedSize -> [Precond (And [Leq (int32lit sq.minSize.acn, Var count); Leq (Var count, int32lit sq.maxSize.acn)])] + | _ -> [] + let fd = { + FunDef.id = fnid + prms = [cdc] @ countParam @ [sqfVecVar; from] + annots = [Opaque; InlineOnce] + specs = if enc = ACN then countPrecond @ [Precond fromBounds; Precond (Equals (vecSize (Var sqfVecVar), (Var from))); Precond validateOffset; Measure decreasesExpr] else [] + postcond = if enc = ACN then Some (postcondRes, postcond) else None + returnTpe = fnRetTpe + body = body + } + let call = + 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 leftBdg = {Var.name = "l"; tpe = IntegerType Int} + // TODO: FIXME: the right type must be the outside type!!! + let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} + let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! + let rightBdg = {Var.name = "bdg"; tpe = collTpe} + let rightBody = + match sqf with + | SqOf _ -> + let ctor = ClassCtor {ct = {id = td; tps = []}; 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 + +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} + // 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 offsetInv = callValidateOffsetBits (Var cdc) (Plus (remainingBitsExpr, Mult (elemSzExpr, Minus (nbItems, Var ix)))) - [bufInv; cdcInv] @ boundsInv @ [bixInv; bixInvOldCdc; offsetInv] - - let postInc = - Ghost (mkBlock ( - Check (And [ - Leq (IntLit (Int, 0I), Var ix) - Leq (Var ix, nbItems) - ]) :: (invariants |> List.map Check))) - - Some { - preSerde = show preSerde - postSerde = show postSerde - postInc = show postInc - invariant = show (SplitAnd invariants) - } \ No newline at end of file + ] + 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 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 + ])) + + { + 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 + } + +let generateOptionalAuxiliaries (enc: Asn1Encoding) (soc: SequenceOptionalChild) (codec: Codec): FunDef list * Expr = + if soc.child.Optionality.IsNone then [], EncDec (soc.childBody soc.p soc.existVar) + else + //assert (codec = Encode || soc.existVar.IsSome) + let codecTpe = runtimeCodecTypeFor enc + let cdc = {Var.name = "codec"; tpe = ClassType codecTpe} + let oldCdc = {Var.name = $"oldCdc"; tpe = ClassType codecTpe} + let childAsn1Tpe = soc.child.Type.toAsn1AcnAst + let childTpe = fromAsn1TypeKind soc.child.Type.Kind.baseKind + let optChildTpe = ClassType (optionMutTpe childTpe) + let fnid, fnIdPure = + //let td = soc.sq.typeDef.[Scala].typeName + //let prefix = soc.nestingScope.parents |> List.tryHead |> Option.map (fun (cs, _) -> $"{cs.arg.asIdentifier}_") |> Option.defaultValue "" + let fnId = + match codec with + | Encode -> $"{ToC soc.child.Type.id.dropModule.AsString}_Optional_ACN_Encode" + | Decode -> $"{ToC soc.child.Type.id.dropModule.AsString}_Optional_ACN_Decode" + fnId, $"{ToC soc.child.Type.id.dropModule.AsString}_Optional_ACN_Decode_pure" + let errTpe = IntegerType Int + let validateOffsetBitCond = [Precond (validateOffsetBitsACN (Var cdc) (longlit childAsn1Tpe.acnMaxSizeInBits))] + 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}} + + match codec with + | Encode -> + let rightTpe = IntegerType Int + let fnRetTpe = ClassType (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 leftBdg = {Var.name = "l"; tpe = IntegerType Int} + let leftBody = Return (leftExpr errTpe rightTpe (Var leftBdg)) + eitherMatchExpr scrut (Some leftBdg) leftBody None (mkBlock []) + optionMutMatchExpr (Var childVar) (Some bdg) validCall UnitLit + ) |> Option.toList + let encDec = EncDec (soc.childBody {soc.p with arg = soc.p.arg.asLastOrSelf} None) + let resPostcond = {Var.name = "res"; tpe = fnRetTpe} + + let outermostPVal = {Var.name = "pVal"; tpe = fromAsn1TypeKind (soc.nestingScope.parents |> List.last |> snd).Kind} + 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 fd = { + FunDef.id = fnid + prms = [cdc; outermostPVal; childVar] + annots = [Opaque; InlineOnce] + specs = validateOffsetBitCond + postcond = Some (resPostcond, postcondExpr) + returnTpe = fnRetTpe + body = body + } + let call = + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc; Var outermostPVal; outerPVal]} + let leftBdg = {Var.name = "l"; tpe = errTpe} + // TODO: FIXME: the right type must be the outside type!!! + let leftHACK = ClassCtor {ct = {id = leftId; tps = []}; args = [Var leftBdg]} + let leftBody = Return leftHACK // (leftMutExpr errTpe tpe (Var leftBdg)) // TODO: Wrong tpe, it's the one outside!!! + eitherMatchExpr scrut (Some leftBdg) leftBody None UnitLit + [fd], call + | Decode -> + // The `existVar` does not exist for always present/absent + let existVar = soc.existVar |> Option.map (fun v -> {Var.name = v; tpe = BooleanType}) + 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 retVal = {Var.name = soc.p.arg.lastId; tpe = childTpe} + let retInnerFd = + let rightRet = rightMutExpr errTpe rightTpe (Var retVal) + match isValidFuncName with + | Some validFnName -> + let someBdg = {Var.name = "v"; tpe = childTpe} + let eitherPatmat = + let scrut = FunctionCall {prefix = []; id = validFnName; tps = []; args = [Var someBdg]} + let leftBdg = {Var.name = "l"; tpe = errTpe} + let leftBody = leftMutExpr errTpe rightTpe (Var leftBdg) + eitherMatchExpr scrut (Some leftBdg) leftBody None rightRet + optionMutMatchExpr (Var retVal) (Some someBdg) eitherPatmat rightRet + | None -> rightRet + + let resPostcond = {Var.name = "res"; tpe = fnRetTpe} + let resvalVar = {Var.name = "resVal"; tpe = childTpe} + let alwaysAbsentOrPresent = + match soc.child.Optionality with + | Some AlwaysPresent -> [isDefinedMutExpr (Var resvalVar)] + | Some AlwaysAbsent -> [Not (isDefinedMutExpr (Var resvalVar))] + | _ -> [] + 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]}) + optionMutMatchExpr (Var resvalVar) (Some someBdg) isRight (BoolLit true)) |> Option.toList + let postcondExpr = generateDecodePostcondExprCommon resPostcond resvalVar sz alwaysAbsentOrPresent cstrIsValid + let body = letsGhostIn [(oldCdc, Snapshot (Var cdc))] (mkBlock [encDec; retInnerFd]) + let acnParams = acnExternDependenciesVariableDecode soc.child.Type.toAsn1AcnAst soc.nestingScope + + let fd = { + FunDef.id = fnid + prms = [cdc] @ (existVar |> Option.toList) @ acnParams + annots = [Opaque; InlineOnce] + specs = validateOffsetBitCond + postcond = Some (resPostcond, postcondExpr) + returnTpe = fnRetTpe + body = body + } + + let call = + let scrut = FunctionCall {prefix = []; id = fd.id; tps = []; args = [Var cdc] @ (existVar |> Option.map Var |> Option.toList) @ (acnParams |> List.map Var)} + let leftBdg = {Var.name = "l"; tpe = errTpe} + // TODO: FIXME: the right type must be the outside type!!! + let leftHACK = ClassCtor {ct = {id = leftMutId; tps = []}; args = [Var leftBdg]} + 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 []) + + 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)}] + (mkTuple [Var varCpy; Var varRes])) + { + FunDef.id = fnIdPure + prms = [cdc] @ (existVar |> Option.toList) @ acnParams + annots = [GhostAnnot; Pure] + specs = validateOffsetBitCond + postcond = None + returnTpe = tupleType [ClassType codecTpe; fnRetTpe] + body = pureBody + } + let prefixLemma = generateOptionalPrefixLemma enc soc + [fd; fdPure], ret diff --git a/StgScala/acn_scala.stg b/StgScala/acn_scala.stg index ae5e3b100..872875aff 100644 --- a/StgScala/acn_scala.stg +++ b/StgScala/acn_scala.stg @@ -1,6 +1,6 @@ group scala_acn; -getStringSize(p) ::= "ULong.fromRaw(

.indexOf(0x00.toRawUByte))" +getStringSize(p) ::= "ULong.fromRaw(

.indexOfOrLength(0x00.toRawUByte))" getSizeableSize(p, sAcc, bIsUnsigned) ::= << @@ -33,6 +33,7 @@ def (@annotation.unused () match case Left(l) => return Left(l) case Right(_) => + @ghost val oldCdc = snapshot(codec) @@ -54,6 +55,7 @@ def (@annotation.unused codec: ACN): Ei )}; separator="\n"> }; separator="\n"> + @ghost val oldCdc = snapshot(codec) @@ -100,8 +102,7 @@ locally { codec.base.bitStream.alignTo() ghostExpr { BitStream.validateOffsetBitsIneqLemma(unalignedCodec.base.bitStream, codec.base.bitStream, , 7L) - check(codec.base.bitStream.bitIndex \<= codec_0_1.base.bitStream.bitIndex + L + 7L) - check(codec.base.bitStream.bitIndex \<= codec__.base.bitStream.bitIndex + L + 7L) + check(codec.base.bitStream.bitIndex \<= oldCdc.base.bitStream.bitIndex + L + 7L) } } @@ -113,8 +114,7 @@ locally { codec.base.bitStream.alignTo() ghostExpr { BitStream.validateOffsetBitsIneqLemma(unalignedCodec.base.bitStream, codec.base.bitStream, , 7L) - check(codec.base.bitStream.bitIndex \<= codec_0_1.base.bitStream.bitIndex + L + 7L) - check(codec.base.bitStream.bitIndex \<= codec__.base.bitStream.bitIndex + L + 7L) + check(codec.base.bitStream.bitIndex \<= oldCdc.base.bitStream.bitIndex + L + 7L) } } @@ -450,11 +450,11 @@ val

= codec.dec_String_Ascii_FixSize() >> Acn_String_Ascii_Null_Terminated_encode(p, sErrCode, nAsn1Max, arruNullBytes) ::= << -codec.enc_String_Ascii_Null_Terminated_mult(, Array({}), ,

) +codec.enc_String_Ascii_Null_Terminated_multVec(, Array({}), ,

) >> Acn_String_Ascii_Null_Terminated_decode(p, sErrCode, nAsn1Max, arruNullBytes) ::= << -val

= codec.dec_String_Ascii_Null_Terminated_mult(, Array({}), ) +val

= codec.dec_String_Ascii_Null_Terminated_multVec(, Array({}), ) >> Acn_String_Ascii_External_Field_Determinant_encode(p, sErrCode, nAsn1Max, sExtFld) ::= "codec.enc_String_Ascii_External_Field_Determinant(,

)" @@ -498,8 +498,8 @@ val

= codec.dec_String_CharIndex_External_Field_Determinant(, allo Acn_IA5String_CharIndex_External_Field_Determinant_encode(p, sErrCode, nAsn1Max, sExtFld, td/*:FE_StringTypeDefinition*/, nCharSize, nRemainingBits) ::= << locally { val bix = codec.base.bitStream.bitIndex - codec.enc_IA5String_CharIndex_External_Field_Determinant(,

) - if codec.base.bitStream.bitIndex > bix + L * L then + codec.enc_IA5String_CharIndex_External_Field_DeterminantVec(,

) + if codec.base.bitStream.bitIndex > bix + L * L || codec.base.bitStream.bitIndex != bix + 7L *

.indexOfOrLength(UByte.fromRaw(0.toByte)) then return Left(461) } >> @@ -509,8 +509,8 @@ val

= locally { val bix = codec.base.bitStream.bitIndex if .toRaw \< 0L then return LeftMut(464) - val

= codec.dec_IA5String_CharIndex_External_Field_Determinant(, .toRaw) - if codec.base.bitStream.bitIndex > bix + L * L then + val

= codec.dec_IA5String_CharIndex_External_Field_DeterminantVec(, .toRaw) + if codec.base.bitStream.bitIndex > bix + L * L || codec.base.bitStream.bitIndex != bix + 7L *

.indexOfOrLength(UByte.fromRaw(0.toByte)) then return LeftMut(470)

} @@ -518,107 +518,114 @@ val

= locally { oct_external_field_encode(sTypedefName, p, sAcc, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode) ::= << -codec.base.encodeOctetString_no_length(

arr,

nCount.toInt) +codec.base.encodeOctetString_no_length_vec(

arr,

nCount.toInt) >> oct_external_field_decode(sTypedefName, p, sAcc, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode) ::= << val

= if ((ULong.fromRaw() \<= ) && ( \<= ULong.fromRaw())) then - (.toRaw.toInt, codec.base.decodeOctetString_no_length(.toRaw.toInt)) + (.toRaw.toInt, codec.base.decodeOctetString_no_length_vec(.toRaw.toInt)) else return LeftMut() >> oct_external_field_fix_size_encode(sTypedefName, p, sAcc, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode) ::= << -codec.base.encodeOctetString_no_length(

arr, ) +codec.base.encodeOctetString_no_length_vec(

arr, ) >> oct_external_field_fix_size_decode(sTypedefName, p, sAcc, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode) ::= << val

= if ((ULong.fromRaw() \<= ) && ( \<= ULong.fromRaw())) then - (codec.base.decodeOctetString_no_length()) + (codec.base.decodeOctetString_no_length_vec()) else return LeftMut() >> +seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << + +@ghost val codec_0_1 = snapshot(codec) + -sqf_external_field_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +locally { + @ghost val oldCodec = snapshot(codec) + codec.base.encodeConstrainedWholeNumber(

nCount, , ) + ghostExpr { + @opaque @inlineOnce + def bitCountLemma(): Unit = ().ensuring(_ => GetBitCountUnsigned(ULong.fromRaw() - ULong.fromRaw()) == ) + bitCountLemma() + assert(codec.base.bitStream.bitIndex \<= oldCodec.base.bitStream.bitIndex + L) + BitStream.validateOffsetBitsIneqLemma(oldCodec.base.bitStream, codec.base.bitStream, , L) + check(codec.base.bitStream.bitIndex \<= codec_0_1.base.bitStream.bitIndex + L + L) + //check(codec.base.bitStream.bitIndex \<= codec__.base.bitStream.bitIndex + L + L) + } +} + +>> + +seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << @ghost val codec_0_1 = snapshot(codec) - = 0 -(while( \<

.nCount.toInt) { - decreases(

.nCount.toInt - ) - - - - += 1 - -}).opaque.inline.noReturnInvariant(0 \<= && \<=

.nCount.toInt && ) +val

_nCount = locally { + @ghost val oldCodec = snapshot(codec) + val

_nCount = codec.base.decodeConstrainedWholeNumber(, ).toInt + ghostExpr { + @opaque @inlineOnce + def bitCountLemma(): Unit = ().ensuring(_ => GetBitCountUnsigned(ULong.fromRaw() - ULong.fromRaw()) == ) + bitCountLemma() + assert(codec.base.bitStream.bitIndex \<= oldCodec.base.bitStream.bitIndex + L) + BitStream.validateOffsetBitsIneqLemma(oldCodec.base.bitStream, codec.base.bitStream, , L) + check(codec.base.bitStream.bitIndex \<= codec_0_1.base.bitStream.bitIndex + L + L) + //check(codec.base.bitStream.bitIndex \<= codec__.base.bitStream.bitIndex + L + L) + } +

_nCount +} + +>> + +sqf_external_field_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << + +@ghost val codec_0_1 = snapshot(codec) + + + >> -sqf_external_field_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << @ghost val codec_0_1 = snapshot(codec) val

= if ((ULong.fromRaw() \<= ) && ( \<= ULong.fromRaw())) then - val

= (.toRaw.toInt, Array.fill(.toRaw.toInt)()) - @ghost val

_snap = snapshot(

) - = 0 - (while( \<

.nCount.toInt) { - decreases(

.nCount.toInt - ) - - - - += 1 - - }).opaque.inline.noReturnInvariant(0 \<= && \<=

.nCount.toInt &&

_snap.arr.length ==

.arr.length && ) + val

_nCount = .toRaw.toInt +

else return LeftMut() >> -sqf_external_field_fix_size_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_fix_size_encode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << @ghost val codec_0_1 = snapshot(codec) - = 0 -(while( \< .toInt) { - decreases(.toInt - ) - - - - += 1 - -}).opaque.inline.noReturnInvariant(0 \<= && \<= .toInt && ) + >> -sqf_external_field_fix_size_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +sqf_external_field_fix_size_decode(sTypeDefName, p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, sExtFld, bIsUnsigned, nAlignSize, sErrCode, nIntItemMinSize, nIntItemMaxSize, sChildInitExpr, bIntroSnap, soCallAux) ::= << @ghost val codec_0_1 = snapshot(codec) val

= if ((ULong.fromRaw() \<= ) && ( \<= ULong.fromRaw())) then - val

= (Array.fill(.toRaw.toInt)()) - @ghost val

_snap = snapshot(

) - = 0 - (while( \< .toInt) { - decreases(.toInt - ) - - - - += 1 - - }).opaque.inline.noReturnInvariant(0 \<= && \<= .toInt &&

_snap.arr.length ==

.arr.length && ) +

else return LeftMut() >> oct_sqf_null_terminated_encode(p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, arruNullBytes, nBitPatternLength, sErrCode, nIntItemMinSize, nIntItemMaxSize) ::= << -codec.base.bitStream.appendBitsMSBFirst(Array({}), ) +codec.base.bitStream.appendBitsMSBFirstVec(Array({}), ) >> oct_sqf_null_terminated_decode(p, sAcc, i, sInternalItem, noSizeMin, nSizeMax, arruNullBytes, nBitPatternLength, sErrCode, nIntItemMinSize, nIntItemMaxSize) ::= << @@ -641,7 +648,7 @@ else if checkBitPatternPresentResult.get then >> bit_string_external_field_encode(sTypeDefName, p, sErrCode, sAcc, noSizeMin, nSizeMax, sExtFld) ::= << -codec.base.bitStream.appendBitsMSBFirst(

arr,

nCount) +codec.base.bitStream.appendBitsMSBFirstVec(

arr,

nCount) >> bit_string_external_field_decode(sTypeDefName, p, sErrCode, sAcc, noSizeMin, nSizeMax, sExtFld) ::= << @@ -652,7 +659,7 @@ val

= >> bit_string_external_field_fixed_size_encode(sTypeDefName, p, sErrCode, sAcc, noSizeMin, nSizeMax, sExtFld) ::= << -codec.base.bitStream.appendBitsMSBFirst(

arr, ) +codec.base.bitStream.appendBitsMSBFirstVec(

arr, ) >> bit_string_external_field_fixed_size_decode(sTypeDefName, p, sErrCode, sAcc, noSizeMin, nSizeMax, sExtFld) ::= << @@ -663,7 +670,7 @@ val

= >> bit_string_null_terminated_encode(sTypeDefName, p, sErrCode, sAcc, i, noSizeMin, nSizeMax, arruNullBytes, nBitPatternLength) ::= << -codec.base.bitStream.appendBitsMSBFirst(

arr,

arr.length*8) // TODO: re-introduce nCount? -> codec.base.bitStream.appendBitsMSBFirst(

arr,

nCount) +codec.base.bitStream.appendBitsMSBFirstVec(

arr,

arr.length*8) // TODO: re-introduce nCount? -> codec.base.bitStream.appendBitsMSBFirst(

arr,

nCount) codec.base.bitStream.appendBitsMSBFirst(Array({}), ) >> @@ -758,21 +765,21 @@ sequence_mandatory_child_decode(sChName, sChildContent, soSaveBitStrmPosStatemen >> -sequence_always_present_child_encode(p, sAcc, sChName, soChildContent, soChildExpr, soSaveBitStrmPosStatement) ::= << +sequence_always_present_child_encode(p, sAcc, sChName, soChildContent, soChildExpr, sChildTypedef, soSaveBitStrmPosStatement) ::= << /* Encode */ /* marked as ALWAYS PRESENT, so it must be Some */ -

match +

match case SomeMut() => case NoneMut() => return Left(628) >> -sequence_always_present_child_decode(p, sAcc, sChName, soChildContent, soChildExpr, soSaveBitStrmPosStatement) ::= << +sequence_always_present_child_decode(p, sAcc, sChName, soChildContent, soChildExpr, sChildTypedef, soSaveBitStrmPosStatement) ::= << /* Decode */ /* marked as ALWAYS PRESENT */ -val

_ = +val

: OptionMut[] = SomeMut() >> @@ -786,13 +793,13 @@ sequence_always_absent_child_decode(p, sAcc, sChName, sChildContent, sChildTyped /* Decode */ /* marked as ALWAYS ABSENT, so do not decode anything */ -val

_ = NoneMut[]() +val

: OptionMut[] = NoneMut[]() >> sequence_optional_child_encode(p, sAcc, sChName, sChildContent, soExistVar, soChildExpr, sChildTypedef, soSaveBitStrmPosStatement) ::= << /* Encode */ -

match +

match case SomeMut() => case NoneMut() => @@ -801,7 +808,7 @@ sequence_optional_child_encode(p, sAcc, sChName, sChildContent, soExistVar, soCh sequence_optional_child_decode(p, sAcc, sChName, sChildContent, soExistVar, soChildExpr, sChildTypedef, soSaveBitStrmPosStatement) ::= << /* Decode */ -val

_: OptionMut[] = +val

: OptionMut[] = if then SomeMut() @@ -881,7 +888,7 @@ case () => ChoiceChild_preWhen_bool_condition(sExtFld) ::= "" ChoiceChild_preWhen_int_condition(sExtFld, sVal) ::= "( == )" ChoiceChild_preWhen_str_condition(sExtFld, sVal, arrsNullChars, arruVal) ::= << -(.sameElements(Array[UByte]()}; separator=", ">))) +(.sameElements(Vector.fromList(List[UByte]()}; separator=", ">)))) >> ChoiceChild_preWhen_decode(p, sAcc, sChildID, sChildBody, arrsConditions, bFirst, sChildName, sChildTypeDef, sChoiceTypeName, sChildInitExpr) ::= << @@ -966,7 +973,7 @@ case _: => ChoiceDependencyStrPres_child(v, sChildNamePresent, sChildRetVal, arruChildRetValBytes, arrsNullChars) ::= << case _: => - Array(.toByte}; separator=", ">) + Vector.fromList(List()}; separator=", ">)) >> ChoiceDependencyPres(v, sChPath, sAcc, arrsChoiceItems) ::= << @@ -1047,7 +1054,7 @@ SizeDependency_oct_str_containing(p, sFuncName, sReqBytesForUperEncoding, v, bIs >> octet_string_containing_ext_field_func_encode(p, sFuncName, sReqBytesForUperEncoding, sExtField, sErrCode, soInner) ::= << -codec.base.encodeOctetString_no_length(arr, .toInt) +codec.base.encodeOctetString_no_length_vec(arr, .toInt) >> octet_string_containing_ext_field_func_decode(p, sFuncName, sReqBytesForUperEncoding, sExtField, sErrCode, soInner) ::= << @@ -1058,7 +1065,7 @@ octet_string_containing_ext_field_func_decode(p, sFuncName, sReqBytesForUperEnco val bitStrm: BitStream = BitStream_Init() if .toInt \<= then - codec.base.decodeOctetString_no_length(.toInt) match + codec.base.decodeOctetString_no_length_vec(.toInt) match case NoneMut() => return LeftMut() case SomeMut(arr) => @@ -1071,7 +1078,7 @@ octet_string_containing_ext_field_func_decode(p, sFuncName, sReqBytesForUperEnco >> bit_string_containing_ext_field_func_encode(p, sFuncName, sReqBytesForUperEncoding, sReqBitsForUperEncoding, sExtField, sErrCode) ::= << -codec.base.bitStream.appendBitsMSBFirst(arr, .toInt) +codec.base.bitStream.appendBitsMSBFirstVec(arr, .toInt) >> bit_string_containing_ext_field_func_decode(p, sFuncName, sReqBytesForUperEncoding, sReqBitsForUperEncoding, sExtField, sErrCode) ::= << diff --git a/StgScala/body_scala.stg b/StgScala/body_scala.stg index 7c27a8a09..da6a4cdca 100644 --- a/StgScala/body_scala.stg +++ b/StgScala/body_scala.stg @@ -11,6 +11,7 @@ package asn1src import asn1scala._ import stainless.lang.{ghost => ghostExpr, _} import stainless.annotation._ +import stainless.collection._ import stainless.proof._ import StaticChecks._ diff --git a/StgScala/equal_scala.stg b/StgScala/equal_scala.stg index 2f9333580..627818a37 100644 --- a/StgScala/equal_scala.stg +++ b/StgScala/equal_scala.stg @@ -78,7 +78,12 @@ def (: , : ): Boole isEqual_Primitive(p1, p2) ::= " == " -isEqual_String(p1, p2) ::= ".sameElements()" +isEqual_String(p1, p2) ::= << +locally { + val zero = .indexOfOrLength(UByte.fromRaw(0)) + .toScala.slice(0, zero).sameElements(.toScala.slice(0, zero)) +} +>> isEqual_Integer(p1, p2) /*nogen*/::= "ret = ( == )" @@ -90,7 +95,12 @@ isEqual_Boolean(p1, p2) /*nogen*/::= "ret = ( ( && ) || (! && !) isEqual_Real(p1, p2) ::= "Asn1Real_Equal(, )" -isEqual_IA5String(p1, p2) /*nogen*/::= "ret = .sameElements()" +isEqual_IA5String(p1, p2) /*nogen*/::= << +locally { + val zero = .indexOfOrLength(UByte.fromRaw(0)) + ret = .toScala.slice(0, zero).sameElements(.toScala.slice(0, zero)) +} +>> isEqual_NumericString(p1, p2) /*nogen*/::= "" isEqual_NullType()/*nogen*/ ::= "ret = true" @@ -98,11 +108,11 @@ isEqual_NullType()/*nogen*/ ::= "ret = true" isEqual_BitString(p1,p2,bIsFixedSize, nFixedSize) ::= << (nCount == nCount) && - (arr.slice(0,(nCount/8).toInt).sameElements(arr.slice(0,(nCount/8).toInt))) && + (arr.toScala.slice(0,(nCount/8).toInt).sameElements(arr.toScala.slice(0,(nCount/8).toInt))) && (if nCount % 8 > 0 then (arr(nCount.toInt/8).toRaw \>> (8-nCount % 8).toInt == arr(nCount.toInt/8).toRaw \>> (8-nCount % 8).toInt) else true) - (arr.slice(0,/8).sameElements(arr.slice(0,/8))) && + (arr.toScala.slice(0,/8).sameElements(arr.toScala.slice(0,/8))) && (if ( % 8) > 0 then (arr(/8).toRaw \>> (8- % 8).toInt == arr(/8).toRaw \>> (8- % 8).toInt) else true) @@ -112,9 +122,9 @@ isEqual_BitString(p1,p2,bIsFixedSize, nFixedSize) ::= << isEqual_OctetString(p1,p2, bIsFixedSize, nFixedSize) ::= << - (nCount == nCount) && (arr.slice(0, nCount.toInt).sameElements(arr.slice(0, nCount.toInt))) + (nCount == nCount) && (arr.toScala.slice(0, nCount.toInt).sameElements(arr.toScala.slice(0, nCount.toInt))) - arr.sameElements(arr) + arr.toScala.sameElements(arr.toScala) >> diff --git a/StgScala/header_scala.stg b/StgScala/header_scala.stg index 1696096c6..5eb00b22c 100644 --- a/StgScala/header_scala.stg +++ b/StgScala/header_scala.stg @@ -15,6 +15,9 @@ package asn1src import asn1scala._ import stainless.lang._ import stainless.annotation._ +import stainless.collection._ +import stainless.proof._ +import StaticChecks._ }; separator="\n"> @@ -133,7 +136,7 @@ Define_subType_enumerated_private(td/*:FE_EnumeratedTypeDefinition*/, prTd/*:FE_ /*********************************** STRING ************************************************************/ Define_new_ia5string(td/*:FE_StringTypeDefinition*/, nMin, nMax, nCMax, arrnAlphaChars) ::= << -type = Array[UByte] +type = Vector[UByte] >> Define_subType_ia5string(td/*:FE_StringTypeDefinition*/, prTd/*:FE_StringTypeDefinition*/, soParentTypePackage) ::= << @@ -142,14 +145,14 @@ typedef /*********************************** OCTET STRING ************************************************************/ -Define_new_octet_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize) ::= << +Define_new_octet_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, arrsInvariants) ::= << /*nCount equals to Number of bytes in the array. Max value is : (unsure - TODO read asn1 standard)*/ -case class (var nCount: Long, arr: Array[UByte]) +case class (nCount: Long, arr: Vector[UByte]) { - require(arr.length \<=== && 0 \<= nCount && nCount \<= arr.length) + } >> @@ -163,16 +166,16 @@ Define_new_bit_string_named_bit(td/*:FE_SizeableTypeDefinition*/, sTargetLangBit #define _ 0x /**/ >> -Define_new_bit_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, nMaxOctets, arrsNamedBits) ::= << +Define_new_bit_string(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, nMaxOctets, arrsNamedBits, arrsInvariants) ::= << }; separator="\n"> /*nCount equals to Number of bits in the array. Max value is : */ -case class (var nCount: Long, arr: Array[UByte]) +case class (nCount: Long, arr: Vector[UByte]) { - require(arr.length \<=== && 0 \<= nCount && nCount \<= arr.length.toLong * 8L) + } >> @@ -183,13 +186,18 @@ typedef /*********************************** SEQUENCE OF ************************************************************/ -Define_new_sequence_of(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, sChildType, soChildDefinition) ::= << +Define_new_sequence_of(td/*:FE_SizeableTypeDefinition*/, nMin, nMax, bFixedSize, sChildType, soChildDefinition, arrsSizeClassDefinition, arrsSizeObjDefinition, arrsInvariants) ::= << -case class (var nCount: Int, arr: Array[]) +case class (nCount: Int, arr: Vector[]) { - require(arr.length \<=== && 0 \<= nCount && nCount \<= arr.length) + + + +} +object { + } >> @@ -215,26 +223,38 @@ Define_new_sequence_child(sName, sType, bIsOptional) ::= << Define_new_sequence_save_pos_child(td/*:FE_SequenceTypeDefinition*/, sName, nMaxBytesInACN) ::= "BitStream ;" -Define_new_sequence(td/*:FE_SequenceTypeDefinition*/, arrsChildren, arrsOptionalChildren, arrsChildrenDefinitions, arrsNullFieldsSavePos) ::= << +Define_new_sequence(td/*:FE_SequenceTypeDefinition*/, arrsChildren, arrsOptionalChildren, arrsChildrenDefinitions, arrsNullFieldsSavePos, arrsSizeDefinition, arrsInvariants) ::= << /*-- --------------------------------------------*/ case class ( -) +) { + + + +} case class ( + }; separator=", \n"> +) { + - }; separator=", \n"> -) + +} >> -Define_subType_sequence(td/*:FE_SequenceTypeDefinition*/, prTd/*:FE_SequenceTypeDefinition*/, soParentTypePackage, arrsOptionalChildren) ::= << +Define_subType_sequence(td/*:FE_SequenceTypeDefinition*/, prTd/*:FE_SequenceTypeDefinition*/, soParentTypePackage, arrsOptionalChildren, arrsExtraDefs) ::= << type = + +object { + +} + type = @@ -247,12 +267,14 @@ Define_new_choice_child(sName, sType, sPresent) ::=<< : >> -Define_new_choice(td/*:FE_ChoiceTypeDefinition*/, sChoiceIDForNone, sFirstChildNamePresent, arrsChildren, arrsPresent, arrsCombined, nIndexMax, arrsChildrenDefinitions) ::= << +Define_new_choice(td/*:FE_ChoiceTypeDefinition*/, sChoiceIDForNone, sFirstChildNamePresent, arrsChildren, arrsPresent, arrsCombined, nIndexMax, arrsChildrenDefinitions, arrsSizeDefinition) ::= << /*-- --------------------------------------------*/ enum : }; separator="\n"> + + >> Define_subType_choice(td/*:FE_ChoiceTypeDefinition*/, prTd/*:FE_ChoiceTypeDefinition*/, soParentTypePackage) ::= << diff --git a/StgScala/init_scala.stg b/StgScala/init_scala.stg index fda4c7889..23c7bc0cd 100644 --- a/StgScala/init_scala.stg +++ b/StgScala/init_scala.stg @@ -11,25 +11,25 @@ initTypeAssignment(sVarName, sPtrPrefix, sPtrSuffix, sFuncName, sTypeDefName, sC def (): = >> -initInteger(sVal, sValue, bIsOptional) ::= << +initInteger(sVal, sValue, bIsOptional, sResVar) ::= << - = SomeMut() +val = SomeMut() - = +val = >> -initReal(sVal, dValue, bIsOptional) ::= << +initReal(sVal, dValue, bIsOptional, sResVar) ::= << - = SomeMut() +val = SomeMut() - = +val = >> -initBoolean(sVal, bValue, bIsOptional) ::= << +initBoolean(sVal, bValue, bIsOptional, sResVar) ::= << - = SomeMut(truefalse) +val = SomeMut(truefalse) - = truefalse +val = truefalse >> @@ -89,51 +89,42 @@ assignAny(p, sValue, sTypeDecl) ::= "

= " assignString(p, sValue) ::= "

= " -initIA5String(sPtr, sValue, bIsOptional) ::= << +initIA5String(sPtr, sValue, bIsOptional, sResVar) ::= << - = SomeMut() +val = SomeMut() - = +val = >> -initEnumerated(sVal, sValue, bIsOptional) ::= << +initEnumerated(sVal, sValue, sTypeDefName, bIsOptional, sResVar) ::= << - = SomeMut() +val : OptionMut[] = SomeMut() - = +val : = >> -initNull(sVal, bIsOptional) ::= << +initNull(sVal, bIsOptional, sResVar) ::= << - = SomeMut(0) +val : OptionMut[NullType] = SomeMut(0) - = 0 +val : NullType = 0 >> -initTestCaseIA5String(p, sAcc, nSize, nMaxSizePlusOne, i, td/*:FE_StringTypeDefinition*/, bAlpha, arrnAlphabetAsciiCodes, nAlphabetLength, bZero) ::= << +initTestCaseIA5String(p, sAcc, nSize, nMaxSizePlusOne, i, td/*:FE_StringTypeDefinition*/, bAlpha, arrnAlphabetAsciiCodes, nAlphabetLength, bZero, sResVar) ::= << -

= Array.fill()(0.toRawUByte) - +val = Vector.fill()(UByte.fromRaw(0)) - - = 0 -

= Array.fill()(0.toRawUByte) -while ( \< ) { - - val allowedCharSet: Array[UByte] = Array(.toRawUByte}; wrap, anchor, separator=",">) - -

() = allowedCharSet( % ) - - -

() = (if % 128 == 0 then 'A'.toByte.toRawUByte else ( % 128).toByte.toRawUByte) // TODO: what is done here? - - - = + 1 -} - + +val allowedCharSet: Array[UByte] = Array(.toRawUByte}; wrap, anchor, separator=",">) +val _tmp = scala.collection.immutable.Vector.tabulate()( => if == - 1 then UByte.fromRaw(0) else allowedCharSet( % )) +val = Vector.fromScala(_tmp :+ UByte.fromRaw(0)) + +val _tmp = scala.collection.immutable.Vector.tabulate()( => UByte.fromRaw(if == - 1 then 0.toByte else if % 128 == 0 then 'A'.toByte else ( % 128).toByte)) +val = Vector.fromScala(_tmp :+ UByte.fromRaw(0)) + >> @@ -151,33 +142,25 @@ initFixVarSizeBitOrOctString(p, sAcc, nSize, arrsBytes) ::= << >> -initTestCaseOctetString(p, sAcc, sArrayHolderName, nSize, i, bIsFixedSize, bZero, nMinSize, bZeroSizedArray) ::= << +initTestCaseOctetString(p, sAcc, sArrayHolderName, nSize, i, bIsFixedSize, bZero, nMinSize, bZeroSizedArray, sResVar) ::= << -

= (, Array.fill()(0.toRawUByte)) +val = (, Vector.fill()(0.toRawUByte)) - = 0 -(while (\< ) { -

.arr() = (%256).toByte.toRawUByte - += 1 -}) +val _tmp = scala.collection.immutable.Vector.tabulate()( => UByte.fromRaw(( % 256).toByte)) +val = (, Vector.fromScala(_tmp)) - -

nCount = >> -initTestCaseBitString(p, sAcc, sArrayHolderName, nSize, nSizeCeiled, i, bIsFixedSize, bZero, nMinSize, bIsOptionalField) ::= << +initTestCaseBitString(p, sAcc, sArrayHolderName, nSize, nSizeCeiled, i, bIsFixedSize, bZero, nMinSize, bIsOptionalField, sResVar) ::= << -

= (, Array.fill(/8)(0.toRawUByte) - +val = (, Vector.fill(/8)(0.toRawUByte)) - -

nCount = - = 0 -while (\< /8 &&

isDefined) { -

getarr() = 0x55.toRawUByte /* --> 0101 0101 as in Ada*/ - = + 1 -} + +val : OptionMut[] = SomeMut((, Vector.fill( / 8)(UByte.fromRaw(0x55)))) + +val = (, Vector.fill( / 8)(UByte.fromRaw(0x55))) + >> @@ -200,18 +183,17 @@ initVarSizeSequenceOf(p, sAcc, nSize, arrsInnerValues) ::= << >> -initTestCaseSizeSequenceOf_innerItem(bFirst, bLastItem, nCaseIdx, sChildCaseInit, i, nCaseLen) ::= << +initTestCaseSizeSequenceOf_innerItem(bFirst, bLastItem, nCaseIdx, sChildCaseInit, i, nCaseLen, sResVar) ::= << ifelse if ( % == ) {else { + }>> -initTestCaseSizeSequenceOf(p, sAcc, noMinSize, nSize, bIsFixedSize, arrsInnerItems, bMultiCases, i) ::= << - = 0 -while ( \< ) { +initTestCaseSizeSequenceOf(p, sAcc, sArrayHolderName, noMinSize, nSize, bIsFixedSize, arrsInnerItems, bMultiCases, i, sResVar) ::= << +val _vec = scala.collection.immutable.Vector.tabulate() { => - = + 1 } -

nCount = +val = (, Vector.fromScala(_vec)) >> @@ -229,15 +211,11 @@ initSequence(arrsInnerValues) ::= << initSequence_emptySeq(p) ::= "" initTestCase_sequence_child(p, sAcc, sChName, sChildContent, bOptional, sInitExpr) ::= << - -

= SomeMut() - - >> -initTestCase_sequence_child_opt(p, sAcc, sChName) ::= << -

= NoneMut() +initTestCase_sequence_child_opt(p, sAcc, sChName, sChildTypedef, sResVar) ::= << +val : OptionMut[] = NoneMut() >> initChoice(p, sAcc, sChildContent, sChildID, sChildName, sChildTypeName, sChoiceTypeName, sChildTempVarName, sChildTempDefaultInit, bComponentTempInit) ::= << @@ -246,13 +224,12 @@ var : =

= () >> -initTestCase_choice_child(p, sAcc, sChildContent, sChildID, sChildName, sChildTypeName, sChoiceTypeName, sChildTempVarName, sChildTempDefaultInit, bIsOptional) ::= << -var : = +initTestCase_choice_child(p, sAcc, sChildContent, sChildID, sChildName, sChildTypeName, sChoiceTypeName, sChildTempVarName, sChildTempDefaultInit, bIsOptional, sResVar) ::= << -

= SomeMut(()) +val = SomeMut(()) -

= () +val = () >> @@ -280,14 +257,14 @@ initTypeConstant_body(sTypeDecl, sConstantName, sValue) ::= << val : = >> -initFixSizeOctetString(sTypeDefName, nMax, bZeroSizedArray) ::= "(Array.fill()(0.toRawUByte))" -initVarSizeOctetString(sTypeDefName, nMin, nMax) ::= "(, Array.fill()(0.toRawUByte))" +initFixSizeOctetString(sTypeDefName, nMax, bZeroSizedArray) ::= "(Vector.fill()(0.toRawUByte))" +initVarSizeOctetString(sTypeDefName, nMin, nMax) ::= "(, Vector.fill()(0.toRawUByte))" -initFixSizeBitString(sTypeDefName, nMax, nMaxOctets) ::= "(Array.fill()(0.toRawUByte))" -initVarSizeBitString(sTypeDefName, nMin, nMax, nMaxOctets) ::= "(, Array.fill()(0.toRawUByte))" +initFixSizeBitString(sTypeDefName, nMax, nMaxOctets) ::= "(Vector.fill()(0.toRawUByte))" +initVarSizeBitString(sTypeDefName, nMin, nMax, nMaxOctets) ::= "(, Vector.fill()(0.toRawUByte))" -initFixSizeSequenceOfExpr(sTypeDefName, nMax, sChildExp) ::= "(Array.fill()())" -initVarSizeSequenceOfExpr(sTypeDefName, nMin, nMax, sChildExp) ::= "(, Array.fill()())" +initFixSizeSequenceOfExpr(sTypeDefName, nMax, sChildExp) ::= "(Vector.fill()())" +initVarSizeSequenceOfExpr(sTypeDefName, nMin, nMax, sChildExp) ::= "(, Vector.fill()())" initObjectIdentifierAsExpr() ::= << diff --git a/StgScala/isvalid_scala.stg b/StgScala/isvalid_scala.stg index dcad543fa..e6062b18d 100644 --- a/StgScala/isvalid_scala.stg +++ b/StgScala/isvalid_scala.stg @@ -187,9 +187,9 @@ StatementForLoop(p, sAcc, i, bIsFixedSize, nFixedSize, sInnerStatement) ::= << Print_AlphabetCheckFunc(sFuncName, arrsAlphaConBody) ::= << -def (str0: Array[UByte]): Boolean = +def (str0: Vector[UByte]): Boolean = { - val str = str0.toArrayRaws + val str = str0.toVectorRaws var valid: Boolean = true var i: Int = 0 (while (i \< str.length && (str(i) != CHAR_0000) && valid) { diff --git a/StgScala/test_cases_scala.stg b/StgScala/test_cases_scala.stg index d0c4cd64b..89835e0a2 100644 --- a/StgScala/test_cases_scala.stg +++ b/StgScala/test_cases_scala.stg @@ -23,6 +23,7 @@ package asn1src import asn1scala._ import stainless.lang._ +import stainless.collection._ >> @@ -35,6 +36,7 @@ package asn1src import asn1scala._ import stainless.lang._ +import stainless.collection._ import java.io._ // test_cases_scala.stg:38 @@ -197,7 +199,7 @@ def print_test_case_success(message: String, duration: Long): Unit = println(s"test case '$message' succeeded, duration was \t\t\t\t$duration ms") } -@main def main(): Int = +@main def main(): Unit = { val output = TestOutput( report_tests_failed = printf_tests_failed, @@ -212,7 +214,8 @@ def print_test_case_success(message: String, duration: Long): Unit = report_test_case_success = print_test_case_success ) - asn1scc_run_generated_testsuite(output) + val res = asn1scc_run_generated_testsuite(output) + System.exit(res) } >> @@ -275,6 +278,7 @@ package asn1src import asn1scala._ import stainless.lang._ +import stainless.collection._ def asn1scc_run_generated_testsuite(output: TestOutput): Int = { @@ -331,7 +335,6 @@ def (output: TestOutput): Int = output.report_case_begin("") - var tc_data: = () val start = System.currentTimeMillis() @@ -344,17 +347,25 @@ def (output: TestOutput): Int = output.report_failure_begin() errorCode match case 1 => - output.report_failure_message("Test case '/' failed in encoding.") + // TODO: ATC may generate invalid messages that get rejected when encoding. + // This typically happens for determinants shared across multiple choices within a sequence. + // As such, we do not count it as an error. + // Note that the Ada and C backend do not always propagate errors when encoding fail, + // therefore they are "unaffected" by this bug. + output.report_failure_message("!!!!! Test case '/' failed in encoding.") case 2 => output.report_failure_message("Test case '/' failed in decoding.") + totalErrors = totalErrors + 1 case 3 => output.report_failure_message("Test case '/' failed in the validation of the decoded message.") + totalErrors = totalErrors + 1 case 4 => output.report_failure_message("Test case '/' failed. Encoded and decoded messages are different.") + totalErrors = totalErrors + 1 case _ => output.report_failure_message("Unexpected error code in test case ''.") + totalErrors = totalErrors + 1 output.report_failure_message("========================================") - totalErrors = totalErrors + 1 output.report_failure_end() @@ -373,6 +384,7 @@ Code automatically generated by asn1scc tool package asn1src import stainless.lang._ +import stainless.collection._ >> @@ -384,6 +396,7 @@ package asn1src import asn1scala._ import stainless.lang._ +import stainless.collection._ // test_cases_scala.stg:386 diff --git a/StgScala/uper_scala.stg b/StgScala/uper_scala.stg index f4659fbd5..57d650a9a 100644 --- a/StgScala/uper_scala.stg +++ b/StgScala/uper_scala.stg @@ -8,7 +8,6 @@ call_base_type_func_encode(p, sFuncName) ::= << case Left(err) => return Left(err) >> call_base_type_func_decode(p, sFuncName) ::= << -// uper call_base_type_func_decode val

= (codec) match // uper:13 case RightMut(decData) => decData case LeftMut(err) => return LeftMut(err) @@ -39,6 +38,7 @@ def (@annotation.unused () match case Left(l) => return Left(l) case Right(_) => + @ghost val oldCdc = snapshot(codec) @@ -60,6 +60,7 @@ def (@annotation.unused codec: UPER): E )}; separator="\n"> }; separator="\n"> + @ghost val oldCdc = snapshot(codec) @@ -81,6 +82,7 @@ def _pure(codec: UPER): (UPER, EitherMut[ErrorCode, ]) val res = (cpy) (cpy, res) } + >> InternalItem_oct_str_encode(p, sAcc, i, sErrCode) ::=<< @@ -103,10 +105,11 @@ InternalItem_string_with_alpha_encode(p, sErrCode, td/*:FE_StringTypeDefinition* val charIndex: Int = GetCharIndex(

(), UByte.fromArrayRaws(allowedCharSet)) codec.base.encodeConstrainedWholeNumber(charIndex, 0, ) >> + InternalItem_string_with_alpha_decode(p, sErrCode, td/*:FE_StringTypeDefinition*/, i, nLastItemIndex, arrnAlphabetAsciiCodes, nAlphabetLength, nCharIndexSize) ::=<< -

() = allowedCharSet(codec.base.decodeConstrainedWholeNumber(0, ).toInt).toRawUByte +val

_arr__ = allowedCharSet(codec.base.decodeConstrainedWholeNumber(0, ).toInt).toRawUByte >> InternalItem_string_no_alpha_encode(p, sErrCode, i) ::=<< @@ -114,7 +117,7 @@ codec.base.encodeConstrainedWholeNumber(

().toRaw, 0, 127) >> InternalItem_string_no_alpha_decode(p, sErrCode, i) ::=<< -

() = UByte.fromRaw(codec.base.decodeConstrainedWholeNumberByte(0, 127)) // uper:109 +val

_arr__ = UByte.fromRaw(codec.base.decodeConstrainedWholeNumberByte(0, 127)) // uper:109 >> /* INTEGER START*/ @@ -155,7 +158,10 @@ val

= codec.base.decodeConstrainedPosWholeNumber(ULong.fromRaw( = codec.base.decodeUnconstrainedWholeNumber() // uper:145 +val

= codec.base.decodeUnconstrainedWholeNumber() match { + case None() => return LeftMut() + case Some(v) => v +} >> /*case: A :: = INTEGER(MIN..5) */ @@ -384,8 +390,12 @@ val

_ = >> -sequence_build(p, sTypeDefName, arrsChildren) ::= << +sequence_build(p, sTypeDefName, bIsOptional, arrsChildren) ::= << + val

= () + +val

: OptionMut[] = SomeMut(()) + >> @@ -403,70 +413,47 @@ loopFixedItem (i, fixedSize, sInternalItem)::= /*nogen*/<< /* IA5String & Numeric String */ -str_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +str_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soCallAux) ::= << @ghost val codec_0_1 = snapshot(codec) -@ghost val

_snap = snapshot(

) - = 0 -(while( \< .toInt) { - decreases(.toInt - ) - - - - += 1 - -}).opaque.inline.invariant(0 \<= && \<= .toInt &&

_snap.length ==

.length && ) + >> -str_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +str_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, bIntroSnap, soCallAux) ::= << @ghost val codec_0_1 = snapshot(codec) -val

= -@ghost val

_snap = snapshot(

) - = 0 -(while( \< .toInt) { - decreases(.toInt - ) - - - - += 1 - -}).opaque.inline.invariant(0 \<= && \<= .toInt &&

_snap.length ==

.length && ) -

() = UByte.fromRaw(0x0) + >> -str_VarSize_encode(p, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr) ::= << -nStringLength =

.indexOf(0x00.toRawUByte) + +str_VarSize_encode(p, sPIden, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, soCallAux) ::= << +nStringLength =

.indexOfOrLength(0x00.toRawUByte) /*ret = nStringLength >= && nStringLength \<= ;*/ codec.base.encodeConstrainedWholeNumber(nStringLength, , ) - - +val _nCount = nStringLength + >> -str_VarSize_decode(p, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr) ::= << -val

= +str_VarSize_decode(p, sPIden, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, soInitExpr, soCallAux) ::= << nStringLength = codec.base.decodeConstrainedWholeNumberInt(, ) -

(nStringLength) = UByte.fromRaw(0) - - = 0 - +val

_nCount = nStringLength + >> /* SEQUENCE OF & OCTET STRING*/ -seqOf_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr) ::= << - +seqOf_FixedSize_encode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, soCallAux) ::= << + >> -seqOf_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr) ::= << -val

= (, Array.fill()()) - +seqOf_FixedSize_decode(p, sTasName, i, sInternalItem, nFixedSize, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, soCallAux) ::= << + >> -seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +seqOf_VarSize_encode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << @ghost val codec_0_1 = snapshot(codec) @@ -480,22 +467,14 @@ locally { bitCountLemma() assert(codec.base.bitStream.bitIndex \<= oldCodec.base.bitStream.bitIndex + L) BitStream.validateOffsetBitsIneqLemma(oldCodec.base.bitStream, codec.base.bitStream, , L) - check(codec.base.bitStream.bitIndex \<= codec_0_1.base.bitStream.bitIndex + L + L) - check(codec.base.bitStream.bitIndex \<= codec__.base.bitStream.bitIndex + L + L) + //check(codec.base.bitStream.bitIndex \<= codec_0_1.base.bitStream.bitIndex + L + L) + //check(codec.base.bitStream.bitIndex \<= codec__.base.bitStream.bitIndex + L + L) } } - = 0 -(while( \<

.nCount.toInt) { - decreases(

.nCount.toInt - ) - - - - += 1 - -}).opaque.inline.noReturnInvariant(0 \<= && \<=

.nCount.toInt && ) + >> -seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soPreSerde, soPostSerde, soPostInc, soInvariant) ::= << +seqOf_VarSize_decode(p, sAcc, sTasName, i, sInternalItem, nSizeMin, nSizeMax, nSizeInBits, nIntItemMinSize, nIntItemMaxSize, nAlignSize, sChildInitExpr, sErrCode, nAbsOffset, nRemainingMinBits, nLevel, nIx, nOffset, bIntroSnap, soCallAux) ::= << @ghost val codec_0_1 = snapshot(codec) @@ -509,53 +488,43 @@ val

_nCount = locally { bitCountLemma() assert(codec.base.bitStream.bitIndex \<= oldCodec.base.bitStream.bitIndex + L) BitStream.validateOffsetBitsIneqLemma(oldCodec.base.bitStream, codec.base.bitStream, , L) - check(codec.base.bitStream.bitIndex \<= codec_0_1.base.bitStream.bitIndex + L + L) - check(codec.base.bitStream.bitIndex \<= codec__.base.bitStream.bitIndex + L + L) + //check(codec.base.bitStream.bitIndex \<= codec_0_1.base.bitStream.bitIndex + L + L) + //check(codec.base.bitStream.bitIndex \<= codec__.base.bitStream.bitIndex + L + L) }

_nCount } -val

= (

_nCount.toInt, Array.fill(

_nCount.toInt)()) -@ghost val

_snap = snapshot(

) - = 0 -(while( \<

_nCount.toInt) { - decreases(

_nCount.toInt - ) - - - - += 1 - -}).opaque.inline.noReturnInvariant(0 \<= && \<=

_nCount.toInt &&

_snap.arr.length ==

.arr.length && ) + >> octet_FixedSize_encode(sTypeDefName, p, sAcc, nFixedSize) ::= << -codec.base.encodeOctetString_no_length(

arr, .toInt) +codec.base.encodeOctetString_no_length_vec(

arr, .toInt) >> octet_FixedSize_decode(sTypeDefName, p, sAcc, nFixedSize) ::= << -val

= (codec.base.decodeOctetString_no_length()) +val

= (codec.base.decodeOctetString_no_length_vec()) >> octet_VarSize_encode(sTypeDefName, p, sAcc, nSizeMin, nSizeMax, nSizeInBits, sErrCode) ::= << codec.base.encodeConstrainedWholeNumber(

nCount, , ) -codec.base.encodeOctetString_no_length(

arr,

nCount.toInt) +codec.base.encodeOctetString_no_length_vec(

arr,

nCount.toInt) >> octet_VarSize_decode(sTypeDefName, p, sAcc, nSizeMin, nSizeMax, nSizeInBits, sErrCode) ::= << // decode length val

_nCount = codec.base.decodeConstrainedWholeNumber(, ) // decode payload -val

_arr = codec.base.decodeOctetString_no_length(

_nCount.toInt) +val

_arr = codec.base.decodeOctetString_no_length_vec(

_nCount.toInt) val

= (

_nCount,

_arr) >> /* BIT STRING*/ bitString_FixSize_encode(sTypeDefName, p, sAcc, nFixedSize, sErrCode) ::= << assert(.toInt >= 0) // overflow may happen during cast -codec.base.bitStream.appendBitsMSBFirst(

arr, .toInt) +codec.base.bitStream.appendBitsMSBFirstVec(

arr, .toInt) >> bitString_FixSize_decode(sTypeDefName, p, sAcc, nFixedSize, sErrCode) ::= << -val

= (codec.base.bitStream.readBits(.toInt)) +val

= (codec.base.bitStream.readBitsVec(.toInt)) >> bitString_VarSize_encode(sTypeDefName, p, sAcc, nSizeMin, nSizeMax, sErrCode, nSizeInBits) ::= << @@ -565,7 +534,7 @@ codec.base.encodeConstrainedWholeNumber(

nCount, , ) bitString_VarSize_decode(sTypeDefName, p, sAcc, nSizeMin, nSizeMax, sErrCode, nSizeInBits) ::= << val

_nCount = codec.base.decodeConstrainedWholeNumber(, ) -val

_arr = codec.base.bitStream.readBits(

_nCount.toInt) +val

_arr = codec.base.bitStream.readBitsVec(

_nCount.toInt) val

= (

_nCount,

_arr) >> diff --git a/asn1scala/bitStream_genc.sh b/asn1scala/bitStream_genc.sh new file mode 100755 index 000000000..0201b9594 --- /dev/null +++ b/asn1scala/bitStream_genc.sh @@ -0,0 +1,8 @@ +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 \ +--config-file=stainless.conf \ +--genc=true\ +$1 diff --git a/asn1scala/build.sbt b/asn1scala/build.sbt index e52f7c830..76e1ffcbf 100644 --- a/asn1scala/build.sbt +++ b/asn1scala/build.sbt @@ -4,5 +4,9 @@ ThisBuild / scalaVersion := "3.3.1" lazy val root = (project in file(".")) .settings( - name := "asn1scala" + name := "asn1scala", + run / javaOptions ++= Seq( + "-Xss1G" + ), + run / Keys.fork := true ) diff --git a/asn1scala/lib/stainless-library_2.13-0.9.8.2.jar b/asn1scala/lib/stainless-library_2.13-0.9.8.2.jar deleted file mode 100644 index 352ba4e41..000000000 Binary files a/asn1scala/lib/stainless-library_2.13-0.9.8.2.jar and /dev/null differ diff --git a/asn1scala/lib/stainless-library_3-0.9.8.7.jar b/asn1scala/lib/stainless-library_3-0.9.8.7.jar new file mode 100644 index 000000000..c7e4526fd Binary files /dev/null and b/asn1scala/lib/stainless-library_3-0.9.8.7.jar differ diff --git a/asn1scala/src/main/scala/asn1scala/Main.scala b/asn1scala/src/main/scala/asn1scala/Main.scala new file mode 100644 index 000000000..068148e91 --- /dev/null +++ b/asn1scala/src/main/scala/asn1scala/Main.scala @@ -0,0 +1,101 @@ +package asn1scala + +import asn1scala.BitStream.bitIndex +import stainless.* +import stainless.lang.{None => None, ghost => ghostExpr, Option => Option, _} +import stainless.collection.* + +def byteToBinaryString(b: Byte): String = + val s = (0 to 7).map(i => if ((b & (1 << i)) != 0) "1" else "0").mkString + s + +def bitStreamToString(b: BitStream): String = + val bi = BitStream.bitIndex(b.buf.length, b.currentByte, b.currentBit) + val res = s"Buf: ${b.buf.toList.map(byteToBinaryString).mkString(" ")}\n" + + res + s"BuffLength: ${b.buf.length}\ncurrentByte: ${b.currentByte}\ncurrentBit: ${b.currentBit}\nBitIndex: ${bi}\n" +@main def Main = + // val b1 = BitStream(Array[Byte](0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00), 0, 0) + // println(s"bitStream before appendBit: \n${bitStreamToString(b1)}") + // b1.appendBit(true) + // println(s"bitStream after appendBit: \n${bitStreamToString(b1)}") + // b1.appendBit(true) + // println(s"bitStream after appendBit: \n${bitStreamToString(b1)}") + + // // Test lemma + + // val arr = new Array[Byte](536870912) + // val bs = BitStream(arr, 0, 1) + // val nBits = 4672978248L + // val expected = false + // val from = 4639423817L + + // BitStream.checkBitsLoopPrefixLemma(bs, nBits, expected, from) + + + // ---------------------------------------------------------------------------- + // val n = 64 + // val v = Long.MaxValue + // println(s"bitStream before appendBits: \n${bitStreamToString(b1)}") + // b1.appendBitsLSBFirst(v, n) + // println(s"bitStream after appendBits: \n${bitStreamToString(b1)}") + // b1.moveBitIndex(-n) + // println(s"bitStream after moveBitIndex: \n${bitStreamToString(b1)}") + + // val res: Long = b1.readNBitsLSBFirst(n) + // assert(res == v ) + // println(s"Read $n bits: ${res}\n") + // println(s"bitStream after readNBits: \n${bitStreamToString(b1)}") + + // ---------------------------------------------------------------------------- + // val n = 8 * 5 + // val raw = Array[Byte](7, 18, 112, 76, 87) + // val ar = UByte.fromArrayRaws(raw) + // println(s"UByte: ${raw.map(byteToBinaryString).mkString(" ")}") + // println(s"bitStream before appendBitsMSBFirst: \n${bitStreamToString(b1)}") + // b1.appendBitsMSBFirst(ar, n) + // println(s"bitStream after appendBitsMSBFirst: \n${bitStreamToString(b1)}") + + // b1.moveBitIndex(-n) + // println(s"bitStream after moveBitIndex: \n${bitStreamToString(b1)}") + + // val res = b1.readBits(n) + // println(s"Read $n bits: ${res.map(ub => byteToBinaryString(ub.toRaw)).mkString(" ")}\n") + + // for (resB, origB) <- res.zip(ar) do + // assert(resB == origB) + + // DEBBUG appendBitsMSBFirst + // val bitStream1 = BitStream(Array(-82, -81, 2, 2), 0, 0) + // val bitStream2 = BitStream(Array(-18, -82, 1, 1), 0, 1) + // val base = BitStream(Array(-82, -81, 2, 2), 3, 2) + // val thiss = BitStream(new Array[Byte](2147), 1, 0) + // val listBits = Cons[Boolean](true, Cons[Boolean](false, Nil[Boolean]())) + // val nBits = 2 + + // println(s"bitStream1 \n${bitStreamToString(bitStream1)}") + // println(s"bitStream2 \n${bitStreamToString(bitStream2)}") + // println(s"read two bits from bitStream1: ${bitStream1.readBit()} ${bitStream1.readBit()}") + // println(s"Computed ListBits on bitStream1: ${thiss.bitStreamReadBitsIntoList(bitStream1, nBits)}") + // println(s"Computed ListBits on bitStream2: ${thiss.bitStreamReadBitsIntoList(bitStream2, nBits - 1)}") + + // DEBUG readByteArray + val bitStream1 = BitStream(new Array(2147483586), 2147483584, 0) + val i = 1 + val to = 2 + val thiss = bitStream1 + thiss.buf.update(2147483584, 123) + thiss.buf.update(2147483585, 43) + val arr = new Array[UByte](1073737727) + + println(s"bit index = ${bitIndex(thiss.buf.length, thiss.currentByte, thiss.currentBit)}") + + thiss.readByteArrayLoop(arr, i, to) + + println(s"bit index = ${bitIndex(thiss.buf.length, thiss.currentByte, thiss.currentBit)}") + println(s"arr[0] = ${arr(0).toRaw}\narr[1] = ${arr(1).toRaw}\narr[2] = ${arr(2).toRaw}") + + + + + diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm.scala index e5a12e9ba..5de9f1bc5 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm.scala @@ -31,6 +31,7 @@ opaque type UByte = Byte object UByte { @inline def fromRaw(u: Byte): UByte = u @inline @pure def fromArrayRaws(arr: Array[Byte]): Array[UByte] = arr + @inline @pure def fromVectorRaws(arr: Vector[Byte]): Vector[UByte] = arr } extension (l: UByte) { @inline def toRaw: Byte = l @@ -61,6 +62,10 @@ extension (arr: Array[UByte]) { @inline def toArrayRaws: Array[Byte] = arr } +extension (vec: Vector[UByte]) { + @inline def toVectorRaws: Vector[Byte] = vec +} + opaque type UShort = Short object UShort { @@ -249,6 +254,54 @@ def bitMSBLong(bit: Boolean, nBits: Int): Long = { if bit then onesMSBLong(nBits) else 0L } +def alignedToN(alignment: Long, bits: Long): Long = { + require(2L <= alignment && alignment <= 64L && 0L <= bits && bits <= Long.MaxValue - alignment) + val rem = bits % alignment + if (rem != 0L) bits + (alignment - rem) + else bits +} + +def alignedSizeToN(alignment: Long, offset: Long, bits: Long): Long = { + require(2L <= alignment && alignment <= 64L && 0L <= bits && bits <= Long.MaxValue - alignment) + require(offset >= 0L) + val rem = offset % alignment + if (rem != 0L) bits + (alignment - rem) + else bits +} + +def alignedToByte(bits: Long): Long = { + require(0L <= bits && bits <= Long.MaxValue - 8L) + alignedToN(8L, bits) +}.ensuring(res => res % 8L == 0L && bits <= res && res <= bits + 7L) + +def alignedToWord(bits: Long): Long = { + require(0L <= bits && bits <= Long.MaxValue - 16L) + alignedToN(16L, bits) +}.ensuring(res => res % 16L == 0L && bits <= res && res <= bits + 15L) + +def alignedToDWord(bits: Long): Long = { + require(0L <= bits && bits <= Long.MaxValue - 32L) + alignedToN(32L, bits) +}.ensuring(res => res % 32L == 0L && bits <= res && res <= bits + 31L) + +def alignedSizeToByte(bits: Long, offset: Long): Long = { + require(0L <= bits && bits <= Long.MaxValue - 8L) + require(offset >= 0L) + alignedSizeToN(8L, offset, bits) +}.ensuring(res => bits <= res && res <= bits + 7L) + +def alignedSizeToWord(bits: Long, offset: Long): Long = { + require(0L <= bits && bits <= Long.MaxValue - 16L) + require(offset >= 0L) + alignedSizeToN(16L, offset, bits) +}.ensuring(res => bits <= res && res <= bits + 15L) + +def alignedSizeToDWord(bits: Long, offset: Long): Long = { + require(0L <= bits && bits <= Long.MaxValue - 32L) + require(offset >= 0L) + alignedSizeToN(32L, offset, bits) +}.ensuring(res => bits <= res && res <= bits + 31L) + def uint2int(v: ULong, uintSizeInBytes: Int): Long = { require(uintSizeInBytes >= 1 && uintSizeInBytes <= 9) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala index da1f9091a..325c68805 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Bitstream.scala @@ -33,7 +33,7 @@ object BitStream { require(bufLength <= Int.MaxValue && currentByte <= Int.MaxValue && currentBit <= Int.MaxValue) require(bufLength >= 0 && currentByte >= 0 && currentBit >= 0) require(invariant(currentBit.toInt, currentByte.toInt, bufLength.toInt)) - BitStream.remainingBits(bufLength, currentByte, currentBit) >= 1 + validate_offset_bits(bufLength, currentByte, currentBit, 1) } @pure @@ -71,26 +71,60 @@ object BitStream { 0 <= res && res <= bufLength.toLong * 8L ) + @ghost @pure + def readerFrom(w: BitStream, newCurrentBit: Int, newCurrentBytes: Int): BitStream = { + require(invariant(w.currentBit, w.currentByte, w.buf.length)) + require(invariant(newCurrentBit, newCurrentBytes, w.buf.length)) + BitStream(snapshot(w.buf), newCurrentBytes, newCurrentBit) + + }.ensuring(res => invariant(res.currentBit, res.currentByte, res.buf.length)) + + /** + * Creates two new BitStream instances, with the buffer of w2, and the currentByte and currentBit of w1 and w2 respectively. + * + * @param w1 + * @param w2 + * @return + */ @ghost @pure def reader(w1: BitStream, w2: BitStream): (BitStream, BitStream) = { require(w1.isPrefixOf(w2)) val r1 = BitStream(snapshot(w2.buf), w1.currentByte, w1.currentBit) val r2 = BitStream(snapshot(w2.buf), w2.currentByte, w2.currentBit) + lemmaIsPrefixRefl(w1) + lemmaIsPrefixRefl(r1) + lemmaIsPrefixRefl(w2) + lemmaIsPrefixRefl(r2) + + // Asserts are here as documentation for the proof + assert((w1.buf.length != 0) ==> arrayBitRangesEq(w1.buf, w2.buf, 0, BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit))) + if(w1.buf.length != 0) then + arrayBitRangesEqSymmetric(w1.buf, w2.buf, 0 , BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit )) + assert((w1.buf.length != 0) ==> arrayBitRangesEq(w2.buf, w1.buf, 0, BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit))) + + assert(r1.isPrefixOf(w1)) + lemmaIsPrefixTransitive(r1, w1, w2) + lemmaIsPrefixTransitive(r1, w2, r2) (r1, r2) - } + } ensuring(res => + res._1.isPrefixOf(res._2) + && res._1.isPrefixOf(w1) + && res._2.isPrefixOf(w2) + && 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 = { @@ -166,15 +200,15 @@ object BitStream { }.ensuring(_ => BitStream.validate_offset_bits(b2.buf.length.toLong, b2.currentByte.toLong, b2.currentBit.toLong, bits)) } - @ghost @pure @opaque @inlineOnce - def validateOffsetBytesFromBitsLemma(b: BitStream, bits: Long, bytes: Int): Unit = { - require(0 <= bytes && bytes <= bits / 8 && 0 <= bits) - require(BitStream.validate_offset_bits(b.buf.length.toLong, b.currentByte.toLong, b.currentBit.toLong, bits)) + // @ghost @pure @opaque @inlineOnce + // def validateOffsetBytesFromBitsLemma(b: BitStream, bits: Long, bytes: Int): Unit = { + // require(0 <= bytes && bytes <= bits / 8 && 0 <= bits) + // require(BitStream.validate_offset_bits(b.buf.length.toLong, b.currentByte.toLong, b.currentBit.toLong, bits)) - { - () - }.ensuring(_ => BitStream.validate_offset_bytes(b.buf.length.toLong, b.currentByte.toLong, b.currentBit.toLong, bytes)) - } + // { + // () + // }.ensuring(_ => BitStream.validate_offset_bytes(b.buf.length.toLong, b.currentByte.toLong, b.currentBit.toLong, bytes)) + // } @ghost @pure @opaque @inlineOnce def validateOffsetBytesFromBitIndexLemma(b1: BitStream, b2: BitStream, bits: Long, bytes: Int): Unit = { @@ -195,18 +229,17 @@ 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) @@ -259,7 +292,7 @@ object BitStream { @ghost @pure @opaque @inlineOnce def readBitPrefixLemma(bs1: BitStream, bs2: BitStream): Unit = { require(bs1.buf.length == bs2.buf.length) - require(BitStream.validate_offset_bit(bs1.buf.length.toLong, bs1.currentByte.toLong, bs1.currentBit.toLong)) + require(bs1.validate_offset_bits(1)) require(arrayBitRangesEq( bs1.buf, bs2.buf, @@ -278,6 +311,27 @@ object BitStream { } } + @ghost @pure @opaque @inlineOnce + def lemmaReadNBitsLSBFirstsLoopIsCorrect(bs: BitStream, nBits: Int, i: Int, acc: Long): Unit = { + require(0 <= i && i < nBits && nBits <= 64) + require(BitStream.validate_offset_bits(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong, nBits - i)) + require((acc & onesMSBLong(64 - i)) == 0L) // The 64 - i MSBs must be 0 + require((acc & onesMSBLong(64)) == acc) + decreases(nBits - i) + val (bsFinal, vGot1) = bs.readNBitsLSBFirstsLoopPure(nBits, i, acc) + val readBit = bs.readBitPure()._2 + val bs2 = bs.withMovedBitIndex(1) + val newAcc = acc | (if readBit then 1L << i else 0) + val (bs2Final, vGot2) = bs2.readNBitsLSBFirstsLoopPure(nBits, i + 1, newAcc) + + { + () + }.ensuring { _ => + vGot1 == vGot2 && bsFinal == bs2Final + } + } + + // TODO: "loopPrefixLemma" is a bad name, it's not the same "prefix lemma" as the others!!! @ghost @pure @opaque @inlineOnce def readNLeastSignificantBitsLoopPrefixLemma(bs: BitStream, nBits: Int, i: Int, acc: Long): Unit = { @@ -466,28 +520,28 @@ object BitStream { } } - @ghost @pure @opaque @inlineOnce - def checkBitsLoopAndReadNLSB(bs: BitStream, nBits: Int, bit: Boolean, from: Int = 0): Unit = { - require(0 < nBits && nBits <= 64) - require(0 <= from && from <= nBits) - require(BitStream.validate_offset_bits(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong, nBits - from)) - decreases(nBits - from) - val (bs1Final, ok) = bs.checkBitsLoopPure(nBits, bit, from) - require(ok) - val acc = if (bit) onesLSBLong(from) << (nBits - from) else 0 - val (bs2Final, vGot) = bs.readNLeastSignificantBitsLoopPure(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) - } - } + // @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.readNLeastSignificantBitsLoopPure(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) + // } + // } // TODO: Bad name @ghost @pure @opaque @inlineOnce @@ -503,91 +557,96 @@ object BitStream { { () }.ensuring { _ => - vGot1 == ((readBit == expected) && vGot2) && ((readBit == expected) ==> (bsFinal == bs2Final)) - } - } - - @ghost @pure @opaque @inlineOnce - def checkBitsLoopPrefixLemma2(bs1: BitStream, bs2: BitStream, nBits: Int, expected: Boolean, from: Long): Unit = { - require(bs1.buf.length == bs2.buf.length) - require(0 < nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) - require(0 <= from && from < nBits) - require(BitStream.validate_offset_bits(bs1.buf.length.toLong, bs1.currentByte.toLong, bs1.currentBit.toLong, nBits - from)) - require(arrayBitRangesEq( - bs1.buf, - bs2.buf, - 0, - BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + nBits - from - )) - decreases(nBits - from) - - val bs2Reset = bs2.resetAt(bs1) - val (bsFinal1, vGot1) = bs1.checkBitsLoopPure(nBits, expected, from) - val (bsFinal2, vGot2) = bs2Reset.checkBitsLoopPure(nBits, expected, from) - - val bsFinal1PureBitIndex = BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) - val bsFinal2PureBitIndex = BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) + // rewritten SAM + vGot1 == ((readBit == expected) && vGot2) + && + (if(readBit == expected) then (bsFinal == bs2Final) else true) - { - val (bs1Rec, gotB1) = bs1.readBitPure() - val (bs2Rec, gotB2) = bs2Reset.readBitPure() - arrayBitRangesEqSlicedLemma(bs1.buf, bs2.buf, 0, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + nBits - from, 0, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) - readBitPrefixLemma(bs1, bs2) - assert(gotB1 == gotB2) - if (from == nBits - 1) { - check(vGot1 == vGot2) - assert(BitStream.invariant(bsFinal1)) - check(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) - } else { - assert(BitStream.invariant(bs1Rec)) - assert(BitStream.bitIndex(bs1Rec.buf.length, bs1Rec.currentByte, bs1Rec.currentBit ) == BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) - validateOffsetBitsContentIrrelevancyLemma(bs1, bs1Rec.buf, 1) - assert(BitStream.invariant(bs1Rec)) - assert((BitStream.validate_offset_bits(bs1Rec.buf.length.toLong, bs1Rec.currentByte.toLong, bs1Rec.currentBit.toLong, nBits - from - 1))) - checkBitsLoopPrefixLemma2(bs1Rec, bs2Rec, nBits, expected, from + 1) - - val (_, vRecGot1) = bs1Rec.checkBitsLoopPure(nBits, expected, from + 1) - assert((BitStream.validate_offset_bits(bs2Rec.buf.length.toLong, bs2Rec.currentByte.toLong, bs2Rec.currentBit.toLong, nBits - from - 1))) - val (_, vRecGot2) = bs2Rec.checkBitsLoopPure(nBits, expected, from + 1) - - assert(vRecGot1 == vRecGot2) - assert(vGot1 == ((gotB1 == expected) && vRecGot1)) - assert(vGot2 == ((gotB1 == expected) && vRecGot2)) - - check(vGot1 == vGot2) - assert(BitStream.invariant(bsFinal2.currentBit, bsFinal2.currentByte, bsFinal2.buf.length)) - assert(BitStream.invariant(bsFinal1.currentBit, bsFinal1.currentByte, bsFinal1.buf.length)) - assert(bsFinal2PureBitIndex == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) - assert(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == bsFinal1PureBitIndex) - assert(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) // 200sec!!! - check(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) - } - }.ensuring { _ => - vGot1 == vGot2 && BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) + // vGot1 == ((readBit == expected) && vGot2) && ((readBit == expected) ==> (bsFinal == bs2Final)) } } - @ghost @pure @opaque @inlineOnce - def readByteArrayLoopAnyArraysLemma(bs: BitStream, arr1: Array[UByte], arr2: Array[UByte], from: Int, to: Int): Unit = { - require(arr1.length <= arr2.length) - require(0 <= from && from <= to && to <= arr1.length) - require( BitStream.validate_offset_bytes(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong,to - from)) - decreases(to - from) - - val (_, arr1b) = bs.readByteArrayLoopPure(arr1, from, to) - val (_, arr2b) = bs.readByteArrayLoopPure(arr2, from, to) - - { - if (from == to) { - () - } else { - val bsRec = bs.withMovedByteIndex(1) - val b = bs.readBytePure()._2 - validateOffsetBytesFromBitIndexLemma(bs, bsRec, 8, to - from) - readByteArrayLoopAnyArraysLemma(bsRec, arr1.updated(from, b), arr2.updated(from, b), from + 1, to) - } - }.ensuring(_ => arrayRangesEq(arr1b, arr2b, from, to)) - } + // @ghost @pure @opaque @inlineOnce + // def checkBitsLoopPrefixLemma2(bs1: BitStream, bs2: BitStream, nBits: Int, expected: Boolean, from: Long): Unit = { + // require(bs1.buf.length == bs2.buf.length) + // require(0 < nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) + // require(0 <= from && from < nBits) + // require(BitStream.validate_offset_bits(bs1.buf.length.toLong, bs1.currentByte.toLong, bs1.currentBit.toLong, nBits - from)) + // require(arrayBitRangesEq( + // bs1.buf, + // bs2.buf, + // 0, + // BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + nBits - from + // )) + // decreases(nBits - from) + + // val bs2Reset = bs2.resetAt(bs1) + // val (bsFinal1, vGot1) = bs1.checkBitsLoopPure(nBits, expected, from) + // val (bsFinal2, vGot2) = bs2Reset.checkBitsLoopPure(nBits, expected, from) + + // val bsFinal1PureBitIndex = BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) + // val bsFinal2PureBitIndex = BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) + + // { + // val (bs1Rec, gotB1) = bs1.readBitPure() + // val (bs2Rec, gotB2) = bs2Reset.readBitPure() + // arrayBitRangesEqSlicedLemma(bs1.buf, bs2.buf, 0, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + nBits - from, 0, BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) + // readBitPrefixLemma(bs1, bs2) + // assert(gotB1 == gotB2) + // if (from == nBits - 1) { + // check(vGot1 == vGot2) + // assert(BitStream.invariant(bsFinal1)) + // check(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) + // } else { + // assert(BitStream.invariant(bs1Rec)) + // assert(BitStream.bitIndex(bs1Rec.buf.length, bs1Rec.currentByte, bs1Rec.currentBit ) == BitStream.bitIndex(bs1.buf.length, bs1.currentByte, bs1.currentBit ) + 1) + // validateOffsetBitsContentIrrelevancyLemma(bs1, bs1Rec.buf, 1) + // assert(BitStream.invariant(bs1Rec)) + // assert((BitStream.validate_offset_bits(bs1Rec.buf.length.toLong, bs1Rec.currentByte.toLong, bs1Rec.currentBit.toLong, nBits - from - 1))) + // checkBitsLoopPrefixLemma2(bs1Rec, bs2Rec, nBits, expected, from + 1) + + // val (_, vRecGot1) = bs1Rec.checkBitsLoopPure(nBits, expected, from + 1) + // assert((BitStream.validate_offset_bits(bs2Rec.buf.length.toLong, bs2Rec.currentByte.toLong, bs2Rec.currentBit.toLong, nBits - from - 1))) + // val (_, vRecGot2) = bs2Rec.checkBitsLoopPure(nBits, expected, from + 1) + + // assert(vRecGot1 == vRecGot2) + // assert(vGot1 == ((gotB1 == expected) && vRecGot1)) + // assert(vGot2 == ((gotB1 == expected) && vRecGot2)) + + // check(vGot1 == vGot2) + // assert(BitStream.invariant(bsFinal2.currentBit, bsFinal2.currentByte, bsFinal2.buf.length)) + // assert(BitStream.invariant(bsFinal1.currentBit, bsFinal1.currentByte, bsFinal1.buf.length)) + // assert(bsFinal2PureBitIndex == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) + // assert(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == bsFinal1PureBitIndex) + // assert(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) // 200sec!!! + // check(BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit )) + // } + // }.ensuring { _ => + // vGot1 == vGot2 && BitStream.bitIndex(bsFinal1.buf.length, bsFinal1.currentByte, bsFinal1.currentBit ) == BitStream.bitIndex(bsFinal2.buf.length, bsFinal2.currentByte, bsFinal2.currentBit ) + // } + // } + + // @ghost @pure @opaque @inlineOnce + // def readByteArrayLoopAnyArraysLemma(bs: BitStream, arr1: Array[UByte], arr2: Array[UByte], from: Int, to: Int): Unit = { + // require(arr1.length <= arr2.length) + // require(0 <= from && from <= to && to <= arr1.length) + // require( BitStream.validate_offset_bytes(bs.buf.length.toLong, bs.currentByte.toLong, bs.currentBit.toLong,to - from)) + // decreases(to - from) + + // val (_, arr1b) = bs.readByteArrayLoopPure(arr1, from, to) + // val (_, arr2b) = bs.readByteArrayLoopPure(arr2, from, to) + + // { + // if (from == to) { + // () + // } else { + // val bsRec = bs.withMovedByteIndex(1) + // val b = bs.readBytePure()._2 + // validateOffsetBytesFromBitIndexLemma(bs, bsRec, 8, to - from) + // readByteArrayLoopAnyArraysLemma(bsRec, arr1.updated(from, b), arr2.updated(from, b), from + 1, to) + // } + // }.ensuring(_ => arrayRangesEq(arr1b, arr2b, from, to)) + // } @ghost @pure @opaque @inlineOnce def readByteArrayLoopArrayPrefixLemma(bs: BitStream, arr: Array[UByte], from: Int, to: Int): Unit = { @@ -615,7 +674,7 @@ object BitStream { } @ghost @pure @opaque @inlineOnce - def validReflexiveLemma(bs: BitStream): Unit = { + def lemmaIsPrefixRefl(bs: BitStream): Unit = { if (bs.buf.length != 0) { arrayBitEqImpliesRangesEqLemma(bs.buf) arrayBitRangesEqSlicedLemma(bs.buf, snapshot(bs.buf), 0, bs.buf.length.toLong * 8, 0, BitStream.bitIndex(bs.buf.length, bs.currentByte, bs.currentBit )) @@ -625,7 +684,7 @@ object BitStream { } @ghost @pure @opaque @inlineOnce - def validTransitiveLemma(w1: BitStream, w2: BitStream, w3: BitStream): Unit = { + def lemmaIsPrefixTransitive(w1: BitStream, w2: BitStream, w3: BitStream): Unit = { require(w1.isPrefixOf(w2)) require(w2.isPrefixOf(w3)) arrayRangesEqTransitive(w1.buf, w2.buf, w3.buf, 0, w1.currentByte, w2.currentByte) @@ -644,7 +703,6 @@ object BitStream { }.ensuring { _ => w1.isPrefixOf(w3) } - */ def moveByteIndexPrecond(b: BitStream, diffInBytes: Int): Boolean = { -b.buf.length <= diffInBytes && diffInBytes <= b.buf.length && { @@ -691,9 +749,9 @@ case class BitStream private [asn1scala]( }.ensuring {_ => val oldBitStr = old(this) - BitStream.bitIndex(oldBitStr.buf.length, oldBitStr.currentByte, oldBitStr.currentBit) + 1 == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ) &&& - BitStream.remainingBits(oldBitStr.buf.length.toLong, oldBitStr.currentByte.toLong, oldBitStr.currentBit.toLong) - BitStream.remainingBits(buf.length.toLong, currentByte.toLong, currentBit.toLong) == 1 &&& - oldBitStr.buf.length == buf.length + BitStream.bitIndex(oldBitStr.buf.length, oldBitStr.currentByte, oldBitStr.currentBit) + 1 == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ) && + BitStream.remainingBits(oldBitStr.buf.length.toLong, oldBitStr.currentByte.toLong, oldBitStr.currentBit.toLong) - BitStream.remainingBits(buf.length.toLong, currentByte.toLong, currentBit.toLong) == 1 && + oldBitStr.buf.length == buf.length } def moveBitIndex(diffInBits: Long): Unit = { @@ -709,7 +767,11 @@ case class BitStream private [asn1scala]( currentByte += 1 else currentBit += nbBits - }.ensuring(_ => BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + diffInBits == BitStream.bitIndex(buf.length, currentByte, currentBit)) + }.ensuring(_ => + BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + diffInBits == BitStream.bitIndex(buf.length, currentByte, currentBit) + && old(this).buf.length == buf.length + && old(this).buf == this.buf + ) @ghost @pure def withMovedBitIndex(diffInBits: Long): BitStream = { @@ -717,7 +779,10 @@ case class BitStream private [asn1scala]( val cpy = snapshot(this) cpy.moveBitIndex(diffInBits) cpy - } + }.ensuring(res => + BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ) + diffInBits == BitStream.bitIndex(res.buf.length, res.currentByte, res.currentBit) + && this.buf.length == res.buf.length + ) def moveByteIndex(diffInBytes: Int): Unit = { require(moveByteIndexPrecond(this, diffInBytes)) @@ -765,6 +830,12 @@ case class BitStream private [asn1scala]( BitStream.validate_offset_bits(buf.length, currentByte, currentBit, bits) } + @pure @inline + def validate_offset_bytes(bytes: Int): Boolean = { + require(bytes >= 0) + BitStream.validate_offset_bytes(buf.length, currentByte, currentBit, bytes) + } + @ghost @pure @inline def resetAt(b: BitStream): BitStream = { require(b.buf.length == buf.length) @@ -801,71 +872,66 @@ case class BitStream private [asn1scala]( } increaseBitIndex() + }.ensuring { _ => val w1 = old(this) val w2 = this - w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + 1 /* && w1.isPrefixOf(w2) && { - val (r1, r2) = reader(w1, w2) - val (r2Got, bGot) = r1.readBitPure() - bGot == b && r2Got == r2 - }*/ + w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + 1 + && w1.isPrefixOf(w2) + && { + val r = readerFrom(w2, w1.currentBit, w1.currentByte) + val (r2Got, bGot) = r.readBitPure() + bGot == b + && r2Got == this && + r2Got.bitIndex == this.bitIndex // obvious but important as documentation + } } /** * Append a set bit */ + @opaque @inlineOnce def appendBitOne(): Unit = { require(BitStream.validate_offset_bit(buf.length.toLong, currentByte.toLong, currentBit.toLong)) appendBit(true) - }.ensuring(_ => buf.length == old(this).buf.length && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + 1) - - /** - * Append n set bits to bitstream - * - * @param nBits number of bits - * - */ - @opaque @inlineOnce - def appendNOneBits(nBits: Long): Unit = { - 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)) - appendNBits(nBits, true) - } + }.ensuring(_ => + val w1 = old(this) + val w2 = this + w2.buf.length == w1.buf.length && + BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + 1 + && w1.isPrefixOf(w2) + && { + val r = readerFrom(w2, w1.currentBit, w1.currentByte) + val (r2Got, bGot) = r.readBitPure() + bGot == true + && r2Got == this && + r2Got.bitIndex == this.bitIndex + } + ) /** * Append cleared bit to bitstream */ - @opaque @inlineOnce + @opaque @inlineOnce def appendBitZero(): Unit = { require(BitStream.validate_offset_bit(buf.length.toLong, currentByte.toLong, currentBit.toLong)) appendBit(false) - }.ensuring(_ => buf.length == old(this).buf.length && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + 1) - - /** - * Append n cleared bits to bitstream - * - * @param nBits number of bits - * - */ - @opaque @inlineOnce - def appendNZeroBits(nBits: Long): Unit = { - 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)) - appendNBits(nBits, false) - }.ensuring { _ => + }.ensuring(_ => val w1 = old(this) val w2 = this - w1.buf.length == w2.buf.length - && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit ) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits - /*&& w1.isPrefixOf(w2) && { - val (r1, r2) = reader(w1, w2) - validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) - val (r2Got, bGot) = r1.checkBitsLoopPure(nBits, false, 0) - bGot && r2Got == r2 - }*/ - } + w2.buf.length == w1.buf.length && + BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + 1 + && w1.isPrefixOf(w2) + && { + val r = readerFrom(w2, w1.currentBit, w1.currentByte) + val (r2Got, bGot) = r.readBitPure() + bGot == false + && r2Got == this && + r2Got.bitIndex == this.bitIndex + } + ) @opaque @inlineOnce def appendNBits(nBits: Long, bit: Boolean): Unit = { @@ -877,12 +943,13 @@ case class BitStream private [asn1scala]( val w2 = this w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit ) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits - /*&& w1.isPrefixOf(w2) && { + && w1.isPrefixOf(w2) + && { val (r1, r2) = reader(w1, w2) validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) val (r2Got, bGot) = r1.checkBitsLoopPure(nBits, bit, 0) bGot && r2Got == r2 - }*/ + } } @opaque @inlineOnce @@ -891,17 +958,17 @@ case class BitStream private [asn1scala]( require(0 <= from && from <= nBits) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - from)) decreases(nBits - from) + @ghost val oldThis = snapshot(this) if (from < nBits) { @ghost val oldThis1 = snapshot(this) appendBit(bit) - // @ghost val oldThis2 = snapshot(this) + @ghost val oldThis2 = snapshot(this) ghostExpr { BitStream.validateOffsetBitsIneqLemma(oldThis1, this, nBits - from, 1) } appendNBitsLoop(nBits, bit, from + 1) - /* ghostExpr { - validTransitiveLemma(oldThis1, oldThis2, this) + lemmaIsPrefixTransitive(oldThis1, oldThis2, this) readBitPrefixLemma(oldThis2.resetAt(oldThis1), this) val (r1_13, r3_13) = reader(oldThis1, this) @@ -917,26 +984,81 @@ case class BitStream private [asn1scala]( assert(r3Got_23 == r3_23) - checkBitsLoopPrefixLemma(r1_13, nBits, bit, from) + // checkBitsLoopPrefixLemma(r1_13, nBits, bit, from) // not needed but speed up verification assert(r2_23 == r1_13.withMovedBitIndex(1)) - check(resGot_13 == resGot_23) + check(resGot_13 == resGot_23) // timeout check(r3Got_13 == r3_13) + } - */ - } /*else { + + } else { ghostExpr { - validReflexiveLemma(this) + lemmaIsPrefixRefl(this) + + assert(nBits == from) } - }*/ + } }.ensuring { _ => val w1 = old(this) val w2 = this - w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + (nBits - from) /*&& w1.isPrefixOf(w2) && { + w1.buf.length == w2.buf.length + && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + (nBits - from) + && w1.isPrefixOf(w2) + && { val (r1, r2) = reader(w1, w2) validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits - from) val (r2Got, bGot) = r1.checkBitsLoopPure(nBits, bit, from) bGot && r2Got == r2 - }*/ + } + } + + /** + * Append n set bits to bitstream + * + * @param nBits number of bits + * + */ + + def appendNOneBits(nBits: Long): Unit = { + 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)) + appendNBits(nBits, true) + }.ensuring { _ => + val w1 = old(this) + val w2 = this + w1.buf.length == w2.buf.length + && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits + && w1.isPrefixOf(w2) + && { + val (r1, r2) = reader(w1, w2) + validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) + val (r2Got, bGot) = r1.checkBitsLoopPure(nBits, true, 0) + bGot && r2Got == r2 + } + } + + /** + * Append n cleared bits to bitstream + * + * @param nBits number of bits + * + */ + def appendNZeroBits(nBits: Long): Unit = { + 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)) + appendNBits(nBits, false) + }.ensuring { _ => + val w1 = old(this) + val w2 = this + w1.buf.length == w2.buf.length + && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits + && w1.isPrefixOf(w2) + && { + val (r1, r2) = reader(w1, w2) + validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) + val (r2Got, bGot) = r1.checkBitsLoopPure(nBits, false, 0) + bGot && r2Got == r2 + } } /** @@ -950,15 +1072,34 @@ case class BitStream private [asn1scala]( * bit 8 as LSB - but we start from 0 in CS * */ - @opaque @inlineOnce private def appendBitFromByte(b: Byte, bitNr: Int): Unit = { require(bitNr >= 0 && bitNr < NO_OF_BITS_IN_BYTE) require(BitStream.validate_offset_bit(buf.length.toLong, currentByte.toLong, currentBit.toLong)) - val bitPosInByte = 1 << ((NO_OF_BITS_IN_BYTE - 1) - bitNr) - appendBit((b.unsignedToInt & bitPosInByte) != 0) + // val bitPosInByte = 1 << ((NO_OF_BITS_IN_BYTE - 1) - bitNr) // change to the following to match spec + val mask = BitAccessMasks(bitNr) + val bit = (b.toUByte & mask) != 0 + appendBit(bit) - }.ensuring(_ => buf.length == old(this).buf.length && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + 1) + }.ensuring(_ => + val w1 = old(this) + val w2 = this + val mask = BitAccessMasks(bitNr) + val bit = (b.toUByte & mask) != 0 + w2.buf.length == w1.buf.length && + BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + 1 + && w1.isPrefixOf(w2) + && { + val r = readerFrom(w2, w1.currentBit, w1.currentByte) + val (r2Got, bGot) = r.readBitPure() + val vGot = r.readBits(1) + bGot == bit + && r2Got == this && + r2Got.bitIndex == this.bitIndex + // && checkByteArrayBitContent(Array(b.toUByte), vGot, bitNr, 0 , 1) + + } + ) /** * Append nBits from the 64bit Integer value v to the bitstream @@ -970,7 +1111,7 @@ case class BitStream private [asn1scala]( * bit 0 is the LSB of v */ @opaque @inlineOnce - def appendBitsLSBFirst(v: Long, nBits: Int): Unit = { + def appendBitsLSBFirstWhile(v: Long, nBits: Int): Unit = { require(nBits >= 0 && nBits <= NO_OF_BITS_IN_LONG) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) @@ -988,11 +1129,145 @@ case class BitStream private [asn1scala]( i += 1 assert(BitStream.invariant(currentBit, currentByte, buf.length)) - ).invariant(i >= 0 && BitStream.invariant(currentBit, currentByte, buf.length) && i <= nBits &&& - buf.length == oldThis.buf.length &&& - BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) + i &&& + ).invariant( + i >= 0 && + BitStream.invariant(currentBit, currentByte, buf.length) && i <= nBits && + buf.length == oldThis.buf.length && + BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) + i && BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) - }.ensuring(_ => buf.length == old(this).buf.length && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits) + }.ensuring(_ => + buf.length == old(this).buf.length && + BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits + + ) + + def appendBitsLSBFirst(v: Long, nBits: Int): Unit = { + require(nBits >= 0 && nBits <= NO_OF_BITS_IN_LONG) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) + + @ghost val oldThis = snapshot(this) + assert(BitStream.invariant(this)) + assert(BitStream.invariant(currentBit, currentByte, buf.length)) + + appendBitsLSBFirstLoopTR(v, nBits, 0) + }.ensuring(_ => + val w1 = old(this) + val w2 = this + buf.length == old(this).buf.length + && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits + && w1.buf.length == w2.buf.length + && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits + && w1.isPrefixOf(w2) + && { + val (r1, r2) = reader(w1, w2) + validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) + val (r2Got, vGot) = r1.readNBitsLSBFirstPure(nBits) + vGot == (v & onesLSBLong(nBits)) && r2Got == r2 + } + + ) + + def appendBitsLSBFirstLoopTR(v: Long, nBits: Int, i: Int): Unit = { + require(nBits >= 0 && nBits <= NO_OF_BITS_IN_LONG) + require(0 <= i && i <= nBits) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) + + decreases(nBits - i) + + @ghost val oldThis = snapshot(this) + assert(BitStream.invariant(this)) + assert(BitStream.invariant(currentBit, currentByte, buf.length)) + + if(i == nBits) { + assert(BitStream.invariant(currentBit, currentByte, buf.length) ) + assert(buf.length == oldThis.buf.length ) + assert(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) + nBits - i ) + ghostExpr(lemmaIsPrefixRefl(this)) + assert(oldThis.isPrefixOf(this)) + () + } else { + val ii = v & (1L << i) + val b = ii != 0 + + appendBit(b) + + @ghost val oldThis2 = snapshot(this) + assert(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) + 1 ) + assert(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit) ) + assert(BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit) == BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) + 1 ) + + val res = appendBitsLSBFirstLoopTR(v, nBits, i + 1) + + ghostExpr(lemmaIsPrefixTransitive(oldThis, oldThis2, this)) + + assert(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit) + nBits - i - 1) + + assert(BitStream.invariant(currentBit, currentByte, buf.length) ) + assert(buf.length == oldThis.buf.length ) + assert(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) + nBits - i ) + + assert(oldThis2.isPrefixOf(this)) + assert(oldThis.isPrefixOf(oldThis2)) + + ghostExpr({ + readBitPrefixLemma(oldThis2.resetAt(oldThis), this) + + val (r1_13, r3_13) = reader(oldThis, this) + val (r2_23, r3_23) = reader(oldThis2, this) + val (_, bitGot) = r1_13.readBitPure() + check(bitGot == b) + + val zeroed = v & onesLSBLong(i) + validateOffsetBitsContentIrrelevancyLemma(oldThis, this.buf, nBits - i) + val (r3Got_13, resGot_13) = r1_13.readNBitsLSBFirstsLoopPure(nBits, i, zeroed) + + val upd = zeroed | (if bitGot then 1L << i else 0) + validateOffsetBitsContentIrrelevancyLemma(oldThis2, this.buf, nBits - i - 1) + val (r3Got_23, resGot_23) = r2_23.readNBitsLSBFirstsLoopPure(nBits, i + 1, upd) + + assert(r3Got_23 == r3_23) + + lemmaReadNBitsLSBFirstsLoopIsCorrect(r1_13, nBits, i, zeroed) + + check(r1_13 == r3_13.withMovedBitIndex(BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) - BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) )) + check(r2_23 == r3_23.withMovedBitIndex(BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit) - BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) )) + check(BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) == BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit) - 1) + + assert(r2_23 == r1_13.withMovedBitIndex(1)) + check(resGot_13 == resGot_23) + assert(BitStream.bitIndex(r3Got_13.buf.length, r3Got_13.currentByte, r3Got_13.currentBit) == BitStream.bitIndex(r3_13.buf.length, r3_13.currentByte, r3_13.currentBit)) + + + // helps with the performance, otherwise it times out even with 600sec sometimes + check(BitStream.invariant(currentBit, currentByte, buf.length) ) + check(oldThis.buf.length == this.buf.length ) + check(BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) == BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit) + nBits - i ) + check(oldThis.isPrefixOf(this) ) + check({ + val (r1, r2) = reader(oldThis, this) + val zeroed = v & onesLSBLong(i) + validateOffsetBitsContentIrrelevancyLemma(oldThis, this.buf, nBits - i) + val (r2Got, vGot) = r1.readNBitsLSBFirstsLoopPure(nBits, i, zeroed) + vGot == (v & onesLSBLong(nBits)) && r2Got == r2 + }) + }) + res + } + }.ensuring(_ => + val w1 = old(this) + val w2 = this + BitStream.invariant(currentBit, currentByte, buf.length) + &&& w1.buf.length == w2.buf.length + &&& BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits - i + &&& w1.isPrefixOf(w2) + &&& { + val (r1, r2) = reader(w1, w2) + val zeroed = v & onesLSBLong(i) + validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits - i) + val (r2Got, vGot) = r1.readNBitsLSBFirstsLoopPure(nBits, i, zeroed) + vGot == (v & onesLSBLong(nBits)) && r2Got == r2 + } + ) /** * Append nBits from the 64bit Integer value v to the bitstream @@ -1014,7 +1289,6 @@ case class BitStream private [asn1scala]( * After bit 24, bit 23 and so on get added * */ - @opaque @inlineOnce def appendNLeastSignificantBits(v: Long, nBits: Int): Unit = { require(nBits >= 0 && nBits <= NO_OF_BITS_IN_LONG) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) @@ -1023,15 +1297,15 @@ case class BitStream private [asn1scala]( }.ensuring { _ => val w1 = old(this) val w2 = this - w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit ) + nBits /*&& w1.isPrefixOf(w2) && { + w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit ) + nBits + && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) val (r2Got, vGot) = r1.readNLeastSignificantBitsPure(nBits) vGot == v && r2Got == r2 - }*/ + } } - @opaque @inlineOnce def appendNLeastSignificantBitsLoop(v: Long, nBits: Int, i: Int): Unit = { require(0 <= i && i <= nBits && nBits <= 64) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) @@ -1040,13 +1314,13 @@ case class BitStream private [asn1scala]( if (i < nBits) { val ii = v & (1L << (nBits - 1 - i)) val b = ii != 0 - // @ghost val oldThis1 = snapshot(this) + @ghost val oldThis1 = snapshot(this) appendBit(b) - // @ghost val oldThis2 = snapshot(this) + @ghost val oldThis2 = snapshot(this) appendNLeastSignificantBitsLoop(v, nBits, i + 1) - /* + ghostExpr { - validTransitiveLemma(oldThis1, oldThis2, this) + lemmaIsPrefixTransitive(oldThis1, oldThis2, this) readBitPrefixLemma(oldThis2.resetAt(oldThis1), this) val (r1_13, r3_13) = reader(oldThis1, this) @@ -1065,27 +1339,154 @@ case class BitStream private [asn1scala]( assert(r3Got_23 == r3_23) readNLeastSignificantBitsLoopPrefixLemma(r1_13, nBits, i, zeroed) - assert(r2_23 == r1_13.withMovedBitIndex(1)) + + check(r1_13 == r3_13.withMovedBitIndex(BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit) - BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) )) + check(r2_23 == r3_23.withMovedBitIndex(BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit) - BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) )) + check(BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit) == BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit) - 1) + + assert(r2_23 == r1_13.withMovedBitIndex(1)) // really slow ~250sec check(resGot_13 == resGot_23) check(r3Got_13 == r3_13) - }*/ - } /*else { + } + } else { ghostExpr { - validReflexiveLemma(this) + lemmaIsPrefixRefl(this) } - }*/ + } }.ensuring { _ => val w1 = old(this) val w2 = this - w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit ) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit ) + (nBits - i) /*&& w1.isPrefixOf(w2) && { + w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit ) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit ) + (nBits - i) + && w1.isPrefixOf(w2) + && { val (r1, r2) = reader(w1, w2) val zeroed = v & ~onesLSBLong(nBits - i) validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits - i) val (r2Got, vGot) = r1.readNLeastSignificantBitsLoopPure(nBits, i, zeroed) vGot == v && r2Got == r2 - }*/ + } } + + + def appendBitsMSBFirstLoop(srcBuffer: Array[UByte], i: Long, to: Long): Unit = { + require(to >= 0) + require(i >= 0) + require(i <= to) + require(i < Long.MaxValue - to) + require(i < Long.MaxValue) + require(to < Long.MaxValue) + require(to <= srcBuffer.length.toLong * 8L) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, to - i)) + decreases(to - i) + + @ghost val beforeAppend = snapshot(this) + @ghost val oldSrcBuffer = snapshot(srcBuffer) + @ghost val bitIndexBeforeAppend = BitStream.bitIndex(buf.length, currentByte, currentBit) + ghostExpr(BitStream.lemmaIsPrefixRefl(this)) + if i < to then + appendBitFromByte(srcBuffer((i / NO_OF_BITS_IN_BYTE).toInt).toRaw, (i % NO_OF_BITS_IN_BYTE).toInt) + @ghost val afterAppend = snapshot(this) + ghostExpr { + BitStream.validateOffsetBitsIneqLemma(beforeAppend, this, to - i, 1) + } + + assert(beforeAppend.isPrefixOf(this)) + assert(beforeAppend.isPrefixOf(afterAppend)) + + ghostExpr({ + val (readerFromStartBeforeLoop, _) = reader(beforeAppend, this) + validateOffsetBitsContentIrrelevancyLemma(beforeAppend, this.buf, 1) + + val listOfBitsFromStartBeforeLoop = bitStreamReadBitsIntoList(readerFromStartBeforeLoop, 1) + val srcListFromI = byteArrayBitContentToList(srcBuffer, i, 1) + check(srcListFromI.head == listOfBitsFromStartBeforeLoop.head) + }) + + appendBitsMSBFirstLoop(srcBuffer, i + 1, to) + + ghostExpr(BitStream.lemmaIsPrefixTransitive(beforeAppend, afterAppend, this)) + assert(afterAppend.isPrefixOf(this)) + assert(beforeAppend.isPrefixOf(this)) + + ghostExpr({ + val snapThis = snapshot(this) + assert(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(beforeAppend.buf.length, beforeAppend.currentByte, beforeAppend.currentBit ) + to - i) + assert(BitStream.invariant(currentBit, currentByte, buf.length) ) + assert(beforeAppend.buf.length == this.buf.length) + assert(beforeAppend.isPrefixOf(this) ) + check(buf.length == beforeAppend.buf.length) + check(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(beforeAppend.buf.length, beforeAppend.currentByte, beforeAppend.currentBit ) + to - i) + check(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(afterAppend.buf.length, afterAppend.currentByte, afterAppend.currentBit ) + to - i - 1) + assert(afterAppend.buf.length == this.buf.length) + assert(BitStream.invariant(afterAppend.currentBit, afterAppend.currentByte, afterAppend.buf.length) ) + assert(BitStream.invariant(afterAppend.currentBit, afterAppend.currentByte, this.buf.length) ) + + val (readerFromStart, _) = reader(beforeAppend, this) + validateOffsetBitsContentIrrelevancyLemma(beforeAppend, this.buf, to - i) + + val (readerFromAfterAppend, _) = reader(afterAppend, this) + + validateOffsetBitsContentIrrelevancyLemma(afterAppend, this.buf, to - i - 1) + + val srcListFromI = byteArrayBitContentToList(srcBuffer, i, to - i) + val srcListFromIPlusOne = byteArrayBitContentToList(srcBuffer, i + 1, to - i - 1) + + val listOfBitsFromStart = bitStreamReadBitsIntoList(readerFromStart, to - i) + val listOfBitsFromAfterAppend = bitStreamReadBitsIntoList(readerFromAfterAppend, to - i - 1) + + assert(to - i != 0) + assert(listOfBitsFromStart.length > 0) + lemmaBitStreamReadBitsIntoListFromBitIndexPlusOneIsTail(snapThis, readerFromStart, readerFromAfterAppend, to - i, listOfBitsFromStart) + assert(listOfBitsFromStart.tail == listOfBitsFromAfterAppend) + + assert(bitAt(readerFromStart.buf, bitIndexBeforeAppend) == bitAt(readerFromAfterAppend.buf, bitIndexBeforeAppend)) + assert(listOfBitsFromStart.head == bitAt(readerFromStart.buf, bitIndexBeforeAppend)) + assert(srcListFromI.head == bitAt(srcBuffer.toArrayRaws, i)) + assert(bitAt(afterAppend.buf, bitIndexBeforeAppend) == bitAt(srcBuffer.toArrayRaws, i)) + + assert(afterAppend.isPrefixOf(this)) + assert(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(afterAppend.buf.length, afterAppend.currentByte, afterAppend.currentBit ) + to - i - 1) + arrayBitRangesEqImpliesEq(afterAppend.buf, this.buf, 0, bitIndexBeforeAppend, BitStream.bitIndex(afterAppend.buf.length, afterAppend.currentByte, afterAppend.currentBit)) + assert(bitAt(afterAppend.buf, bitIndexBeforeAppend) == bitAt(this.buf, bitIndexBeforeAppend)) + + assert(bitAt(this.buf, bitIndexBeforeAppend) == bitAt(srcBuffer.toArrayRaws, i)) + assert(readerFromStart.readBitPure()._2 == bitAt(srcBuffer.toArrayRaws, i)) + + assert(listOfBitsFromStart.head == srcListFromI.head) + + }) + else + ghostExpr({ + assert(BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(beforeAppend.buf.length, beforeAppend.currentByte, beforeAppend.currentBit ) + to - i) + assert(BitStream.invariant(currentBit, currentByte, buf.length) ) + assert(beforeAppend.buf.length == this.buf.length ) + assert(beforeAppend.isPrefixOf(this) ) + check(buf.length == beforeAppend.buf.length) + val (r1, r2) = reader(beforeAppend, this) + val vGot = r1.readBits(to - i) + assert(to - i == 0) + check(checkByteArrayBitContent(srcBuffer, vGot, i, 0, to - i)) + }) + + }.ensuring( _ => + BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + to - i + &&& BitStream.invariant(currentBit, currentByte, buf.length) + &&& old(this).buf.length == this.buf.length + &&& old(this).isPrefixOf(this) + &&& + ( + buf.length == old(this).buf.length + && + { + val (r1, r2) = reader(old(this), this) + validateOffsetBitsContentIrrelevancyLemma(old(this), this.buf, to - i) + val listBits = bitStreamReadBitsIntoList(r1, to - i) + val srcList = byteArrayBitContentToList(srcBuffer, i, to - i) + listBits == srcList + } + ) + ) /** * Append nBits from srcBuffer to bitstream * @@ -1097,7 +1498,6 @@ case class BitStream private [asn1scala]( * bit 0 is the MSB of the first byte of srcBuffer * */ - @opaque @inlineOnce def appendBitsMSBFirst(srcBuffer: Array[UByte], nBits: Long, from: Long = 0): Unit = { require(nBits >= 0) require(from >= 0) @@ -1106,23 +1506,188 @@ case class BitStream private [asn1scala]( require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) @ghost val oldThis = snapshot(this) - @ghost val oldSrcBuffer = snapshot(srcBuffer) - var i = from // from - val to = from + nBits - (while i < to do - decreases(to - i) - @ghost val beforeAppend = snapshot(this) - appendBitFromByte(srcBuffer((i / NO_OF_BITS_IN_BYTE).toInt).toRaw, (i % NO_OF_BITS_IN_BYTE).toInt) - ghostExpr { - BitStream.validateOffsetBitsIneqLemma(beforeAppend, this, to - i, 1) - } - i += 1L - ).invariant(i >= from &&& i <= to &&& i / NO_OF_BITS_IN_BYTE <= Int.MaxValue &&& - srcBuffer == oldSrcBuffer &&& - buf.length == oldThis.buf.length &&& - BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(oldThis.buf.length, oldThis.currentByte, oldThis.currentBit ) + (i - from) &&& - BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, to - i)) + @ghost val oldSrc = snapshot(srcBuffer) + appendBitsMSBFirstLoop(srcBuffer, from, from + nBits) + ghostExpr({ + val w1 = oldThis + val w2 = this + assert(srcBuffer == oldSrc) + assert(BitStream.invariant(currentBit, currentByte, buf.length) ) + assert(w1.buf.length == w2.buf.length ) + assert(BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits) + assert(w1.isPrefixOf(w2) ) + + + val (r1, _) = reader(w1, w2) + validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) + val vGot = r1.readBits(nBits) + val (readerr, _) = reader(w1, w2) + // lemmaReadBitsThenGetListIsSameAsGetList(vGot, readerr, nBits) + assert(byteArrayBitContentToList(vGot, 0, nBits) == bitStreamReadBitsIntoList(readerr, nBits)) + + val (readerrr, _) = reader(w1, w2) + assert(bitStreamReadBitsIntoList(readerrr, nBits) == byteArrayBitContentToList(srcBuffer, from, nBits)) // Should work + + lemmaSameBitContentListThenCheckByteArrayBitContent(srcBuffer, vGot, from, 0, nBits) + assert(checkByteArrayBitContent(srcBuffer, vGot, from, 0, nBits) ) + }) + + }.ensuring(_ => + val w1 = old(this) + val w2 = this + srcBuffer == old(srcBuffer) + &&& BitStream.invariant(currentBit, currentByte, buf.length) + &&& w1.buf.length == w2.buf.length + &&& BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits + &&& w1.isPrefixOf(w2) + &&& + { + val (r1, r2) = reader(w1, w2) + validateOffsetBitsContentIrrelevancyLemma(w1, w2.buf, nBits) + val vGot = r1.readBits(nBits) + + checkByteArrayBitContent(srcBuffer, vGot, from, 0, nBits) + } + ) + + /** + * Transforms an array of UByte, for example resulting from a readBits call, into a list of bits, for specification purposes + * + */ + @ghost + @pure + def bitStreamReadBitsIntoList(bitStream: BitStream, nBits: Long): List[Boolean] = { + require(nBits >= 0) + require(BitStream.validate_offset_bits(bitStream.buf.length.toLong, bitStream.currentByte.toLong, bitStream.currentBit.toLong, nBits)) + + decreases(nBits) + val bitStreamSnap = snapshot(bitStream) + if(nBits == 0) then + Nil() + else + val bit = bitStreamSnap.readBit() + Cons(bit, bitStreamReadBitsIntoList(bitStreamSnap, nBits - 1)) + } ensuring( res => if(nBits == 0) then res.isEmpty else res.length > 0 ) // we'd like to prove res.length == nBits but it's not possible because of type mismatch + + @ghost + @opaque + @inlineOnce + def lemmaBitStreamReadBitsIntoListFromBitIndexPlusOneIsTail(base: BitStream, bitStream1: BitStream, bitStream2: BitStream, nBits: Long, listBits: List[Boolean]): Unit = { + require(nBits > 0) + require(listBits.length > 0) + require(bitStream1.isPrefixOf(base)) + require(bitStream2.isPrefixOf(base)) + require(bitStream1.isPrefixOf(bitStream2)) + require(bitStream1.buf == bitStream2.buf) + require(bitStream1.buf == base.buf) + require(BitStream.bitIndex(base.buf.length, base.currentByte, base.currentBit) < Long.MaxValue - nBits) + require(BitStream.bitIndex(bitStream1.buf.length, bitStream1.currentByte, bitStream1.currentBit) + 1 == BitStream.bitIndex(bitStream2.buf.length, bitStream2.currentByte, bitStream2.currentBit)) + require(BitStream.validate_offset_bits(bitStream1.buf.length.toLong, bitStream1.currentByte.toLong, bitStream1.currentBit.toLong, nBits)) + require(BitStream.validate_offset_bits(bitStream2.buf.length.toLong, bitStream2.currentByte.toLong, bitStream2.currentBit.toLong, nBits - 1)) + require(listBits == bitStreamReadBitsIntoList(bitStream1, nBits)) + + if nBits == 1 then + () + else + val bitStream1Snap = snapshot(bitStream1) + assert(bitStream1.readBitPure()._2 == listBits.head) + () + } ensuring(_ => + bitStreamReadBitsIntoList(bitStream2, nBits - 1) == listBits.tail + ) + + + /** + * Transforms an array of UByte, for example resulting from a readBits call, into a list of bits, for specification purposes + * + * @param arr + * @param from + * @param nBits + */ + @ghost + @pure + def byteArrayBitContentToList(arr: Array[UByte], from: Long, nBits: Long): List[Boolean] = { + require(from >= 0) + require(nBits >= 0) + require(from < Long.MaxValue - nBits) + require(from + nBits <= arr.length.toLong * 8L) + decreases(nBits) + if(nBits == 0) then + Nil() + else + val byteIndex = from / 8 + val bitIndex = from % 8 + val mask = BitAccessMasks(bitIndex.toInt) + val b = (arr(byteIndex.toInt).toRaw & mask) != 0 + Cons(b, byteArrayBitContentToList(arr, from + 1, nBits - 1)) + } + + + /** + * Compare the content of two byte arrays at the bit level, from bit from to bit to (from is included, to is excluded) + * + * @param arr1 + * @param arr2 + * @param from1 + * @param from2 + * @param nBits + */ + @ghost + @pure + def checkByteArrayBitContent(arr1: Array[UByte], arr2: Array[UByte], from1: Long, from2: Long, nBits: Long): Boolean = { + require(from1 >= 0) + require(from2 >= 0) + require(nBits >= 0) + require(from2 < Long.MaxValue - nBits) + require(from1 < Long.MaxValue - nBits) + require(from1 + nBits <= arr1.length.toLong * 8L) + require(from2 + nBits <= arr2.length.toLong * 8L) + decreases(nBits) + if(nBits == 0) then + true + else + val byteIndex1 = from1 / 8 + val bitIndex1 = from1 % 8 + val byteIndex2 = from2 / 8 + val bitIndex2 = from2 % 8 + val mask1 = BitAccessMasks(bitIndex1.toInt) + val mask2 = BitAccessMasks(bitIndex2.toInt) + val b1 = (arr1(byteIndex1.toInt).toRaw & mask1) != 0 + val b2 = (arr2(byteIndex2.toInt).toRaw & mask2) != 0 + if b1 != b2 then + false + else + checkByteArrayBitContent(arr1, arr2, from1 + 1, from2 + 1, nBits - 1) + } + + @opaque + @ghost + @pure + def lemmaSameBitContentListThenCheckByteArrayBitContent(arr1: Array[UByte], arr2: Array[UByte], fromArr1: Long, fromArr2: Long, nBits: Long): Unit = { + require(fromArr1 >= 0) + require(fromArr2 >= 0) + require(nBits >= 0) + require(fromArr1 < Long.MaxValue - nBits) + require(fromArr2 < Long.MaxValue - nBits) + require(fromArr1 + nBits <= arr1.length.toLong * 8L) + require(fromArr2 + nBits <= arr2.length.toLong * 8L) + require(byteArrayBitContentToList(arr2, fromArr2, nBits) == byteArrayBitContentToList(arr1, fromArr1, nBits)) + decreases(nBits) + if nBits > 0 then + lemmaSameBitContentListThenCheckByteArrayBitContent(arr1, arr2, fromArr1 + 1, fromArr2 + 1, nBits - 1) + } ensuring(_ => checkByteArrayBitContent(arr1, arr2, fromArr1, fromArr2, nBits)) + + + + @extern + def appendBitsMSBFirstVec(srcBuffer: Vector[UByte], nBits: Long, from: Long = 0): Unit = { + require(nBits >= 0) + require(from >= 0) + require(from < Long.MaxValue - nBits) + require(nBits + from <= srcBuffer.length.toLong * 8L) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) + appendBitsMSBFirst(srcBuffer.toScala.toArray, nBits, from) }.ensuring(_ => srcBuffer == old(srcBuffer) && buf.length == old(this).buf.length && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + nBits) // ****************** Append Byte Functions ********************** @@ -1163,7 +1728,7 @@ case class BitStream private [asn1scala]( val mask2 = MASK_B(8 - totalBits) val mask = (mask1 | mask2).toByte buf(currentByte) = wrappingExpr { ((buf(currentByte) & mask) | (vv << (8 - totalBits))).toByte } - /*ghostExpr { + ghostExpr { arrayUpdatedAtPrefixLemma(oldThis.buf, currentByte, buf(currentByte)) assert(arrayRangesEq(oldThis.buf, buf, 0, currentByte)) assert( @@ -1174,16 +1739,16 @@ case class BitStream private [asn1scala]( oldThis.currentBit ) ) - }*/ + } moveBitIndex(nBits) else val totalBitsForNextByte = totalBits - 8 buf(currentByte) = wrappingExpr { ((buf(currentByte) & mask1) | ((vv & 0XFF) >>> totalBitsForNextByte)).toByte } - // @ghost val oldThis2 = snapshot(this) + @ghost val oldThis2 = snapshot(this) currentByte += 1 val mask = MASK_B(8 - totalBitsForNextByte).toByte buf(currentByte) = wrappingExpr { ((buf(currentByte) & mask) | (vv << (8 - totalBitsForNextByte))).toByte } - /*ghostExpr { + ghostExpr { arrayUpdatedAtPrefixLemma(oldThis.buf, currentByte - 1, buf(currentByte - 1)) arrayUpdatedAtPrefixLemma(oldThis2.buf, currentByte, buf(currentByte)) arrayRangesEqTransitive( @@ -1200,16 +1765,17 @@ case class BitStream private [asn1scala]( totalBitsForNextByte ) ) - }*/ + } currentBit = totalBitsForNextByte }.ensuring { _ => val w1 = old(this) val w2 = this - w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits /* && w1.isPrefixOf(w2) && { + w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + nBits + && w1.isPrefixOf(w2) && { val (r1, r2) = reader(w1, w2) val (r2Got, vGot) = r1.readPartialBytePure(nBits) vGot.toRaw == wrappingExpr { (v.toRaw & MASK_B(nBits)).toByte } && r2Got == r2 - }*/ + } } /** @@ -1236,7 +1802,7 @@ case class BitStream private [asn1scala]( def appendByte(v: UByte): Unit = { require(BitStream.validate_offset_byte(buf.length.toLong, currentByte.toLong, currentBit.toLong)) - // @ghost val oldThis = snapshot(this) + @ghost val oldThis = snapshot(this) val cb = currentBit.toByte val ncb = (8 - cb).toByte var mask = (~MASK_B(ncb)).toByte @@ -1245,7 +1811,7 @@ case class BitStream private [asn1scala]( buf(currentByte) = wrappingExpr { (buf(currentByte) | ((v.toRaw & 0xFF) >>> cb)).toByte } currentByte += 1 - /*ghostExpr { + ghostExpr { check( (oldThis.currentByte < oldThis.buf.length) ==> byteRangesEq( @@ -1253,14 +1819,14 @@ case class BitStream private [asn1scala]( buf(oldThis.currentByte), 0, oldThis.currentBit)) } - @ghost val oldThis2 = snapshot(this)*/ + @ghost val oldThis2 = snapshot(this) if cb > 0 then mask = (~mask).toByte buf(currentByte) = wrappingExpr { (buf(currentByte) & mask).toByte } buf(currentByte) = wrappingExpr { (buf(currentByte) | (v.toRaw << ncb)).toByte } - /*ghostExpr { + ghostExpr { arrayUpdatedAtPrefixLemma(oldThis.buf, currentByte - 1, buf(currentByte - 1)) assert(arrayRangesEq(oldThis.buf, oldThis2.buf, 0, currentByte - 1)) @@ -1286,15 +1852,17 @@ case class BitStream private [asn1scala]( 0, oldThis.currentByte )) - }*/ + } }.ensuring { _ => val w1 = old(this) val w2 = this - w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + 8 /*&& w1.isPrefixOf(w2) && { + w1.buf.length == w2.buf.length && BitStream.bitIndex(w2.buf.length, w2.currentByte, w2.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + 8 + && w1.isPrefixOf(w2) + && { val (r1, r2) = reader(w1, w2) val (r2Got, vGot) = r1.readBytePure() vGot == v && r2Got == r2 - }*/ + } } /** @@ -1312,6 +1880,18 @@ case class BitStream private [asn1scala]( require(BitStream.validate_offset_bytes(buf.length.toLong, currentByte.toLong, currentBit.toLong, noOfBytes)) appendByteArrayLoop(arr, 0, noOfBytes) + }.ensuring { _ => + val w1 = old(this) + val w3 = this + w1.buf.length == w3.buf.length + && BitStream.bitIndex(w3.buf.length, w3.currentByte, w3.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + noOfBytes.toLong * 8L + && w1.isPrefixOf(w3) + && { + val (r1, r3) = reader(w1, w3) + validateOffsetBitsContentIrrelevancyLemma(w1, w3.buf, noOfBytes) + val (r3Got, arrGot) = r1.readByteArrayLoopPure(arr, 0, noOfBytes) + arrGot.length == arr.length && r3Got == r3 && arrayRangesEq(arr, arrGot, 0, noOfBytes) + } } @opaque @inlineOnce @@ -1327,15 +1907,15 @@ case class BitStream private [asn1scala]( assert(BitStream.invariant( oldThis1.currentBit, oldThis1.currentByte, oldThis1.buf.length)) assert((BitStream.validate_offset_bytes(oldThis1.buf.length.toLong, oldThis1.currentByte.toLong, oldThis1.currentBit.toLong, to - from))) appendByte(arr(from)) - // @ghost val oldThis2 = snapshot(this) + @ghost val oldThis2 = snapshot(this) ghostExpr { assert((BitStream.validate_offset_bytes(oldThis1.buf.length.toLong, oldThis1.currentByte.toLong, oldThis1.currentBit.toLong, to - from))) validateOffsetBytesFromBitIndexLemma(oldThis1, this, 8, to - from) } appendByteArrayLoop(arr, from + 1, to) - /* + ghostExpr { - validTransitiveLemma(oldThis1, oldThis2, this) + lemmaIsPrefixTransitive(oldThis1, oldThis2, this) val oldThis2Reset = oldThis2.resetAt(oldThis1) readBytePrefixLemma(oldThis2Reset, this) val (r1_13, r3_13) = reader(oldThis1, this) @@ -1352,21 +1932,36 @@ case class BitStream private [asn1scala]( arrayRangesEqSymmetricLemma(arrGot_13, arrGot_23, 0, to) arrayRangesEqTransitive(arr, arrGot_23, arrGot_13, 0, to, to) check(arrayRangesEq(arr, arrGot_13, 0, to)) - }*/ - } /*else { + } + } else { ghostExpr { - validReflexiveLemma(this) + lemmaIsPrefixRefl(this) } - }*/ + } }.ensuring { _ => val w1 = old(this) val w3 = this - w1.buf.length == w3.buf.length && BitStream.bitIndex(w3.buf.length, w3.currentByte, w3.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + (to - from).toLong * 8L /*&& w1.isPrefixOf(w3) && { + w1.buf.length == w3.buf.length + && BitStream.bitIndex(w3.buf.length, w3.currentByte, w3.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + (to - from).toLong * 8L + && w1.isPrefixOf(w3) + && { val (r1, r3) = reader(w1, w3) validateOffsetBitsContentIrrelevancyLemma(w1, w3.buf, to - from) val (r3Got, arrGot) = r1.readByteArrayLoopPure(arr, from, to) arrGot.length == arr.length && r3Got == r3 && arrayRangesEq(arr, arrGot, 0, to) - }*/ + } + } + + @extern + def appendByteVec(arr: Vector[UByte], noOfBytes: Int): Unit = { + require(0 <= noOfBytes && noOfBytes <= arr.length) + require(BitStream.validate_offset_bytes(buf.length.toLong, currentByte.toLong, currentBit.toLong, noOfBytes)) + + appendByteArray(arr.toScala.toArray, noOfBytes) + }.ensuring { _ => + val w1 = old(this) + val w3 = this + w1.buf.length == w3.buf.length && BitStream.bitIndex(w3.buf.length, w3.currentByte, w3.currentBit) == BitStream.bitIndex(w1.buf.length, w1.currentByte, w1.currentBit) + noOfBytes.toLong * 8L } // ****************** Peak Functions ********************** @@ -1391,9 +1986,8 @@ case class BitStream private [asn1scala]( * @return next bit on the bitstream * */ - @opaque @inlineOnce def readBit(): Boolean = { - require(BitStream.validate_offset_bit(buf.length.toLong, currentByte.toLong, currentBit.toLong)) + require(validate_offset_bits(1)) val ret = (buf(currentByte) & BitAccessMasks(currentBit)) != 0 increaseBitIndex() ret @@ -1401,7 +1995,7 @@ case class BitStream private [asn1scala]( @ghost @pure def readBitPure(): (BitStream, Boolean) = { - require(BitStream.validate_offset_bit(buf.length.toLong, currentByte.toLong, currentBit.toLong)) + require(validate_offset_bits(1)) val cpy = snapshot(this) val b = cpy.readBit() (cpy, b) @@ -1435,7 +2029,6 @@ case class BitStream private [asn1scala]( * MSB byte 0 MSB byte 1 * */ - @opaque @inlineOnce def readBits(nBits: Long): Array[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)) @@ -1445,13 +2038,15 @@ case class BitStream private [asn1scala]( readBitsLoop(nBits, arr, 0, nBits) UByte.fromArrayRaws(arr) } ensuring(res => - buf == old(this).buf && BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) && - BitStream.invariant(this.currentBit, this.currentByte, this.buf.length) && - res.length == ((nBits + NO_OF_BITS_IN_BYTE - 1) / NO_OF_BITS_IN_BYTE).toInt + buf == old(this).buf + &&& BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) + &&& BitStream.invariant(this.currentBit, this.currentByte, this.buf.length) + &&& res.length == ((nBits + NO_OF_BITS_IN_BYTE - 1) / NO_OF_BITS_IN_BYTE).toInt + &&& old(this).currentByte <= this.currentByte + &&& byteArrayBitContentToList(res, 0, nBits) == bitStreamReadBitsIntoList(old(this), nBits) + ) - )// && old(this).currentByte <= this.currentByte) - @opaque @inlineOnce def readBitsLoop(nBits: Long, arr: Array[Byte], from: Long, to: Long): Unit = { require(0 <= nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) require(arr.length >= ((nBits + NO_OF_BITS_IN_BYTE - 1) / NO_OF_BITS_IN_BYTE)) @@ -1467,8 +2062,8 @@ case class BitStream private [asn1scala]( val bitIx = (from % NO_OF_BITS_IN_BYTE).toInt arr(byteIx) = stainless.math.wrapping { ((arr(byteIx) & ~BitAccessMasks(bitIx)) | (if bit then BitAccessMasks(bitIx) else 0)).toByte } - // @ghost val arr2 = snapshot(arr) - // @ghost val oldThis2 = snapshot(this) + @ghost val arr2 = snapshot(arr) + @ghost val oldThis2 = snapshot(this) ghostExpr { BitStream.validateOffsetBitsIneqLemma(oldThis1, this, nBits - from, 1) } @@ -1479,14 +2074,14 @@ case class BitStream private [asn1scala]( BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit ) + to - from == BitStream.bitIndex(buf.length, currentByte, currentBit) && oldThis1.buf == buf && arr1.length == arr.length } - /* + arrayBitRangesUpdatedAtLemma(arr1, from, bit) arrayBitRangesEqTransitive(arr1, arr2, arr, 0, from, from + 1) check(arrayBitRangesEq(arr1, arr, 0, from)) arrayBitRangesEqImpliesEq(arr2, arr, 0, from, from + 1) check(arrayBitRangesEq(arr1, arr, 0, from)) - check(bitAt(arr, from) == bit)*/ + check(bitAt(arr, from) == bit) } } else { ghostExpr { @@ -1496,13 +2091,26 @@ case class BitStream private [asn1scala]( } }.ensuring { _ => BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + to - from == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ) && - old(this).buf == this.buf && - old(arr).length == arr.length && - // arrayBitRangesEq(old(arr), arr, 0, from) && - // ((from < to) ==> (bitAt(arr, from) == old(this).readBitPure()._2)) && - BitStream.invariant(this.currentBit, this.currentByte, this.buf.length) + old(this).buf == this.buf + &&& old(arr).length == arr.length + &&& arrayBitRangesEq(old(arr), arr, 0, from) + &&& (if (from < to) then (bitAt(arr, from) == old(this).readBitPure()._2) else true) + &&& BitStream.invariant(this.currentBit, this.currentByte, this.buf.length) + &&& byteArrayBitContentToList(UByte.fromArrayRaws(arr), from, to - from) == bitStreamReadBitsIntoList(old(this), to - from) } + @extern + def readBitsVec(nBits: Long): 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 arr = readBits(nBits) + Vector.fromScala(arr.toVector) + } ensuring(res => + buf == old(this).buf && BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) && + BitStream.invariant(this.currentBit, this.currentByte, this.buf.length) && + res.length == ((nBits + NO_OF_BITS_IN_BYTE - 1) / NO_OF_BITS_IN_BYTE).toInt + ) + @opaque @inlineOnce def checkBitsLoop(nBits: Long, expected: Boolean, from: Long): Boolean = { require(0 <= nBits && nBits <= Int.MaxValue.toLong * NO_OF_BITS_IN_BYTE.toLong) @@ -1524,8 +2132,9 @@ case class BitStream private [asn1scala]( }.ensuring { ok => BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + nBits - from >= BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ) && old(this).buf == this.buf && - (ok ==> (BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + nBits - from == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ))) /*&& - ((ok && from < nBits) ==> (expected == old(this).readBitPure()._2))*/ + (if(nBits == from) ok else true) && + (ok ==> (BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + nBits - from == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ))) + && ((ok && from < nBits) ==> (expected == old(this).readBitPure()._2)) } @ghost @pure @@ -1538,6 +2147,63 @@ case class BitStream private [asn1scala]( (cpy, res) } + /** + * Counter Operation to appendBitsLSBFirst + * @param nBits number of bits to read [0-64] + * @return value that holds nBits from bitstream + * + * Remarks: + * The first bit from the bitstream will get written into the LSB + */ + def readNBitsLSBFirst(nBits: Int): Long = { + require(nBits >= 0 && nBits <= 64) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) + readNBitsLSBFirstsLoop(nBits, 0, 0L) + }.ensuring(_ => + buf == old(this).buf + && BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits) + + @ghost @pure + def readNBitsLSBFirstPure(nBits: Int): (BitStream, Long) = { + require(nBits >= 0 && nBits <= 64) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) + val cpy = snapshot(this) + val res = cpy.readNBitsLSBFirst(nBits) + (cpy, res) + } + + def readNBitsLSBFirstsLoop(nBits: Int, i: Int, acc: Long): Long = { + require(0 <= i && i <= nBits && nBits <= 64) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) + require((acc & onesMSBLong(64 - i)) == 0L) // The 64 - i MSBs must be 0 + require((acc & onesMSBLong(64)) == acc) + decreases(nBits - i) + if (nBits == i) { + acc + } else { + val bit = readBit() + val newAcc = acc | (if bit then 1L << i else 0) + readNBitsLSBFirstsLoop(nBits, i + 1, newAcc) + } + }.ensuring { res => + buf == old(this).buf && + BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + (nBits - i) + && (res & onesLSBLong(i)) == (acc & onesLSBLong(i)) + && (res & onesLSBLong(nBits)) == res + && (if (i < nBits) then ((((res >>> i) & 1) == 1) == old(this).readBitPure()._2) else true) + } + + @ghost @pure + def readNBitsLSBFirstsLoopPure(nBits: Int, i: Int, acc: Long): (BitStream, Long) = { + require(0 <= i && i <= nBits && nBits <= 64) + require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) + require((acc & onesMSBLong(64 - i)) == 0L) // The 64 - i MSBs must be 0 + require((acc & onesMSBLong(64)) == acc) + val cpy = snapshot(this) + val res = cpy.readNBitsLSBFirstsLoop(nBits, i, acc) + (cpy, res) + } + /** * Counter Operation to appendNLeastSignificantBits * @param nBits number of bits to read [0-64] @@ -1546,7 +2212,6 @@ case class BitStream private [asn1scala]( * Remarks: * The last bit from the bitstream will get written into the LSB */ - @opaque @inlineOnce def readNLeastSignificantBits(nBits: Int): Long = { require(nBits >= 0 && nBits <= 64) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) @@ -1562,7 +2227,6 @@ case class BitStream private [asn1scala]( (cpy, res) } - @opaque @inlineOnce def readNLeastSignificantBitsLoop(nBits: Int, i: Int, acc: Long): Long = { require(0 <= i && i <= nBits && nBits <= 64) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits - i)) @@ -1580,8 +2244,8 @@ case class BitStream private [asn1scala]( buf == old(this).buf && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + (nBits - i) && (res >>> (nBits - i) == acc >>> (nBits - i)) && - (res & onesLSBLong(nBits)) == res /*&& - (i < nBits) ==> ((((res >>> (nBits - 1 - i)) & 1) == 1) == old(this).readBitPure()._2)*/ + (res & onesLSBLong(nBits)) == res && + (i < nBits) ==> ((((res >>> (nBits - 1 - i)) & 1) == 1) == old(this).readBitPure()._2) } @ghost @pure @@ -1606,19 +2270,21 @@ case class BitStream private [asn1scala]( * First bit read from bitstream is the return bytes MSB * */ - @opaque @inlineOnce def readByte(): UByte = { require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, 8)) - val cb = currentBit.toByte + val cb = this.currentBit.toByte val ncb = (8 - cb).toByte - var v = wrappingExpr { (buf(currentByte) << cb).toByte } - currentByte += 1 + var v = wrappingExpr { (this.buf(this.currentByte) << cb).toByte } + this.currentByte += 1 if cb > 0 then - v = wrappingExpr { (v | (buf(currentByte) & 0xFF) >>> ncb).toByte } + v = wrappingExpr { (v | (this.buf(this.currentByte) & 0xFF) >>> ncb).toByte } UByte.fromRaw(v) - }.ensuring(_ => buf == old(this).buf && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + 8) + }.ensuring(_ => + buf == old(this).buf + && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + 8 + ) @ghost @pure def readBytePure(): (BitStream, UByte) = { @@ -1637,29 +2303,29 @@ case class BitStream private [asn1scala]( arr } - @opaque @inlineOnce def readByteArrayLoop(arr: Array[UByte], i: Int, to: Int): Unit = { require(0 <= i && i <= to && to <= arr.length) require(BitStream.validate_offset_bytes(buf.length.toLong, currentByte.toLong, currentBit.toLong, to - i)) decreases(to - i) - if (i < to) { - // @ghost val arr1 = snapshot(arr) - @ghost val oldThis1 = snapshot(this) + @ghost val oldThis1 =snapshot(this) + if (i < to) { + @ghost val arr1 = snapshot(arr) val b = readByte() arr(i) = b - // @ghost val arr2 = snapshot(arr) + @ghost val arr2 = snapshot(arr) + @ghost val oldThis2 = snapshot(this) ghostExpr { validateOffsetBytesFromBitIndexLemma(oldThis1, this, 8, to - i) } readByteArrayLoop(arr, i + 1, to) - /*ghostExpr { - check { - BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit ) + (to - i).toLong * 8L == BitStream.bitIndex(buf.length, currentByte, currentBit) && - oldThis1.buf == buf && arr1.length == arr.length - } + ghostExpr { + check(BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit ) == BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit) + 8L) + check(BitStream.bitIndex(oldThis2.buf.length, oldThis2.currentByte, oldThis2.currentBit ) + (to - i - 1) * 8L == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit)) + check(BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit ) + (to - i) * 8L == BitStream.bitIndex(buf.length, currentByte, currentBit)) + check(oldThis1.buf == buf && arr1.length == arr.length) arrayUpdatedAtPrefixLemma(arr1, i, b) arrayRangesEqTransitive(arr1, arr2, arr, 0, i, i + 1) @@ -1667,19 +2333,20 @@ case class BitStream private [asn1scala]( arrayRangesEqImpliesEq(arr2, arr, 0, i, i + 1) check(arr(i) == b) - }*/ - } /*else { + } + } else { ghostExpr { + check(BitStream.bitIndex(oldThis1.buf.length, oldThis1.currentByte, oldThis1.currentBit ) == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit)) arrayRangesEqReflexiveLemma(arr) arrayRangesEqSlicedLemma(arr, snapshot(arr), 0, arr.length, 0, i) } - }*/ + } }.ensuring { _ => - BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + (to - i).toLong * 8L == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ) && - old(this).buf == this.buf && - old(arr).length == arr.length /*&& - arrayRangesEq(old(arr), arr, 0, i) && - (i < to) ==> (arr(i) == old(this).readBytePure()._2)*/ + BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + (to - i) * 8L == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit) + && old(this).buf == this.buf + && old(arr).length == arr.length + && arrayRangesEq(old(arr), arr, 0, i) + (i < to) ==> (arr(i) == old(this).readBytePure()._2) } @ghost @pure @@ -1693,6 +2360,19 @@ case class BitStream private [asn1scala]( (cpy, arrCpy) } + @extern + def readByteVec(nBytes: Int): Vector[UByte] = { + require(nBytes >= 0) + require(BitStream.validate_offset_bytes(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBytes)) + + val arr = readByteArray(nBytes) + Vector.fromScala(arr.toVector) + }.ensuring { res => + BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit ) + nBytes.toLong * 8L == BitStream.bitIndex(this.buf.length, this.currentByte, this.currentBit ) && + old(this).buf == this.buf && + res.length == nBytes + } + /** * Read nBits from Bitstream into Byte * @@ -1723,7 +2403,6 @@ case class BitStream private [asn1scala]( * and written into v * */ - @opaque @inlineOnce def readPartialByte(nBits: Int): UByte = { require(nBits >= 1 && nBits < NO_OF_BITS_IN_BYTE) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) @@ -1743,7 +2422,9 @@ case class BitStream private [asn1scala]( v = wrappingExpr { (v & MASK_B(nBits)).toByte } currentBit = totalBitsForNextByte UByte.fromRaw(v) - }.ensuring(_ => buf == old(this).buf && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits) + }.ensuring(_ => + buf == old(this).buf + && BitStream.bitIndex(buf.length, currentByte, currentBit) == BitStream.bitIndex(old(this).buf.length, old(this).currentByte, old(this).currentBit) + nBits) @pure @ghost def readPartialBytePure(nBits: Int): (BitStream, UByte) = { @@ -1754,7 +2435,6 @@ case class BitStream private [asn1scala]( (cpy, b) } - @opaque @inlineOnce def checkBitPatternPresent(bit_terminated_pattern: Array[UByte], nBits: Long): Boolean = { require(nBits >= 0) require(BitStream.validate_offset_bits(buf.length.toLong, currentByte.toLong, currentBit.toLong, nBits)) diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala index f99f73b5d..a68eca4e6 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec.scala @@ -69,10 +69,8 @@ object Codec { (Codec(r1), Codec(r2)) } - // For showing invertibility of encoding - not fully integrated yet - /* @ghost @pure - def decodeUnconstrainedWholeNumber_prefixLemma_helper(c1: Codec, c2: Codec): (Codec, Codec, Long, Codec, Long) = { + def decodeUnconstrainedWholeNumber_prefixLemma_helper(c1: Codec, c2: Codec): (Codec, Codec, Option[Long], Codec, Option[Long]) = { require(c1.bufLength() == c2.bufLength()) require(BitStream.validate_offset_bytes(c1.bitStream.buf.length.toLong, c1.bitStream.currentByte.toLong, c1.bitStream.currentBit.toLong,1)) val nBytes = c1.bitStream.readBytePure()._2.unsignedToInt @@ -142,7 +140,6 @@ 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) } } - */ } /** @@ -151,7 +148,7 @@ object Codec { * @param count represents the number of bytes in the internal buffer * */ -case class Codec private [asn1scala](bitStream: BitStream) { +case class Codec(bitStream: BitStream) { import Codec.* import BitStream.{reader => _, *} export bitStream.{resetAt => _, withMovedByteIndex => _, withMovedBitIndex => _, isPrefixOf => _, *} @@ -266,24 +263,23 @@ case class Codec private [asn1scala](bitStream: BitStream) { val encVal = v - min @ghost val nEncValBits = GetBitCountUnsigned(encVal) - // assert(nRangeBits >= nEncValBits) // TODO: T.O appendNLeastSignificantBits(encVal, nRangeBits) - // else - // ghostExpr { - // validReflexiveLemma(bitStream) - // } + else + ghostExpr { + lemmaIsPrefixRefl(bitStream) + } }.ensuring { _ => val w1 = old(this) val w2 = this val range = max - min 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) && { + 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) val (r2Got, vGot) = r1.decodeConstrainedPosWholeNumberPure(min, max) vGot == v && r2Got == r2 - }*/ + } } /** @@ -344,9 +340,9 @@ case class Codec private [asn1scala](bitStream: BitStream) { */ @opaque @inlineOnce def encodeConstrainedWholeNumber(v: Long, min: Long, max: Long): Unit = { - require(min <= max) - require(min <= v && v <= max) - require(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, GetBitCountUnsigned(stainless.math.wrapping(max - min).toRawULong))) // SAM There was a bug here, we checked for N bytes even though the number returned by teh function is bits + staticRequire(min <= max) + staticRequire(min <= v && v <= max) + staticRequire(BitStream.validate_offset_bits(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, GetBitCountUnsigned(stainless.math.wrapping(max - min).toRawULong))) // SAM There was a bug here, we checked for N bytes even though the number returned by teh function is bits val range: Long = stainless.math.wrapping(max - min) // get number of bits that get written val nRangeBits: Int = GetBitCountUnsigned(range.toRawULong) @@ -362,7 +358,7 @@ case class Codec private [asn1scala](bitStream: BitStream) { appendNLeastSignificantBits(encVal, nRangeBits) // else // ghostExpr { - // validReflexiveLemma(bitStream) + // lemmaIsPrefixRefl(bitStream) // } }.ensuring { _ => val w1 = old(this) @@ -667,27 +663,40 @@ case class Codec private [asn1scala](bitStream: BitStream) { * @return decoded number */ @opaque @inlineOnce - def decodeUnconstrainedWholeNumber(): Long = { + def decodeUnconstrainedWholeNumber(): Option[Long] = { require(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,1)) // get length val nBytes = readByte().unsignedToInt if (!(0 <= nBytes && nBytes <= 8 && BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit, nBytes))) - 0L + None[Long]() else val nBits = nBytes * NO_OF_BITS_IN_BYTE // check bitstream precondition //SAM assert(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,nBytes)) //SAM assert(0 <= nBytes && nBytes <= 8) - // read value val read = readNLeastSignificantBits(nBits) - // TODO: This was added (sign extension) - if (read == 0 || nBits == 0 || nBits == 64 || (read & (1L << (nBits - 1))) == 0L) read - else onesMSBLong(64 - nBits) | read - }.ensuring(_ => bitStream.buf == old(this).bitStream.buf && bitIndex <= old(this).bitIndex + 72L) + val res = + if (read == 0 || nBits == 0 || nBits == 64 || (read & (1L << (nBits - 1))) == 0L) read + else onesMSBLong(64 - nBits) | read // Sign extension + // A trick to make the postcondition be true and have this function be the inverse of the encoding function + // Note that if this doesn't hold, then the number was probably not properly encoded + if (GetLengthForEncodingSigned(res) != nBytes) None[Long]() + else Some(res) + }.ensuring { res => + val (c2, nBytes0) = old(this).bitStream.readBytePure() + val nBytes = nBytes0.unsignedToInt + res match { + case None() => true + case Some(res) => + 0 <= nBytes && nBytes <= 8 && c2.validate_offset_bytes(nBytes) && bitStream.buf == old(this).bitStream.buf && + bitIndex == old(this).bitStream.bitIndex + 8L + 8L * nBytes.toLong && + GetLengthForEncodingSigned(res) == nBytes + } + } @ghost @pure - def decodeUnconstrainedWholeNumberPure(): (Codec, Long) = { + def decodeUnconstrainedWholeNumberPure(): (Codec, Option[Long]) = { require(BitStream.validate_offset_bytes(bitStream.buf.length, bitStream.currentByte, bitStream.currentBit,1)) staticRequire { val nBytes = bitStream.readBytePure()._2.unsignedToInt @@ -1072,6 +1081,18 @@ case class Codec private [asn1scala](bitStream: BitStream) { 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)) + 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)) + readByteVec(nCount) + } + def encodeOctetString_fragmentation(arr: Array[UByte], nCount: Int) = { require(nCount >= 0 && nCount <= arr.length) require(nCount < Int.MaxValue / 8 - 2 - (nCount / 0x4000) ) // To avoid overflow of the available length checks diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala index 09954122b..356335299 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala @@ -1209,10 +1209,9 @@ case class ACN(base: Codec) { var pBoolValue: Boolean = true var i: Int = 0 - - assert(i >= 0 ) - assert(i <= nBytesToRead ) - assert(nBitsToRead < Int.MaxValue ) + assert(i >= 0) + assert(i <= nBytesToRead) + assert(nBitsToRead < Int.MaxValue) assert(neededBytes <= patternToRead.length) assert(neededBytes == nBytesToRead || neededBytes == nBytesToRead + 1) assert(nBytesToRead <= Int.MaxValue / 8) @@ -1250,7 +1249,7 @@ case class ACN(base: Codec) { nBytesToRead <= Int.MaxValue / 8 &&& base.bitStream.buf == oldThis.base.bitStream.buf && base.bitStream.currentByte >= 0 && base.bitStream.currentBit >= 0 &&& BitStream.invariant(base.bitStream) &&& - BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) <= BitStream.bitIndex(oldThis.base.bitStream.buf.length, oldThis.base.bitStream.currentByte, oldThis.base.bitStream.currentBit) + i * 8L &&& + BitStream.bitIndex(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit) == BitStream.bitIndex(oldThis.base.bitStream.buf.length, oldThis.base.bitStream.currentByte, oldThis.base.bitStream.currentBit) + i * 8L &&& BitStream.validate_offset_bits(base.bitStream.buf.length, base.bitStream.currentByte, base.bitStream.currentBit, nBitsToRead - i * 8L) ) @@ -1261,10 +1260,10 @@ case class ACN(base: Codec) { assert(nBytesToRead.toLong * 8L + nRemainingBitsToRead.toLong == nBitsToRead) ghostExpr { check(BitStream.bitIndex(this.base.bitStream.buf.length, this.base.bitStream.currentByte, this.base.bitStream.currentBit) <= BitStream.bitIndex(oldThis.base.bitStream.buf.length, oldThis.base.bitStream.currentByte, oldThis.base.bitStream.currentBit) + nBitsToRead) } - assert(BitStream.bitIndex(this.base.bitStream.buf.length, this.base.bitStream.currentByte, this.base.bitStream.currentBit) <= BitStream.bitIndex(oldThis.base.bitStream.buf.length, oldThis.base.bitStream.currentByte, oldThis.base.bitStream.currentBit) + nBitsToRead) + assert(BitStream.bitIndex(this.base.bitStream.buf.length, this.base.bitStream.currentByte, this.base.bitStream.currentBit) == BitStream.bitIndex(oldThis.base.bitStream.buf.length, oldThis.base.bitStream.currentByte, oldThis.base.bitStream.currentBit) + nBitsToRead) pBoolValue - }.ensuring(_ => buf == old(this).base.bitStream.buf && BitStream.bitIndex(this.base.bitStream.buf.length, this.base.bitStream.currentByte, this.base.bitStream.currentBit) <= BitStream.bitIndex(old(this).base.bitStream.buf.length, old(this).base.bitStream.currentByte, old(this).base.bitStream.currentBit) + nBitsToRead) + }.ensuring(_ => buf == old(this).base.bitStream.buf && BitStream.bitIndex(this.base.bitStream.buf.length, this.base.bitStream.currentByte, this.base.bitStream.currentBit) == BitStream.bitIndex(old(this).base.bitStream.buf.length, old(this).base.bitStream.currentByte, old(this).base.bitStream.currentBit) + nBitsToRead) @opaque @inlineOnce def BitStream_DecodeTrueFalseBoolean(truePattern: Array[UByte], falsePattern: Array[UByte], nBitsToRead: Int): Option[Boolean] = { @@ -1506,6 +1505,10 @@ case class ACN(base: Codec) { i += 1 } + 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) + } + def enc_String_Ascii_External_Field_Determinant(max: Long, strVal: Array[ASCIIChar]): Unit = { enc_String_Ascii_private(max, strVal) @@ -1591,6 +1594,12 @@ case class ACN(base: Codec) { () }.ensuring(_ => base.bitStream.buf.length == old(this).base.bitStream.buf.length) + @extern + def enc_IA5String_CharIndex_External_Field_DeterminantVec(max: Long, strVal: Vector[ASCIIChar]): Unit = { + require(max < Int.MaxValue && max >= 0) + enc_IA5String_CharIndex_External_Field_Determinant(max, strVal.toScala.toArray) + }.ensuring(_ => base.bitStream.buf.length == old(this).base.bitStream.buf.length) + @opaque @inlineOnce def enc_IA5String_CharIndex_Internal_Field_Determinant(max: Long, min: Long, strVal: Array[ASCIIChar]): Unit = { val allowedCharSet: Array[Byte] = Array( @@ -1614,6 +1623,11 @@ case class ACN(base: Codec) { () }.ensuring(_ => base.bitStream.buf.length == old(this).base.bitStream.buf.length) + @extern + def enc_IA5String_CharIndex_Internal_Field_DeterminantVec(max: Long, min: Long, strVal: Vector[ASCIIChar]): Unit = { + enc_IA5String_CharIndex_Internal_Field_Determinant(max, min, strVal.toScala.toArray) + }.ensuring(_ => base.bitStream.buf.length == old(this).base.bitStream.buf.length) + def dec_String_Ascii_private(max: Long, charactersToDecode: Long): Array[ASCIIChar] = { val strVal: Array[ASCIIChar] = Array.fill(max.toInt + 1)(0.toRawUByte) @@ -1680,6 +1694,10 @@ case class ACN(base: Codec) { strVal } + 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) + } @opaque @inlineOnce def dec_String_Ascii_External_Field_Determinant(max: Long, extSizeDeterminantFld: Long): Array[ASCIIChar] = { @@ -1718,11 +1736,12 @@ case class ACN(base: Codec) { charactersToDecode < Int.MaxValue && i < strVal.length && max < strVal.length && + strVal.length == max.toInt + 1 && base.bitStream.buf == oldThis.base.bitStream.buf ) strVal - }.ensuring(_ => base.bitStream.buf == old(this).base.bitStream.buf) + }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) def dec_String_CharIndex_FixSize(max: Long, allowedCharSet: Array[ASCIIChar]): Array[ASCIIChar] = { dec_String_CharIndex_private(max, max, allowedCharSet) @@ -1760,7 +1779,16 @@ 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(_ => base.bitStream.buf == old(this).base.bitStream.buf) + }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) + + @extern + def dec_IA5String_CharIndex_External_Field_DeterminantVec(max: Long, extSizeDeterminantFld: Long): Vector[ASCIIChar] = { + require(max < Int.MaxValue) + require(extSizeDeterminantFld >= 0) + require(max >= 0) + val arr = dec_IA5String_CharIndex_External_Field_Determinant(max, extSizeDeterminantFld) + Vector.fromScala(arr.toVector) + }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) def dec_IA5String_CharIndex_Internal_Field_Determinant(max: Long, min: Long): Array[ASCIIChar] = { require(min <= max) @@ -1788,7 +1816,17 @@ 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(_ => base.bitStream.buf == old(this).base.bitStream.buf) + }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) + + @extern + def dec_IA5String_CharIndex_Internal_Field_DeterminantVec(max: Long, min: Long): Vector[ASCIIChar] = { + require(min <= max) + require(max < Int.MaxValue) + require(max >= 0) + require(min >= 0) // SAM Check whether this is correct, otherwise transform it into a runtime check + val arr = dec_IA5String_CharIndex_Internal_Field_Determinant(max, min) + Vector.fromScala(arr.toVector) + }.ensuring(res => base.bitStream.buf == old(this).base.bitStream.buf && res.length == max.toInt + 1) /* Length Determinant functions*/ diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Helper.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Helper.scala index 710351811..8b4fb7b09 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Helper.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Helper.scala @@ -52,13 +52,22 @@ extension [T](arr: Array[T]) { if (i == arr.length) -1 else if (arr(i) == elem) i else rec(i + 1) - } + }.ensuring(res => -1 <= res && res < arr.length) rec(0) - } + }.ensuring(res => -1 <= res && res < arr.length) + + def indexOfOrLength(elem: T): Int = { + val ix = indexOf(elem) + if (ix == -1) arr.length else ix + }.ensuring(res => 0 <= res && res <= arr.length) def sameElements(other: Array[T]): Boolean = arraySameElements(arr, other) } +extension [T](vec: Vector[T]) { + def sameElements(other: Vector[T]): Boolean = vecSameElements(vec, other) +} + // TODO: FIXME: To get around aliasing restriction, ideally we should do things differently @extern @pure def freshCopyHack[@mutable T](t: T): T = t.ensuring(_ == t) @@ -289,6 +298,12 @@ sealed trait OptionMut[@mutable A] { case class NoneMut[@mutable A]() extends OptionMut[A] case class SomeMut[@mutable A](v: A) extends OptionMut[A] -sealed trait EitherMut[@mutable A, @mutable B] +sealed trait EitherMut[@mutable A, @mutable B] { + def isRight: Boolean = this match { + case RightMut(_) => true + case LeftMut(_) => false + } + def isLeft: Boolean = !isRight +} case class LeftMut[@mutable A, @mutable B](a: A) extends EitherMut[A, B] case class RightMut[@mutable A, @mutable B](b: B) extends EitherMut[A, B] diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Vector.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Vector.scala new file mode 100644 index 000000000..be987ae3e --- /dev/null +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Vector.scala @@ -0,0 +1,91 @@ +package asn1scala + +import stainless.lang._ +import stainless.collection._ +import stainless.annotation._ +import StaticChecks._ + +case class Vector[T](@pure @extern underlying: scala.collection.immutable.Vector[T]) { + @ghost @pure @extern + def list: List[T] = List.fromScala(underlying.toList) + + @pure @extern + def size: Int = { + underlying.size + }.ensuring(_ == list.isize) + + @pure + def length: Int = size + + @pure @extern + def apply(i: Int): T = { + require(0 <= i && i < size) + underlying(i) + }.ensuring(_ == list.iapply(i)) + + @pure @extern + def :+(t: T): Vector[T] = { + Vector(underlying :+ t) + }.ensuring(res => res.list == list :+ t && res.size == (if (size == Int.MaxValue) Int.MaxValue else size + 1)) + + @pure @extern + def +:(t: T): Vector[T] = { + Vector(t +: underlying) + }.ensuring(res => res.list == t :: list && res.size == (if (size == Int.MaxValue) Int.MaxValue else size + 1)) + + def append(t: T): Vector[T] = this :+ t + + def indexOf(elem: T): Int = { + def rec(i: Int): Int = { + require(0 <= i && i <= length) + decreases(length - i) + if (i == length) -1 + else if (this(i) == elem) i + else rec(i + 1) + }.ensuring(res => -1 <= res && res < length) + rec(0) + }.ensuring(res => -1 <= res && res < length) + + def indexOfOrLength(elem: T): Int = { + val ix = indexOf(elem) + if (ix == -1) length else ix + }.ensuring(res => 0 <= res && res <= length) + + @pure @extern + def toScala: scala.collection.immutable.Vector[T] = underlying +} +object Vector { + @pure @extern @opaque @inlineOnce + def listEqImpliesEq[T](v1: Vector[T], v2: Vector[T]): Unit = { + require(v1.list == v2.list) + }.ensuring(_ => v1 == v2) + + @pure @extern @opaque @inlineOnce + def listApplyEqVecApply[T](v: Vector[T], i: Int): Unit = { + require(0 <= i && i < v.size) + }.ensuring(_ => v.list.iapply(i) == v(i)) + + @pure @extern + def fill[T](n: Int)(t: T): Vector[T] = { + Vector(scala.collection.immutable.Vector.fill(n)(t)) + }.ensuring(_.list == List.ifill(n)(t)) + + @pure @extern + def empty[T]: Vector[T] = { + Vector(scala.collection.immutable.Vector.empty[T]) + }.ensuring(_.list == Nil[T]()) + + @pure @extern + def fromList[T](l: List[T]): Vector[T] = { + def rec(l: List[T], v: Vector[T]): Vector[T] = { + l match { + case Nil() => v + case Cons(x, xs) => rec(xs, v :+ x) + } + } + rec(l, Vector.empty) + }.ensuring(_.list == l) + + @pure @extern + def fromScala[T](v: scala.collection.immutable.Vector[T]): Vector[T] = Vector(v) +} \ No newline at end of file diff --git a/asn1scala/src/main/scala/asn1scala/asn1jvm_Verification.scala b/asn1scala/src/main/scala/asn1scala/asn1jvm_Verification.scala index c4cf1c859..a4bf5780a 100644 --- a/asn1scala/src/main/scala/asn1scala/asn1jvm_Verification.scala +++ b/asn1scala/src/main/scala/asn1scala/asn1jvm_Verification.scala @@ -10,11 +10,11 @@ import StaticChecks.* @pure @inlineOnce -def arraySameElements[T](a1: Array[T], a2: Array[T]): Boolean = +def arraySameElements[@mutable T](a1: Array[T], a2: Array[T]): Boolean = a1.length == a2.length && arrayRangesEqOffset(a1, a2, 0, a1.length, 0) @pure -def arrayRangesEqOffset[T](a1: Array[T], a2: Array[T], fromA1: Int, toA1: Int, fromA2: Int): Boolean = { +def arrayRangesEqOffset[@mutable T](a1: Array[T], a2: Array[T], fromA1: Int, toA1: Int, fromA2: Int): Boolean = { require(0 <= fromA1 && fromA1 <= toA1) require(toA1 <= a1.length) require(0 <= fromA2 && fromA2 <= a2.length - (toA1 - fromA1)) @@ -73,7 +73,7 @@ def bitAt(arr: Array[Byte], at: Long): Boolean = { } @pure -def arrayRangesEq[T](a1: Array[T], a2: Array[T], from: Int, to: Int): Boolean = { +def arrayRangesEq[@mutable T](a1: Array[T], a2: Array[T], from: Int, to: Int): Boolean = { require(0 <= from && from <= to) require(a1.length <= a2.length) require(to <= a1.length) @@ -83,7 +83,7 @@ def arrayRangesEq[T](a1: Array[T], a2: Array[T], from: Int, to: Int): Boolean = } @pure @opaque @inlineOnce @ghost -def arrayRangesEqReflexiveLemma[T](a: Array[T]) = { +def arrayRangesEqReflexiveLemma[@mutable T](a: Array[T]) = { def rec(i: Int): Unit = { require(0 <= i && i <= a.length) require(arrayRangesEq(a, snapshot(a), i, a.length)) @@ -95,7 +95,7 @@ def arrayRangesEqReflexiveLemma[T](a: Array[T]) = { }.ensuring(_ => arrayRangesEq(a, snapshot(a), 0, a.length)) @pure @opaque @inlineOnce @ghost -def arrayRangesEqSymmetricLemma[T](a1: Array[T], a2: Array[T], from: Int, to: Int) = { +def arrayRangesEqSymmetricLemma[@mutable T](a1: Array[T], a2: Array[T], from: Int, to: Int) = { require(0 <= from && from <= to && to <= a1.length) require(a1.length == a2.length) require(arrayRangesEq(a1, a2, from, to)) @@ -115,27 +115,27 @@ def arrayRangesEqSymmetricLemma[T](a1: Array[T], a2: Array[T], from: Int, to: In }.ensuring(_ => arrayRangesEq(a2, a1, from, to)) @pure @opaque @inlineOnce @ghost -def arrayUpdatedAtPrefixLemma[T](a: Array[T], at: Int, v: T): Unit = { +def arrayUpdatedAtPrefixLemma[@mutable T](a: Array[T], at: Int, v: T): Unit = { require(0 <= at && at < a.length) @opaque @inlineOnce @ghost def rec(i: Int): Unit = { require(0 <= i && i <= at) - require(arrayRangesEq(a, snapshot(a).updated(at, v), i, at)) + require(arrayRangesEq(a, snapshot(a).updated(at, snapshot(v)), i, at)) decreases(i) if (i == 0) () else rec(i - 1) }.ensuring { _ => - arrayRangesEq(a, snapshot(a).updated(at, v), 0, at) + arrayRangesEq(a, snapshot(a).updated(at, snapshot(v)), 0, at) } rec(at) }.ensuring { _ => - arrayRangesEq(a, snapshot(a).updated(at, v), 0, at) + arrayRangesEq(a, snapshot(a).updated(at, snapshot(v)), 0, at) } @ghost @pure @opaque @inlineOnce -def arrayRangesEqSlicedLemma[T](a1: Array[T], a2: Array[T], from: Int, to: Int, fromSlice: Int, toSlice: Int): Unit = { +def arrayRangesEqSlicedLemma[@mutable T](a1: Array[T], a2: Array[T], from: Int, to: Int, fromSlice: Int, toSlice: Int): Unit = { require(0 <= from && from <= to) require(a1.length <= a2.length) require(to <= a1.length) @@ -159,7 +159,7 @@ def arrayRangesEqSlicedLemma[T](a1: Array[T], a2: Array[T], from: Int, to: Int, }.ensuring(_ => arrayRangesEq(a1, a2, fromSlice, toSlice)) @pure @opaque @inlineOnce @ghost -def arrayRangesEqImpliesEq[T](a1: Array[T], a2: Array[T], from: Int, at: Int, to: Int): Unit = { +def arrayRangesEqImpliesEq[@mutable T](a1: Array[T], a2: Array[T], from: Int, at: Int, to: Int): Unit = { require(0 <= from && from <= to) require(a1.length <= a2.length) require(to <= a1.length) @@ -181,7 +181,7 @@ def arrayRangesEqImpliesEq[T](a1: Array[T], a2: Array[T], from: Int, at: Int, to }.ensuring(_ => a1(at) == a2(at)) @pure @opaque @inlineOnce @ghost -def arrayRangesEqAppend[T](a1: Array[T], a2: Array[T], from: Int, to: Int) = { +def arrayRangesEqAppend[@mutable T](a1: Array[T], a2: Array[T], from: Int, to: Int) = { require(0 <= from && from <= to) require(a1.length <= a2.length) require(to < a1.length) @@ -206,7 +206,7 @@ def arrayRangesEqAppend[T](a1: Array[T], a2: Array[T], from: Int, to: Int) = { }.ensuring(_ => arrayRangesEq(a1, a2, from, to + 1)) @pure @opaque @inlineOnce @ghost -def arrayRangesEqTransitive[T](a1: Array[T], a2: Array[T], a3: Array[T], from: Int, mid: Int, to: Int): Unit = { +def arrayRangesEqTransitive[@mutable T](a1: Array[T], a2: Array[T], a3: Array[T], from: Int, mid: Int, to: Int): Unit = { require(0 <= from && from <= mid && mid <= to) require(a1.length <= a2.length && a2.length <= a3.length) require(mid <= a1.length && to <= a2.length) @@ -262,6 +262,39 @@ def arrayBitRangesEqReflexiveLemma(a: Array[Byte]) = { rec(a.length.toLong * 8L) }.ensuring(_ => arrayBitRangesEq(a, snapshot(a), 0, a.length.toLong * 8L)) +@pure @opaque @inlineOnce @ghost +def arrayBitRangesEqSymmetric(a1: Array[Byte], a2: Array[Byte], from: Long, to: Long) = { + require(0 <= from && from <= to) + require(a1.length == a2.length) + require(to <= a1.length.toLong * 8L) + require(arrayBitRangesEq(a1, a2, from, to)) + + if (from < to) { + val (arrPrefixStart, arrPrefixEnd, fromBitIx, toBitIx) = arrayBitIndices(from, to) + val restFrom = (from % 8).toInt + val restTo = (to % 8).toInt + if(arrPrefixStart < arrPrefixEnd) { + check(arrayRangesEq(a1, a2, arrPrefixStart, arrPrefixEnd)) + arrayRangesEqSymmetricLemma(a1, a2, arrPrefixStart, arrPrefixEnd) + check(arrayRangesEq(a2, a1, arrPrefixStart, arrPrefixEnd)) + } + if (fromBitIx == toBitIx) { + check(byteRangesEq(a1(fromBitIx), a2(fromBitIx), restFrom, restTo)) + check(byteRangesEq(a2(fromBitIx), a1(fromBitIx), restFrom, restTo)) + } else { + check(byteRangesEq(a1(fromBitIx), a2(fromBitIx), restFrom, 8)) + check(byteRangesEq(a2(fromBitIx), a1(fromBitIx), restFrom, 8)) + if (restTo != 0){ + check(byteRangesEq(a1(toBitIx), a2(toBitIx), 0, restTo)) + check(byteRangesEq(a2(toBitIx), a1(toBitIx), 0, restTo)) + } + } + } + + + +}.ensuring(_ => arrayBitRangesEq(a2, a1, from, to)) + @pure @opaque @inlineOnce @ghost def arrayBitRangesEqPrepend(a1: Array[Byte], a2: Array[Byte], from: Long, to: Long) = { require(0 < from && from <= to) @@ -461,3 +494,333 @@ def arrayBitRangesEqSlicedLemma(a1: Array[Byte], a2: Array[Byte], fromBit: Long, } } }.ensuring(_ => arrayBitRangesEq(a1, a2, fromSlice, toSlice)) + +//////////////////////////////////// + +@pure +def listRangesEq[T](a1: List[T], a2: List[T], from: Int, to: Int): Boolean = { + require(0 <= from && from <= to) + require(a1.isize <= a2.isize) + require(to <= a1.isize) + decreases(to - from) + if (from == to) true + else a1.iapply(from) == a2.iapply(from) && listRangesEq(a1, a2, from + 1, to) +} + +@pure @opaque @inlineOnce @ghost +def listRangesEqReflexiveLemma[T](a: List[T]) = { + def rec(i: Int): Unit = { + require(0 <= i && i <= a.isize) + require(listRangesEq(a, a, i, a.isize)) + decreases(i) + if (i == 0) () + else rec(i - 1) + }.ensuring(_ => listRangesEq(a, a, 0, a.isize)) + rec(a.isize) +}.ensuring(_ => listRangesEq(a, a, 0, a.isize)) + +@pure @opaque @inlineOnce @ghost +def listRangesEqSymmetricLemma[T](a1: List[T], a2: List[T], from: Int, to: Int) = { + require(0 <= from && from <= to && to <= a1.isize) + require(a1.isize == a2.isize) + require(listRangesEq(a1, a2, from, to)) + + def rec(i: Int): Unit = { + require(from <= i && i <= to) + require(listRangesEq(a2, a1, i, to)) + decreases(i) + if (i == from) () + else { + listRangesEqImpliesEq(a1, a2, from, i - 1, to) + rec(i - 1) + } + }.ensuring(_ => listRangesEq(a2, a1, from, to)) + + rec(to) +}.ensuring(_ => listRangesEq(a2, a1, from, to)) + + +@ghost @pure @opaque @inlineOnce +def listRangesEqSlicedLemma[T](a1: List[T], a2: List[T], from: Int, to: Int, fromSlice: Int, toSlice: Int): Unit = { + require(0 <= from && from <= to) + require(a1.isize <= a2.isize) + require(to <= a1.isize) + require(from <= fromSlice && fromSlice <= toSlice && toSlice <= to) + require(listRangesEq(a1, a2, from, to)) + + @opaque @inlineOnce + def rec(i: Int): Unit = { + require(fromSlice <= i && i <= to) + require(listRangesEq(a1, a2, i, to)) // the original predicate we are unfolding + require((i <= toSlice) ==> listRangesEq(a1, a2, i, toSlice)) // the resulting predicate we are folding + decreases(i) + if (i == fromSlice) () + else { + listRangesEqImpliesEq(a1, a2, from, i - 1, to) + rec(i - 1) + } + }.ensuring(_ => listRangesEq(a1, a2, fromSlice, toSlice)) + + rec(to) +}.ensuring(_ => listRangesEq(a1, a2, fromSlice, toSlice)) + +@pure @opaque @inlineOnce @ghost +def listRangesEqImpliesEq[T](a1: List[T], a2: List[T], from: Int, at: Int, to: Int): Unit = { + require(0 <= from && from <= to) + require(a1.isize <= a2.isize) + require(to <= a1.isize) + require(from <= at && at < to) + require(listRangesEq(a1, a2, from, to)) + + @opaque @inlineOnce @ghost + def rec(i: Int): Unit = { + require(from <= i && i <= at) + require(listRangesEq(a1, a2, i, to)) + decreases(to - i) + if (i == at) () + else rec(i + 1) + }.ensuring { _ => + a1.iapply(at) == a2.iapply(at) + } + + rec(from) +}.ensuring(_ => a1.iapply(at) == a2.iapply(at)) + +@pure @opaque @inlineOnce @ghost +def listRangesEqAppend[T](a1: List[T], a2: List[T], from: Int, to: Int) = { + require(0 <= from && from <= to) + require(a1.isize <= a2.isize) + require(to < a1.isize) + require(listRangesEq(a1, a2, from, to)) + require(a1.iapply(to) == a2.iapply(to)) + + @opaque @inlineOnce + def rec(i: Int): Unit = { + require(from <= i && i <= to) + require(listRangesEq(a1, a2, i, to + 1)) + decreases(i) + if (i == from) () + else { + listRangesEqImpliesEq(a1, a2, from, i - 1, to) + rec(i - 1) + } + }.ensuring { _ => + listRangesEq(a1, a2, from, to + 1) + } + + rec(to) +}.ensuring(_ => listRangesEq(a1, a2, from, to + 1)) + +@pure @opaque @inlineOnce @ghost +def listRangesEqTransitive[T](a1: List[T], a2: List[T], a3: List[T], from: Int, mid: Int, to: Int): Unit = { + require(0 <= from && from <= mid && mid <= to) + require(a1.isize <= a2.isize && a2.isize <= a3.isize) + require(mid <= a1.isize && to <= a2.isize) + require(listRangesEq(a1, a2, from, mid)) + require(listRangesEq(a2, a3, from, to)) + + @opaque @inlineOnce @ghost + def rec(i: Int): Unit = { + require(from <= i && i <= mid) + require(listRangesEq(a1, a2, i, mid)) + require(listRangesEq(a2, a3, i, to)) + require(listRangesEq(a1, a3, from, i)) + decreases(to - i) + if (i == mid) () + else { + listRangesEqAppend(a1, a3, from, i) + rec(i + 1) + } + }.ensuring { _ => + listRangesEq(a1, a3, from, mid) + } + rec(from) +}.ensuring(_ => listRangesEq(a1, a3, from, mid)) + +@opaque @inlineOnce @ghost +def listUpdatedAtUnchangedLemma[T](a: List[T], updatedAt: Int, ix: Int, v: T): Unit = { + require(0 <= updatedAt && updatedAt < a.isize) + require(0 <= ix && ix < a.isize) + require(ix != updatedAt) + decreases(a) + (a: @unchecked) match { + case Cons(hd, tail) => + if (ix == 0 || updatedAt == 0) () + else listUpdatedAtUnchangedLemma(tail, updatedAt - 1, ix - 1, v) + } +}.ensuring {_ => + a.iapply(ix) == a.iupdated(updatedAt, v).iapply(ix) +} + +@pure @opaque @inlineOnce @ghost +def listUpdatedAtPrefixLemma[T](a: List[T], at: Int, v: T): Unit = { + require(0 <= at && at < a.isize) + + @opaque @inlineOnce @ghost + def rec(i: Int): Unit = { + require(0 <= i && i <= at) + require(listRangesEq(a, a.iupdated(at, v), i, at)) + decreases(i) + if (i == 0) () + else { + listUpdatedAtUnchangedLemma(a, at, i - 1, v) + rec(i - 1) + } + }.ensuring { _ => + listRangesEq(a, a.iupdated(at, v), 0, at) + } + + rec(at) +}.ensuring { _ => + listRangesEq(a, a.iupdated(at, v), 0, at) +} + +@pure @opaque @inlineOnce @ghost +def listRangesAppendDropEq[T](a1: List[T], a2: List[T], v: T, from: Int, to: Int): Unit = { + require(0 <= from && from <= to) + require(a1.isize < a2.isize) + require(to <= a1.isize) + require(listRangesEq(a1 :+ v, a2, from, to + 1)) + decreases(a1) + + @opaque @inlineOnce @ghost + def rec(i: Int): Unit = { + require(from <= i && i <= to) + require(listRangesEq(a1, a2, from, i)) + decreases(to - i) + if (i == to) () + else { + ListSpecs.isnocIndex(a1, v, i) + listRangesEqImpliesEq(a1 :+ v, a2, from, i, to + 1) + listRangesEqAppend(a1, a2, from, i) + rec(i + 1) + } + }.ensuring { _ => + listRangesEq(a1, a2, from, to) + } + rec(from) +}.ensuring { _ => + listRangesEq(a1, a2, from, to) +} + +//////////////////////////////////// + +@pure +def vecSameElements[T](v1: Vector[T], v2: Vector[T]): Boolean = + v1.length == v2.length && vecRangesEq(v1, v2, 0, v1.length) + +@pure +def vecRangesEq[T](v1: Vector[T], v2: Vector[T], from: Int, to: Int): Boolean = { + require(0 <= from && from <= to) + require(v1.size <= v2.size) + require(to <= v1.size) + decreases(to - from) + if (from == to) true + else v1(from) == v2(from) && vecRangesEq(v1, v2, from + 1, to) +} + +@pure @opaque @inlineOnce @ghost +def listRangesEqImpliesVecRangesEq[T](v1: Vector[T], v2: Vector[T], from: Int, to: Int): Unit = { + require(0 <= from && from <= to) + require(v1.size <= v2.size) + require(to <= v1.size) + require(listRangesEq(v1.list, v2.list, from, to)) + decreases(to - from) + if (from == to) () + else listRangesEqImpliesVecRangesEq(v1, v2, from + 1, to) +}.ensuring(_ => vecRangesEq(v1, v2, from, to)) + +@pure @opaque @inlineOnce @ghost +def vecRangesEqImpliesListRangesEq[T](v1: Vector[T], v2: Vector[T], from: Int, to: Int): Unit = { + require(0 <= from && from <= to) + require(v1.size <= v2.size) + require(to <= v1.size) + require(vecRangesEq(v1, v2, from, to)) + decreases(to - from) + if (from == to) () + else vecRangesEqImpliesListRangesEq(v1, v2, from + 1, to) +}.ensuring(_ => listRangesEq(v1.list, v2.list, from, to)) + +@pure @opaque @inlineOnce @ghost +def vecRangesEqReflexiveLemma[T](v: Vector[T]) = { + listRangesEqReflexiveLemma(v.list) + listRangesEqImpliesVecRangesEq(v, v, 0, v.size) +}.ensuring(_ => vecRangesEq(v, v, 0, v.size)) + +@pure @opaque @inlineOnce @ghost +def vecRangesEqImpliesEq[T](v1: Vector[T], v2: Vector[T], from: Int, at: Int, to: Int): Unit = { + require(0 <= from && from <= to) + require(v1.size <= v2.size) + require(to <= v1.size) + require(from <= at && at < to) + require(vecRangesEq(v1, v2, from, to)) + + vecRangesEqImpliesListRangesEq(v1, v2, from, to) + listRangesEqImpliesEq(v1.list, v2.list, from, at, to) + Vector.listApplyEqVecApply(v1, at) +}.ensuring(_ => v1(at) == v2(at)) + +@pure @opaque @inlineOnce @ghost +def vecRangesEqSymmetricLemma[T](v1: Vector[T], v2: Vector[T], from: Int, to: Int) = { + require(0 <= from && from <= to && to <= v1.size) + require(v1.size == v2.size) + require(vecRangesEq(v1, v2, from, to)) + + vecRangesEqImpliesListRangesEq(v1, v2, from, to) + listRangesEqSymmetricLemma(v1.list, v2.list, from, to) + listRangesEqImpliesVecRangesEq(v2, v1, from, to) +}.ensuring(_ => vecRangesEq(v2, v1, from, to)) + +@ghost @pure @opaque @inlineOnce +def vecRangesEqSlicedLemma[T](v1: Vector[T], v2: Vector[T], from: Int, to: Int, fromSlice: Int, toSlice: Int): Unit = { + require(0 <= from && from <= to) + require(v1.size <= v2.size) + require(to <= v1.size) + require(from <= fromSlice && fromSlice <= toSlice && toSlice <= to) + require(vecRangesEq(v1, v2, from, to)) + + vecRangesEqImpliesListRangesEq(v1, v2, from, to) + listRangesEqSlicedLemma(v1.list, v2.list, from, to, fromSlice, toSlice) + listRangesEqImpliesVecRangesEq(v1, v2, fromSlice, toSlice) +}.ensuring(_ => vecRangesEq(v1, v2, fromSlice, toSlice)) + +@pure @opaque @inlineOnce @ghost +def vecRangesEqAppend[T](v1: Vector[T], v2: Vector[T], from: Int, to: Int) = { + require(0 <= from && from <= to) + require(v1.size <= v2.size) + require(to < v1.size) + require(vecRangesEq(v1, v2, from, to)) + require(v1(to) == v2(to)) + + vecRangesEqImpliesListRangesEq(v1, v2, from, to) + listRangesEqAppend(v1.list, v2.list, from, to) + listRangesEqImpliesVecRangesEq(v1, v2, from, to + 1) +}.ensuring(_ => vecRangesEq(v1, v2, from, to + 1)) + +@pure @opaque @inlineOnce @ghost +def vecRangesEqTransitive[T](v1: Vector[T], v2: Vector[T], v3: Vector[T], from: Int, mid: Int, to: Int): Unit = { + require(0 <= from && from <= mid && mid <= to) + require(v1.size <= v2.size && v2.size <= v3.size) + require(mid <= v1.size && to <= v2.size) + require(vecRangesEq(v1, v2, from, mid)) + require(vecRangesEq(v2, v3, from, to)) + + vecRangesEqImpliesListRangesEq(v1, v2, from, mid) + vecRangesEqImpliesListRangesEq(v2, v3, from, to) + listRangesEqTransitive(v1.list, v2.list, v3.list, from, mid, to) + listRangesEqImpliesVecRangesEq(v1, v3, from, mid) +}.ensuring(_ => vecRangesEq(v1, v3, from, mid)) + +@pure @opaque @inlineOnce @ghost +def vecRangesAppendDropEq[T](v1: Vector[T], v2: Vector[T], v: T, from: Int, to: Int): Unit = { + require(0 <= from && from <= to) + require(v1.size < v2.size) + require(to <= v1.size) + require(vecRangesEq(v1 :+ v, v2, from, to + 1)) + + vecRangesEqImpliesListRangesEq(v1 :+ v, v2, from, to + 1) + listRangesAppendDropEq(v1.list, v2.list, v, from, to) + listRangesEqImpliesVecRangesEq(v1, v2, from, to) +}.ensuring { _ => + vecRangesEq(v1, v2, from, to) +} \ No newline at end of file diff --git a/asn1scala/src/main/scala/asn1scala/asn1scala.worksheet.sc b/asn1scala/src/main/scala/asn1scala/asn1scala.worksheet.sc new file mode 100644 index 000000000..63d320cb6 --- /dev/null +++ b/asn1scala/src/main/scala/asn1scala/asn1scala.worksheet.sc @@ -0,0 +1,37 @@ +opaque type ULong = Long +object ULong { + @inline def fromRaw(u: Long): ULong = u +} +extension (l: ULong) { + @inline def toRaw: Long = l + + // @ignore + // inline def ==(r: Int): Boolean = { + // scala.compiletime.requireConst(r) + // l == r.toLong.toRawULong + // } +} + +val NO_OF_BITS_IN_LONG = 64 + +def GetBitCountUnsigned(vv: ULong): Int = { + val v = vv.toRaw + + if v < 0 then + return NO_OF_BITS_IN_LONG + + if v == 0 then + return 0 + + var i = 0 + var l = v + (while i < NO_OF_BITS_IN_LONG - 1 && l != 0 do + l >>>= 1 + i += 1 + ) + i +} + +GetBitCountUnsigned(0xFF) + +(0x4002) / 0x4000 \ No newline at end of file diff --git a/asn1scala/stainless.conf b/asn1scala/stainless.conf index ccd846260..1910527d6 100644 --- a/asn1scala/stainless.conf +++ b/asn1scala/stainless.conf @@ -1,9 +1,9 @@ # The settings below correspond to the various # options listed by `stainless --help` -vc-cache = true -# debug = ["verification", "smt"] -timeout = 220 +vc-cache = false +debug = ["smt"] +timeout = 1200 check-models = false print-ids = false print-types = false @@ -13,4 +13,4 @@ solvers = "smt-cvc5,smt-z3,smt-cvc4" check-measures = yes infer-measures = true simplifier = "ol" -# no-colors = false \ No newline at end of file +no-colors = true diff --git a/asn1scala/verify.sh b/asn1scala/verify.sh index d6cf93104..41a81670b 100755 --- a/asn1scala/verify.sh +++ b/asn1scala/verify.sh @@ -1,80 +1,8 @@ -stainless-dotty src/main/scala/asn1scala/asn1jvm.scala \ +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.scala \ -src/main/scala/asn1scala/asn1jvm_Codec_ACN.scala \ --config-file=stainless.conf \ --D-parallel=12 \ ---watch \ ---functions=\ -enc_IA5String_CharIndex_External_Field_Determinant,\ -dec_IA5String_CharIndex_External_Field_Determinant,\ -dec_Int_TwosComplement_ConstSize_little_endian_64,\ -dec_Real_IEEE754_32_big_endian,\ -dec_Real_IEEE754_32_little_endian,\ -dec_Real_IEEE754_64_big_endian,\ -dec_Real_IEEE754_64_little_endian,\ -milbus_encode,\ -milbus_decode\ -BitStream_ReadBitPattern,\ -dec_IA5String_CharIndex_Internal_Field_Determinant,\ -dec_String_CharIndex_private,\ -enc_String_CharIndex_private,\ -GetCharIndex,\ -initACNCodec,\ -reader,\ -readPrefixLemma_TODO,\ -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_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,\ -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_Int_TwosComplement_ConstSize_little_endian_16,\ -dec_Int_TwosComplement_ConstSize_little_endian_32,\ -dec_Int_TwosComplement_ConstSize_little_endian_64,\ -dec_Real_IEEE754_32_big_endian,\ -dec_Real_IEEE754_32_little_endian,\ -dec_Real_IEEE754_64_big_endian,\ -dec_Real_IEEE754_64_little_endian,\ -milbus_encode,\ -milbus_decode\ -$1 \ No newline at end of file +-D-parallel=5 \ +$1 diff --git a/asn1scala/verify_bitStream.sh b/asn1scala/verify_bitStream.sh new file mode 100755 index 000000000..41a81670b --- /dev/null +++ b/asn1scala/verify_bitStream.sh @@ -0,0 +1,8 @@ +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 \ +--config-file=stainless.conf \ +-D-parallel=5 \ +$1 diff --git a/asn1scc/GenerateRTL.fs b/asn1scc/GenerateRTL.fs index a42c2f4db..0777ca799 100644 --- a/asn1scc/GenerateRTL.fs +++ b/asn1scc/GenerateRTL.fs @@ -116,8 +116,8 @@ let exportRTL (di:DirInfo) (l:ProgrammingLanguage) (args:CommandLineSettings) (l // TODO: Scala | ProgrammingLanguage.Scala -> File.WriteAllBytes( - Path.Combine(rootDir, "lib", "stainless-library_2.13-0.9.8.2.jar"), - getResourceAsByteArray "stainless-library_2.13-0.9.8.2.jar" + Path.Combine(rootDir, "lib", "stainless-library_3-0.9.8.7.jar"), + getResourceAsByteArray "stainless-library_3-0.9.8.7.jar" ) writeTextFile (Path.Combine(rootDir, "build.sbt")) (getResourceAsString "build.sbt") @@ -135,6 +135,7 @@ let exportRTL (di:DirInfo) (l:ProgrammingLanguage) (args:CommandLineSettings) (l writeResource di "asn1jvm_Codec_PER.scala" None writeResource di "asn1jvm_Helper.scala" None writeResource di "asn1jvm_Verification.scala" None + writeResource di "asn1jvm_Vector.scala" None if hasUper || hasAcn then writeResource di "asn1jvm_Codec_UPER.scala" None diff --git a/asn1scc/asn1scc.fsproj b/asn1scc/asn1scc.fsproj index b56771f95..8b0cceaef 100644 --- a/asn1scc/asn1scc.fsproj +++ b/asn1scc/asn1scc.fsproj @@ -20,11 +20,12 @@ + build.sbt - - stainless-library_2.13-0.9.8.2.jar + + stainless-library_3-0.9.8.7.jar