Skip to content

Commit

Permalink
First successful attempt to export in XML the combined ASN.1 ACN AST
Browse files Browse the repository at this point in the history
  • Loading branch information
usr3-1415 committed Jun 4, 2017
1 parent b29c677 commit 09c0a48
Show file tree
Hide file tree
Showing 20 changed files with 3,650 additions and 102 deletions.
2 changes: 2 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -917,3 +917,5 @@ Asn1.userprefs
/mantis/0000595/o
/mantis/0000580/o
/mantis/0000600/out
xml
/todo.txt
5 changes: 0 additions & 5 deletions Asn1f4/Asn1f4.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -88,11 +88,6 @@
<Project>{a1882f1d-5185-407c-8227-1e2b69baade9}</Project>
<Private>True</Private>
</ProjectReference>
<ProjectReference Include="..\BackendAst\BackendAst.fsproj">
<Name>BackendAst</Name>
<Project>{2f960476-565f-4282-90b3-606dbac5eff2}</Project>
<Private>True</Private>
</ProjectReference>
<ProjectReference Include="..\CommonTypes\CommonTypes.fsproj">
<Name>CommonTypes</Name>
<Project>{83f15fa6-7da0-4e47-9512-39ae3fdd28cf}</Project>
Expand Down
10 changes: 8 additions & 2 deletions Asn1f4/Program.fs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,8 @@ type CliArguments =
| [<AltCommandLine("-o")>]Out of dir:string
| [<AltCommandLine("-equal")>]Equal_Func
| [<AltCommandLine("-typePrefix")>]Type_Prefix of prefix:string
| [<AltCommandLine("-x")>] Xml_Ast of xmlFilename:string

| [<MainCommand; ExactlyOnce; Last>] Files of files:string list
with
interface IArgParserTemplate with
Expand All @@ -27,7 +29,7 @@ with
| Files (_) -> "List of ASN.1 and ACN files to process."
| Type_Prefix _ -> "adds 'prefix' to all generated C or Ada/SPARK data types."
| Equal_Func -> "generate functions for testing type equality."

| Xml_Ast _ -> "dump internal AST in an xml file"


