issue esa#196

Antlr/asn1.g

@@ -343,7 +343,7 @@ bitStringType
 	;
 
 bitStringItem 
-	:	identifier a=L_PAREN (INT|valuereference) R_PAREN		->  ^(NUMBER_LST_ITEM[$a] identifier INT? valuereference?)
+	:	identifier a=L_PAREN (INT|definedValue) R_PAREN		->  ^(NUMBER_LST_ITEM[$a] identifier INT? definedValue?)
 	;	
 
 booleanType

BackendAst/DAstTypeDefinition.fs

@@ -191,11 +191,24 @@ let createOctetString (r:Asn1AcnAst.AstRoot) (l:ProgrammingLanguage)  (t:Asn1Acn
 
 let createBitString (r:Asn1AcnAst.AstRoot) (l:ProgrammingLanguage)  (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.BitString)  (us:State) =
     let td = o.typeDef.[l]
-    let define_new_bit_string        = match l with C -> header_c.Define_new_bit_string | Ada -> header_a.Define_new_bit_string
+    let define_new_bit_string   = match l with C -> header_c.Define_new_bit_string | Ada -> header_a.Define_new_bit_string
+    let define_named_bit        = match l with C -> header_c.Define_new_bit_string_named_bit | Ada -> header_a.Define_new_bit_string_named_bit
+
     let define_subType_bit_string    = match l with C -> header_c.Define_subType_bit_string | Ada -> header_a.Define_subType_bit_string
     match td.kind with
     | NonPrimitiveNewTypeDefinition              -> 
-        let completeDefintion = define_new_bit_string td (o.minSize.uper) (o.maxSize.uper) (o.minSize.uper = o.maxSize.uper) (BigInteger o.MaxOctets)
+        let nblist = 
+            o.namedBitList |> 
+            List.filter(fun nb -> nb.resolvedValue < 64I) |>
+            List.map(fun nb  ->
+                let hexValue =  
+                    let aa = int nb.resolvedValue
+                    let hexVal = ((uint64 1) <<< aa)
+                    hexVal.ToString("X")
+                let sComment = sprintf "(1 << %A)" nb.resolvedValue
+                define_named_bit td (ToC (nb.Name.Value.ToUpper())) hexValue sComment
+            )
+        let completeDefintion = define_new_bit_string td (o.minSize.uper) (o.maxSize.uper) (o.minSize.uper = o.maxSize.uper) (BigInteger o.MaxOctets) nblist
         Some completeDefintion
     | NonPrimitiveNewSubTypeDefinition subDef     -> 
         let otherProgramUnit = if td.programUnit = subDef.programUnit then None else (Some subDef.programUnit)

BackendAst/PrintAsn1.fs

@@ -76,7 +76,7 @@ let rec PrintType (t:Asn1Type) (m:Asn1Module) (bPrintInSignleModule:bool) =
     |Integer    -> stg_asn1.Print_Integer "" cons
     |Real       -> stg_asn1.Print_Real cons
     |Boolean    -> stg_asn1.Print_Boolean cons
-    |BitString  -> stg_asn1.Print_BitString cons
+    |BitString  _-> stg_asn1.Print_BitString cons
     |OctetString-> stg_asn1.Print_OctetString cons
     |NullType   -> stg_asn1.Print_NullType cons
     |IA5String  -> stg_asn1.Print_IA5String cons

CommonTypes/CommonTypes.fs

@@ -747,3 +747,21 @@ type AntlrParserResult = {
 type ContainedInOctOrBitString =
     | ContainedInOctString
     | ContainedInBitString
+
+
+type IntegerOrDefinedValue =
+    | IDV_IntegerValue         of IntLoc                    //integer literal i.e. 5
+    | IDV_DefinedValue   of (StringLoc*StringLoc)     // reference to an integer value assignment defined in another module
+
+type NamedBit0 = {
+    Name:StringLoc
+    _value : IntegerOrDefinedValue
+    Comments: string array
+}
+
+type NamedBit1 = {
+    Name:StringLoc
+    resolvedValue : BigInteger
+    _value : IntegerOrDefinedValue
+    Comments: string array
+}

FrontEndAst/AcnCreateFromAntlr.fs

@@ -502,7 +502,15 @@ let private mergeOctetStringType (asn1:Asn1Ast.AstRoot) (loc:SrcLoc) (acnErrLoc:
     let typeDef, us1 = getSizeableTypeDifition tdarg us
     {OctetString.acnProperties = acnProperties; cons = cons; withcons = withcons; minSize=minSize; maxSize =maxSize; uperMaxSizeInBits = uperMaxSizeInBits; uperMinSizeInBits=uperMinSizeInBits; acnEncodingClass = acnEncodingClass;  acnMinSizeInBits=acnMinSizeInBits; acnMaxSizeInBits = acnMaxSizeInBits; typeDef=typeDef}, us1
 
-let private mergeBitStringType (asn1:Asn1Ast.AstRoot) (loc:SrcLoc) (acnErrLoc: SrcLoc option) (props:GenericAcnProperty list) cons withcons (tdarg:GetTypeDifition_arg) (us:Asn1AcnMergeState) =
+let private mergeBitStringType (asn1:Asn1Ast.AstRoot) (namedBitList: NamedBit0 list) (loc:SrcLoc) (acnErrLoc: SrcLoc option) (props:GenericAcnProperty list) cons withcons (tdarg:GetTypeDifition_arg) (us:Asn1AcnMergeState) =
+    let newNamedBitList =
+        namedBitList |> List.map(fun nb -> 
+            let resolvedValue = 
+                match nb._value with
+                | IDV_IntegerValue       intVal     -> intVal.Value
+                | IDV_DefinedValue   (mdVal, refVal) -> Asn1Ast.GetValueAsInt (Asn1Ast.GetBaseValue mdVal refVal asn1) asn1
+            {NamedBit1.Name = nb.Name;  _value = nb._value; resolvedValue = resolvedValue; Comments = nb.Comments})
+
     let sizeUperRange = uPER.getBitStringUperRange cons loc
     let sizeUperAcnRange = uPER.getBitStringUperRange (cons@withcons) loc
     //let minSize, maxSize = uPER.getSizeMinAndMaxValue loc sizeUperRange
@@ -525,7 +533,7 @@ let private mergeBitStringType (asn1:Asn1Ast.AstRoot) (loc:SrcLoc) (acnErrLoc: S
     let acnEncodingClass,  acnMinSizeInBits, acnMaxSizeInBits= AcnEncodingClasses.GetBitStringEncodingClass aligment loc acnProperties acnUperMinSizeInBits uperMaxSizeInBits minSize.acn maxSize.acn 
 
     let typeDef, us1 = getSizeableTypeDifition tdarg us
-    {BitString.acnProperties = acnProperties; cons = cons; withcons = withcons; minSize=minSize; maxSize =maxSize; uperMaxSizeInBits = uperMaxSizeInBits; uperMinSizeInBits=uperMinSizeInBits; acnEncodingClass = acnEncodingClass;  acnMinSizeInBits=acnMinSizeInBits; acnMaxSizeInBits = acnMaxSizeInBits; typeDef=typeDef}, us1
+    {BitString.acnProperties = acnProperties; cons = cons; withcons = withcons; minSize=minSize; maxSize =maxSize; uperMaxSizeInBits = uperMaxSizeInBits; uperMinSizeInBits=uperMinSizeInBits; acnEncodingClass = acnEncodingClass;  acnMinSizeInBits=acnMinSizeInBits; acnMaxSizeInBits = acnMaxSizeInBits; typeDef=typeDef; namedBitList = newNamedBitList}, us1
 
 let private mergeNullType (acnErrLoc: SrcLoc option) (props:GenericAcnProperty list) (tdarg:GetTypeDifition_arg) (us:Asn1AcnMergeState) =
     let getRtlTypeName  l = match l with C -> "", header_c.Declare_NullType  (), "NULL" | Ada -> "adaasn1rtl", header_a.Declare_NULLNoRTL  (), "NULL" 
@@ -891,10 +899,10 @@ let rec private mergeType  (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (m:Asn1Ast.Asn1Mo
             let wcons = withCons |> List.collect fixConstraint |> List.map (ConstraintsMapping.getOctetStringConstraint asn1 t)
             let o, us1 = mergeOctetStringType asn1 t.Location acnErrLoc combinedProperties cons wcons tfdArg us
             OctetString o, us1
-        | Asn1Ast.BitString                ->  
+        | Asn1Ast.BitString    namedBitList            ->  
             let cons =  t.Constraints@refTypeCons |> List.collect fixConstraint |> List.map (ConstraintsMapping.getBitStringConstraint asn1 t)
             let wcons = withCons |> List.collect fixConstraint |> List.map (ConstraintsMapping.getBitStringConstraint asn1 t)
-            let o, us1 = mergeBitStringType asn1 t.Location acnErrLoc combinedProperties cons wcons tfdArg us
+            let o, us1 = mergeBitStringType asn1 namedBitList t.Location acnErrLoc combinedProperties cons wcons tfdArg us
             BitString o, us1
         | Asn1Ast.NullType                 ->  
             let constraints = []

FrontEndAst/Asn1AcnAst.fs

@@ -355,7 +355,7 @@ type BitString = {
     acnMinSizeInBits    : BigInteger
     acnEncodingClass    : SizeableAcnEncodingClass
     typeDef             : Map<ProgrammingLanguage, FE_SizeableTypeDefinition>
-
+    namedBitList     : NamedBit1 list
 }
 
 type TimeType = {

FrontEndAst/Asn1Ast.fs

@@ -134,7 +134,7 @@ and Asn1TypeKind =
     | OctetString 
     | NullType
     | TimeType         of TimeTypeClass
-    | BitString
+    | BitString        of list<NamedBit0>
     | Boolean 
     | ObjectIdentifier
     | RelativeObjectIdentifier
@@ -351,7 +351,7 @@ let rec getASN1Name (r:AstRoot) (t:Asn1Type) =
     | NumericString   -> "NumericString"
     | OctetString     -> "OCTET STRING"
     | NullType        -> "NULL"
-    | BitString       -> "BIT STRING"
+    | BitString _     -> "BIT STRING"
     | Boolean         -> "BOOLEAN"
     | Enumerated   _  -> "ENUMERATED"
     | SequenceOf   _  -> "SEQUENCE OF"

FrontEndAst/CheckAsn1.fs

@@ -285,7 +285,7 @@ let rec CheckIfVariableViolatesTypeConstraints (t:Asn1Type) (v:Asn1Value) ast =
         let bitOrOctSrt =
             match (Asn1Ast.GetActualType t  ast).Kind with
             | OctetString       -> Some TP_OCT_STR
-            | BitString         -> Some TP_BIT_STR
+            | BitString  _      -> Some TP_BIT_STR
             | _                 -> None
         let ret = t.Constraints |> Seq.forall(fun c -> IsValueAllowed c v false bitOrOctSrt ast )
         match v.Kind, t.Kind with
@@ -548,7 +548,7 @@ let rec CheckType(t:Asn1Type) (m:Asn1Module) ast =
         | Some itm -> ()
         | None     -> raise(SemanticError(t.Location, "The constraints defined for this type do not allow any value"))
 
-    | BitString            ->   ()
+    | BitString _           ->   ()
     | Integer               ->  ()
     | TimeType _           -> ()
     (*  ++++

FrontEndAst/ConstraintsMapping.fs

@@ -334,7 +334,7 @@ let rec getAnyConstraint (r:Asn1Ast.AstRoot) (t:Asn1Ast.Asn1Type) (c:Asn1Ast.Asn
     |Asn1Ast.OctetString                -> OctetStringConstraint (getOctetStringConstraint r t c)
     |Asn1Ast.NullType                   -> NullConstraint
     |Asn1Ast.TimeType        _          -> TimeConstraint (getTimeConstraint r t c)
-    |Asn1Ast.BitString                  -> BitStringConstraint (getBitStringConstraint r t c)
+    |Asn1Ast.BitString   _              -> BitStringConstraint (getBitStringConstraint r t c)
     |Asn1Ast.Boolean                    -> BoolConstraint (getBoolConstraint r t c)
     |Asn1Ast.ObjectIdentifier           -> ObjectIdConstraint(getObjectIdConstraint r t c)
     |Asn1Ast.RelativeObjectIdentifier   -> ObjectIdConstraint(getObjectIdConstraint r t c)

FrontEndAst/CreateAsn1AstFromAntlrTree.fs

@@ -196,7 +196,7 @@ let rec CreateType (tasParameters : TemplateParameter list) (acnTypeEncodingSpec
         | asn1Parser.SEQUENCE_TYPE      -> Sequence(CreateSequenceChild  tasParameters acnTypeEncodingSpec astRoot typeNode fileTokens alreadyTakenComments )
         | asn1Parser.SET_TYPE           -> Sequence(CreateSequenceChild  tasParameters acnTypeEncodingSpec astRoot typeNode fileTokens alreadyTakenComments )
         | asn1Parser.ENUMERATED_TYPE    -> Enumerated(CreateNamedItems astRoot  typeNode fileTokens alreadyTakenComments)
-        | asn1Parser.BIT_STRING_TYPE    -> BitString
+        | asn1Parser.BIT_STRING_TYPE    -> BitString(CreateNamedBitList astRoot  typeNode fileTokens alreadyTakenComments)
         | asn1Parser.OCTECT_STING       -> OctetString
         | asn1Parser.IA5String          -> IA5String
         | asn1Parser.NumericString      -> NumericString
@@ -276,18 +276,19 @@ and CreateChoiceChild (tasParameters : TemplateParameter list) (chAcnTypeEncodin
         | _ -> raise (BugErrorException("Bug in CreateChoiceChild"))
     )
 
+and singleReference2DoubleReference (tree:ITree) =
+    let strVal = tree.GetChild(0).TextL
+    let modl = tree.GetAncestor(asn1Parser.MODULE_DEF)
+    let modName = modl.GetChild(0).TextL
+    let imports = modl.GetChildrenByType(asn1Parser.IMPORTS_FROM_MODULE)
+    let importedFromModule = imports |> List.tryFind(fun imp-> imp.GetChildrenByType(asn1Parser.LID) |> Seq.exists(fun impTypeName -> impTypeName.Text = strVal.Value ))
+    let valToReturn = 
+        match importedFromModule with
+        |Some(imp)  -> ( imp.GetChild(0).TextL,  strVal)
+        |None       -> ( modName,  strVal)
+    valToReturn
+
 and CreateValue (astRoot:list<ITree>) (tree:ITree ) : Asn1Value=
-    let singleReference2DoubleReference (tree:ITree) =
-        let strVal = tree.GetChild(0).TextL
-        let modl = tree.GetAncestor(asn1Parser.MODULE_DEF)
-        let modName = modl.GetChild(0).TextL
-        let imports = modl.GetChildrenByType(asn1Parser.IMPORTS_FROM_MODULE)
-        let importedFromModule = imports |> List.tryFind(fun imp-> imp.GetChildrenByType(asn1Parser.LID) |> Seq.exists(fun impTypeName -> impTypeName.Text = strVal.Value ))
-        let valToReturn = 
-            match importedFromModule with
-            |Some(imp)  -> ( imp.GetChild(0).TextL,  strVal)
-            |None       -> ( modName,  strVal)
-        valToReturn
 
 
     let GetActualString (str:string) = 
@@ -463,6 +464,28 @@ and CreateNamedItems (astRoot:list<ITree>) (tree:ITree) (fileTokens:array<IToken
     let enumItes = getChildrenByType(tree, asn1Parser.NUMBER_LST_ITEM)
     enumItes |> List.map CreateItem
 
+and CreateNamedBitList (astRoot:list<ITree>) (tree:ITree) (fileTokens:array<IToken>) (alreadyTakenComments:System.Collections.Generic.List<IToken>)=
+    let CreateNamedBit(itemItree:ITree) =
+        let itemChildren = getTreeChildren(itemItree)
+        match itemChildren with
+        | name::vlue::_    -> 
+            let value = 
+                match vlue.Type with
+                | asn1Parser.INT            -> 
+                    match vlue.BigIntL.Value >= 0I with
+                    | true  -> IDV_IntegerValue(vlue.BigIntL)
+                    | false -> raise (SemanticError(vlue.Location, "Negative values are not permitted"))
+                | asn1Parser.DEFINED_VALUE  ->
+                    match vlue.ChildCount with
+                    | 2     -> IDV_DefinedValue(vlue.GetChild(0).TextL, vlue.GetChild(1).TextL)
+                    | 1     -> IDV_DefinedValue(singleReference2DoubleReference vlue)
+                    | _     -> raise (BugErrorException("Bug in CreateValue CreateNamedBit 1"))
+                | _         -> raise (BugErrorException("Bug in CreateValue CreateNamedBit 2"))
+            {NamedBit0.Name=name.TextL; _value=value; Comments = Antlr.Comment.GetComments(fileTokens, alreadyTakenComments, fileTokens.[itemItree.TokenStopIndex].Line, itemItree.TokenStartIndex - 1, itemItree.TokenStopIndex + 2)}
+        | _                 -> raise (BugErrorException("Bug in CreateNamedBitList.CreateItem")) 
+    let namedBits = getChildrenByType(tree, asn1Parser.NUMBER_LST_ITEM)
+    namedBits |> List.map CreateNamedBit
+
 and CreateTimeClass (astRoot:list<ITree>) (tree:ITree) (fileTokens:array<IToken>) (alreadyTakenComments:System.Collections.Generic.List<IToken>)=
     let rec removeSpaceArountEqual (str:string) =
         let rs = [" =";"\t=";"\r\n=";"\r=";"\n=";"= ";"=\t";"=\r\n";"=\r";"=\n"]

FrontEndAst/FE_TypeDefinition.fs

@@ -491,7 +491,7 @@ let getRefereceTypeDefinition (asn1:Asn1Ast.AstRoot) (t:Asn1Ast.Asn1Type) (arg:G
     | Asn1Ast.Boolean                  -> getPrimitiveTypeDifition arg us   |> (fun (a,b) -> a |> Map.toList |> List.map (fun (l, d) -> (l, FE_PrimitiveTypeDefinition d)) |> Map.ofList,b)
     | Asn1Ast.Enumerated        _      -> getEnumeratedTypeDifition arg us  |> (fun (a,b) -> a |> Map.toList |> List.map (fun (l, d) -> (l, FE_EnumeratedTypeDefinition d)) |> Map.ofList,b)
     | Asn1Ast.OctetString              -> getSizeableTypeDifition arg us    |> (fun (a,b) -> a |> Map.toList |> List.map (fun (l, d) -> (l, FE_SizeableTypeDefinition d)) |> Map.ofList,b)
-    | Asn1Ast.BitString                -> getSizeableTypeDifition arg us    |> (fun (a,b) -> a |> Map.toList |> List.map (fun (l, d) -> (l, FE_SizeableTypeDefinition d)) |> Map.ofList,b)
+    | Asn1Ast.BitString   _            -> getSizeableTypeDifition arg us    |> (fun (a,b) -> a |> Map.toList |> List.map (fun (l, d) -> (l, FE_SizeableTypeDefinition d)) |> Map.ofList,b)
     | Asn1Ast.SequenceOf        _      -> getSizeableTypeDifition arg us    |> (fun (a,b) -> a |> Map.toList |> List.map (fun (l, d) -> (l, FE_SizeableTypeDefinition d)) |> Map.ofList,b)
     | Asn1Ast.NumericString            -> getStringTypeDifition arg us      |> (fun (a,b) -> a |> Map.toList |> List.map (fun (l, d) -> (l, FE_StringTypeDefinition d)) |> Map.ofList,b)
     | Asn1Ast.IA5String                -> getStringTypeDifition arg us      |> (fun (a,b) -> a |> Map.toList |> List.map (fun (l, d) -> (l, FE_StringTypeDefinition d)) |> Map.ofList,b)

FrontEndAst/MapParamAstToNonParamAst.fs

@@ -150,6 +150,26 @@ let rec MapAsn1Value (r:ParameterizedAsn1Ast.AstRoot) (kind: ParameterizedAsn1As
         |ParameterizedAsn1Ast.SeqOfValue(vals)      -> 
             match actKind with
             | ParameterizedAsn1Ast.SequenceOf(ch)    -> Asn1Ast.SeqOfValue(vals |> List.mapi (fun idx v -> MapAsn1Value r ch.Kind typeScope (visitSeqOfValue variableScope idx) v))
+            | ParameterizedAsn1Ast.BitString namedBits      -> 
+                let bitPos = 
+                    vals |>
+                    List.map(fun chV -> 
+                        match chV.Kind    with
+                        | ParameterizedAsn1Ast.RefValue            (_,refVal)    -> 
+                            match namedBits |> Seq.tryFind(fun z -> z.Name.Value = refVal.Value) with
+                            | None      -> raise (SemanticError(v.Location, (sprintf "Expecting a BIT STRING value. '%s' is not defined as a named bit" refVal.Value)))
+                            | Some nb   -> 
+                                match nb._value with
+                                | CommonTypes.IDV_IntegerValue       intVal     -> intVal.Value
+                                | CommonTypes.IDV_DefinedValue   (mdVal, refVal) -> ParameterizedAsn1Ast.GetValueAsInt (ParameterizedAsn1Ast.GetBaseValue mdVal refVal r) r
+
+                        | _                                         -> raise (SemanticError(v.Location, (sprintf "Expecting a BIT STRING value but found a SEQUENCE OF value" )))
+                    ) |> Set.ofList
+                let maxValue = bitPos.MaximumElement
+
+                let bitStrVal = 
+                    [0I .. maxValue] |> List.map(fun bi -> if bitPos.Contains bi then '1' else '0') |> Seq.StrJoin ""
+                Asn1Ast.BitStringValue ({StringLoc.Value = bitStrVal; Location = v.Location})
             | _                                      -> raise(SemanticError(v.Location, "Expecting a SEQUENCE OF value"))
         |ParameterizedAsn1Ast.SeqValue(vals)        -> 
             match actKind with
@@ -309,7 +329,7 @@ and MapAsn1Type (r:ParameterizedAsn1Ast.AstRoot) typeScope (t:ParameterizedAsn1A
     | ParameterizedAsn1Ast.OctetString      -> aux Asn1Ast.OctetString
     | ParameterizedAsn1Ast.TimeType cl        -> aux (Asn1Ast.TimeType cl)
     | ParameterizedAsn1Ast.NullType         -> aux Asn1Ast.NullType
-    | ParameterizedAsn1Ast.BitString        -> aux Asn1Ast.BitString
+    | ParameterizedAsn1Ast.BitString nBits       -> aux (Asn1Ast.BitString nBits)
     | ParameterizedAsn1Ast.Boolean          -> aux Asn1Ast.Boolean
     | ParameterizedAsn1Ast.ObjectIdentifier         -> aux Asn1Ast.ObjectIdentifier
     | ParameterizedAsn1Ast.RelativeObjectIdentifier -> aux Asn1Ast.RelativeObjectIdentifier