let checkArguement arg =
Expand All @@ -38,6 +40,7 @@ let checkArguement arg =
| ACN_enc -> ()
| Auto_test_cases -> ()
| Equal_Func -> ()
| Xml_Ast _ -> ()
| Out outDir ->
match System.IO.Directory.Exists outDir with
| true -> ()
Expand All @@ -64,7 +67,7 @@ let constructCommandLineSettings args (parserResults: ParseResults<CliArguments>
GenerateEqualFunctions = parserResults.Contains<@ Equal_Func @> || parserResults.Contains<@ Auto_test_cases @>
TypePrefix = parserResults.GetResult(<@ Type_Prefix@>, defaultValue = "")
CheckWithOss = false
AstXmlAbsFileName = ""
AstXmlAbsFileName = parserResults.GetResult(<@Xml_Ast@>, defaultValue = "")
IcdUperHtmlFileName = ""
IcdAcnHtmlFileName = ""
mappingFunctionsModule = None
Expand All @@ -81,6 +84,9 @@ let main argv =
cliArgs |> Seq.iter checkArguement
let args = constructCommandLineSettings cliArgs parserResults
let frontEntAst = FrontEntMain.constructAst args
match args.AstXmlAbsFileName with
| "" -> ()
| _ -> ExportToXml.exportFile frontEntAst args.AstXmlAbsFileName
0
with
| :? Argu.ArguParseException as ex ->
Expand Down
161 changes: 102 additions & 59 deletions FrontEndAst/AcnCreateFromAntlr.fs

Large diffs are not rendered by default.

168 changes: 140 additions & 28 deletions FrontEndAst/Asn1AcnAst.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
open System.Numerics
open Antlr.Runtime.Tree
open Antlr.Runtime

open System
open FsUtils
open CommonTypes

Expand Down Expand Up @@ -125,22 +125,101 @@ type AcnParameter = {
////// ASN1 VALUES DEFINITION ////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

type Asn1Value = Asn1Ast.Asn1Value
type IntegerValue = IntLoc
type RealValue = DoubleLoc
type StringValue = StringLoc
type BooleanValue = BoolLoc
type BitStringValue = StringLoc
type OctetStringValue = list<ByteLoc>
type EnumValue = StringLoc
type SeqOfValue = list<Asn1Value>
and SeqValue = list<NamedValue>
and ChValue = NamedValue
and RefValue = ((StringLoc*StringLoc)*Asn1Value)

and NamedValue = {
name : StringLoc
Value : Asn1Value
}

and Asn1Value =
| IntegerValue of IntegerValue
| RealValue of RealValue
| StringValue of StringValue
| BooleanValue of BooleanValue
| BitStringValue of BitStringValue
| OctetStringValue of OctetStringValue
| EnumValue of EnumValue
| SeqOfValue of SeqOfValue
| SeqValue of SeqValue
| ChValue of ChValue
| NullValue
| RefValue of RefValue


/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////// ASN1 CONSTRAINTS DEFINITION ////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


type GenericConstraint<'v> =
| UnionConstraint of GenericConstraint<'v>*GenericConstraint<'v>*bool //left,righ, virtual constraint
| IntersectionConstraint of GenericConstraint<'v>*GenericConstraint<'v>
| AllExceptConstraint of GenericConstraint<'v>
| ExceptConstraint of GenericConstraint<'v>*GenericConstraint<'v>
| RootConstraint of GenericConstraint<'v>
| RootConstraint2 of GenericConstraint<'v>*GenericConstraint<'v>
| SingleValueConstraint of 'v

type RangeTypeConstraint<'v1,'v2> =
| RangeUnionConstraint of RangeTypeConstraint<'v1,'v2>*RangeTypeConstraint<'v1,'v2>*bool //left,righ, virtual constraint
| RangeIntersectionConstraint of RangeTypeConstraint<'v1,'v2>*RangeTypeConstraint<'v1,'v2>
| RangeAllExceptConstraint of RangeTypeConstraint<'v1,'v2>
| RangeExceptConstraint of RangeTypeConstraint<'v1,'v2>*RangeTypeConstraint<'v1,'v2>
| RangeRootConstraint of RangeTypeConstraint<'v1,'v2>
| RangeRootConstraint2 of RangeTypeConstraint<'v1,'v2>*RangeTypeConstraint<'v1,'v2>
| RangeSingleValueConstraint of 'v2
| RangeContraint of ('v1) *('v1)*bool*bool //min, max, InclusiveMin(=true), InclusiveMax(=true)
| RangeContraint_val_MAX of ('v1) *bool //min, InclusiveMin(=true)
| RangeContraint_MIN_val of ('v1) *bool //max, InclusiveMax(=true)

type IntegerTypeConstraint = RangeTypeConstraint<BigInteger, BigInteger>
type PosIntTypeConstraint = RangeTypeConstraint<UInt32, UInt32>
type CharTypeConstraint = RangeTypeConstraint<char, string>

type RealTypeConstraint = RangeTypeConstraint<double, double>


type SizableTypeConstraint<'v> =
| SizeUnionConstraint of SizableTypeConstraint<'v>*SizableTypeConstraint<'v>*bool //left,righ, virtual constraint
| SizeIntersectionConstraint of SizableTypeConstraint<'v>*SizableTypeConstraint<'v>
| SizeAllExceptConstraint of SizableTypeConstraint<'v>
| SizeExceptConstraint of SizableTypeConstraint<'v>*SizableTypeConstraint<'v>
| SizeRootConstraint of SizableTypeConstraint<'v>
| SizeRootConstraint2 of SizableTypeConstraint<'v>*SizableTypeConstraint<'v>
| SizeSingleValueConstraint of 'v
| SizeContraint of PosIntTypeConstraint

type Asn1Constraint =
| SingleValueContraint of Asn1Value
| RangeContraint of Asn1Value*Asn1Value*bool*bool //min, max, InclusiveMin(=true), InclusiveMax(=true)
| RangeContraint_val_MAX of Asn1Value*bool //min, InclusiveMin(=true)
| RangeContraint_MIN_val of Asn1Value*bool //max, InclusiveMax(=true)
| RangeContraint_MIN_MAX
| SizeContraint of Asn1Constraint
| AlphabetContraint of Asn1Constraint
| UnionConstraint of Asn1Constraint*Asn1Constraint*bool //left,righ, virtual constraint
| IntersectionConstraint of Asn1Constraint*Asn1Constraint
| AllExceptConstraint of Asn1Constraint
| ExceptConstraint of Asn1Constraint*Asn1Constraint
| RootConstraint of Asn1Constraint
| RootConstraint2 of Asn1Constraint*Asn1Constraint
type IA5StringConstraint =
| StrUnionConstraint of IA5StringConstraint*IA5StringConstraint*bool //left,righ, virtual constraint
| StrIntersectionConstraint of IA5StringConstraint*IA5StringConstraint
| StrAllExceptConstraint of IA5StringConstraint
| StrExceptConstraint of IA5StringConstraint*IA5StringConstraint
| StrRootConstraint of IA5StringConstraint
| StrRootConstraint2 of IA5StringConstraint*IA5StringConstraint
| StrSingleValueConstraint of string
| StrSizeContraint of PosIntTypeConstraint
| AlphabetContraint of CharTypeConstraint

type OctetStringConstraint = SizableTypeConstraint<OctetStringValue>
type BitStringConstraint = SizableTypeConstraint<BitStringValue>
type BoolConstraint = GenericConstraint<bool>
type EnumConstraint = GenericConstraint<string>


type SequenceOfConstraint = SizableTypeConstraint<SeqOfValue>
type SequenceConstraint = GenericConstraint<SeqValue>
type ChoiceConstraint = GenericConstraint<ChValue>


type NamedItem = {
Expand All @@ -167,44 +246,50 @@ type Asn1Optionality = Asn1Ast.Asn1Optionality

type Integer = {
acnProperties : IntegerAcnProperties
constraints : Asn1Constraint list
cons : IntegerTypeConstraint list
withcons : IntegerTypeConstraint list
}

type Real = {
acnProperties : RealAcnProperties
constraints : Asn1Constraint list
cons : RealTypeConstraint list
withcons : RealTypeConstraint list
}

type StringType = {
acnProperties : StringAcnProperties
constraints : Asn1Constraint list
cons : IA5StringConstraint list
withcons : IA5StringConstraint list
}


type OctetString = {
acnProperties : SizeableAcnProperties
constraints : Asn1Constraint list
cons : OctetStringConstraint list
withcons : OctetStringConstraint list
}

type BitString = {
acnProperties : SizeableAcnProperties
constraints : Asn1Constraint list
cons : BitStringConstraint list
withcons : BitStringConstraint list
}

type NullType = {
acnProperties : NullTypeAcnProperties
constraints : Asn1Constraint list
}

type Boolean = {
acnProperties : BooleanAcnProperties
constraints : Asn1Constraint list
cons : BoolConstraint list
withcons : BoolConstraint list
}

type Enumerated = {
items : NamedItem list
acnProperties : IntegerAcnProperties
constraints : Asn1Constraint list
cons : EnumConstraint list
withcons : EnumConstraint list
}

type AcnInsertedType =
Expand Down Expand Up @@ -243,12 +328,14 @@ and Asn1TypeKind =
and SequenceOf = {
child : Asn1Type
acnProperties : SizeableAcnProperties
constraints : Asn1Constraint list
cons : SequenceOfConstraint list
withcons : SequenceOfConstraint list
}

and Sequence = {
children : SeqChildInfo list
constraints : Asn1Constraint list
cons : SequenceConstraint list
withcons : SequenceConstraint list
}


Expand All @@ -272,7 +359,8 @@ and Asn1Child = {
and Choice = {
children : ChChildInfo list
acnProperties : ChoiceAcnProperties
constraints : Asn1Constraint list
cons : ChoiceConstraint list
withcons : ChoiceConstraint list
}

and ChChildInfo = {
Expand Down Expand Up @@ -304,11 +392,19 @@ type TypeAssignment = {

}

type ValueAssignment = {
Name:StringLoc
c_name:string
ada_name:string
Type:Asn1Type
Value:Asn1Value
}


type Asn1Module = {
Name : StringLoc
TypeAssignments : list<TypeAssignment>
ValueAssignments : list<Asn1Ast.ValueAssignment>
ValueAssignments : list<ValueAssignment>
Imports : list<Asn1Ast.ImportedModule>
Exports : Asn1Ast.Exports
Comments : string array
Expand All @@ -327,6 +423,22 @@ type AstRoot = {
}



let rec getASN1Name (t:Asn1Type) =
match t.Kind with
| Integer _ -> "INTEGER"
| Real _ -> "REAL"
| IA5String _ -> "IA5String"
| NumericString _ -> "NumericString"
| OctetString _ -> "OCTET STRING"
| NullType _ -> "NULL"
| BitString _ -> "BIT STRING"
| Boolean _ -> "BOOLEAN"
| Enumerated _ -> "ENUMERATED"
| SequenceOf _ -> "SEQUENCE OF"
| Sequence _ -> "SEQUENCE"
| Choice _ -> "CHOICE"
| ReferenceType r -> getASN1Name r.baseType
(*
type AstRoot with
Expand Down
18 changes: 17 additions & 1 deletion FrontEndAst/Asn1Ast.fs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,6 @@ open Antlr.Runtime
open FsUtils
open CommonTypes


/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////// ASN1 VALUES DEFINITION ////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Expand Down Expand Up @@ -327,3 +326,20 @@ let GetActualTypeByNameAllConsIncluded modName tasName (r:AstRoot) =
let mdl = r.GetModuleByName(modName)
let tas = mdl.GetTypeAssignmentByName tasName r
GetActualTypeAllConsIncluded tas.Type r


let rec getASN1Name (r:AstRoot) (t:Asn1Type) =
match t.Kind with
| Integer -> "INTEGER"
| Real -> "REAL"
| IA5String -> "IA5String"
| NumericString -> "NumericString"
| OctetString -> "OCTET STRING"
| NullType -> "NULL"
| BitString -> "BIT STRING"
| Boolean -> "BOOLEAN"
| Enumerated _ -> "ENUMERATED"
| SequenceOf _ -> "SEQUENCE OF"
| Sequence _ -> "SEQUENCE"
| Choice _ -> "CHOICE"
| ReferenceType _ -> getASN1Name r (GetActualType t r)
Loading

0 comments on commit 09c0a48

Please sign in to comment.