compiler.vb

大名鼎鼎的mono是.NET平台的跨平台（支持linux

        m_tm = New tm(Me, m_ConditionalCompiler)
        m_Parser = New Parser(Me)

        theAss = Parser.Parse(RootNamespace)

        SequenceTime(CompilerSequence.Parsed) = DateTime.Now

        VerifyConsistency(result)

#If DEBUG AndAlso False Then
        Dim xml As Xml.XmlTextWriter
        xml = New Xml.XmlTextWriter(CreateTestOutputFilename(m_OutFilename, "parsedtree"), Text.Encoding.UTF8)
        xml.Formatting = System.Xml.Formatting.Indented
        DumperXML.Dump(theAss, xml)
        xml.Close()
        xml = Nothing
#End If

        Return result
    End Function

    Private Function Compile_Resolve() As Boolean
        Dim result As Boolean = True

#If EXTENDEDDEBUG Then
        Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Starting Resolve")
#End If
        result = CommandLine.Imports.ResolveCode(ResolveInfo.Default(Me)) AndAlso result
        VerifyConsistency(result, "ResolveCode")
        If result = False Then Return result

        result = CommandLine.Files.Resolve(ResolveInfo.Default(Me)) AndAlso result
        VerifyConsistency(result, "Resolve")
        If result = False Then Return result

        result = theAss.CreateImplicitTypes AndAlso result
        VerifyConsistency(result, "CreateImplicitTypes")
        If result = False Then Return result

        result = theAss.ResolveTypes AndAlso result
        VerifyConsistency(result, "ResolveTypes")
        If result = False Then Return result

        result = theAss.ResolveTypeReferences AndAlso result
        VerifyConsistency(result, "ResolveTypeReferences")
        If result = False Then Return result

        m_TypeCache.InitInternalVBMembers()
#If ENABLECECIL Then
        m_CecilTypeCache.InitInternalVBMembers()
#End If

        result = theAss.CreateImplicitMembers AndAlso result
        VerifyConsistency(result, "CreateImplicitMembers")
        If result = False Then Return result

        result = theAss.ResolveMembers AndAlso result
        VerifyConsistency(result, "ResolveMembers")
        result = theAss.ResolveCode(ResolveInfo.Default(Me)) AndAlso result

        SequenceTime(CompilerSequence.Resolved) = DateTime.Now

        VerifyConsistency(result, "FinishedResolve")

#If DEBUG AndAlso False Then
        Dim xml As Xml.XmlTextWriter
        xml = New Xml.XmlTextWriter(CreateTestOutputFilename(m_OutFilename, "typetree"), Text.Encoding.UTF8)
        xml.Formatting = System.Xml.Formatting.Indented
        DumperXML.Dump(theAss, xml)
        xml.Close()
        xml = Nothing
#End If

        Return result
    End Function
#If DEBUG Then
    Private m_Dumper As Dumper
    ReadOnly Property Dumper() As Dumper
        Get
            Return m_Dumper
        End Get
    End Property
#End If

    Function GenerateMy() As Boolean
        Dim result As Boolean = True
        Dim generator As New MyGenerator(Me)

        result = generator.Generate() AndAlso result

        Return result
    End Function

    ''' <summary>
    ''' Compile with the current options.
    ''' </summary>
    ''' <remarks></remarks>
    Function Compile() As Integer
        Dim result As Boolean = True

        Try
            SequenceTime(CompilerSequence.Start) = DateTime.Now

#If DEBUG Then
            'Dump the commandline
            If CommandLine.Dumping Then
                CommandLine.Dump()
            End If

            If CommandLine.Verbose Then
                Console.WriteLine("Runtime loaded from: " & GetType(Microsoft.VisualBasic.Financial).Assembly.Location)
            End If
#End If

            'Show help if asked to
            If CommandLine.Help = True Then
                ShowHelp()
                Return 0
            End If

            'Show logo, unless asked not to
            If CommandLine.NoLogo = False Then ShowLogo()

            If Report.ShowSavedMessages = False Then
                Return 1
            End If

            'Set the culture to en-us to enable correct parsing of numbers, dates, etc.
            Threading.Thread.CurrentThread.CurrentCulture = Globalization.CultureInfo.GetCultureInfo("en-us")

            'Exit if no source files were specified
            If m_CommandLine.Files.Count = 0 Then
                Report.ShowMessage(Messages.VBNC2011)
                Return 1
            End If

            'Set the library of the .net system dir
            m_CommandLine.LibPath.Add(GetSystemDir)

            'Load the referenced assemblies
            If Not CommandLine.References.Contains("mscorlib.dll") Then
                CommandLine.References.Add("mscorlib.dll")
            End If
            If CommandLine.NoVBRuntimeRef = False AndAlso CommandLine.References.Contains("Microsoft.VisualBasic.dll") = False Then
                CommandLine.References.Add("Microsoft.VisualBasic.dll")
            End If

            m_Helper = New Helper(Me)
            m_Helper = New Helper(Me)

            'Calculate the output filename
            result = Compile_CalculateOutputFilename() AndAlso result

            'Load all the referenced assemblies and load all the types and namespaces into the type manager
            m_TypeCache = New TypeCache(Me)
#If ENABLECECIL Then
            m_CecilTypeCache = New CecilTypeCache(Me)
#End If

            result = GenerateMy() AndAlso result

            result = m_TypeManager.LoadReferenced AndAlso result
            If Report.Errors > 0 Then GoTo ShowErrors

            m_NameResolver = New NameResolution(Me) 'Must be created after referenced assemblies have been loaded
            m_TypeResolver = New TypeResolution(Me)


            'Parse the code into the type tree
#If DEBUG Then
            Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Starting Parse")
#End If
            result = Compile_Parse() AndAlso result
            If Report.Errors > 0 Then GoTo ShowErrors


            m_TypeManager.LoadCompiledTypes()

            If CommandLine.NoVBRuntimeRef Then
                m_TypeCache.InitInternalVB()
#If ENABLECECIL Then
                m_CecilTypeCache.InitInternalVB()
#End If
            End If

            'Resolve the code
#If DEBUG Then
            Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Starting Resolve")
#End If
            result = Compile_Resolve() AndAlso result
            If Report.Errors > 0 Then GoTo ShowErrors

            'Create the assembly and module builders
            result = Compile_CreateAssemblyAndModuleBuilders() AndAlso result

            result = AddResources() AndAlso result
            If result = False Then GoTo ShowErrors

            AddHandler AppDomain.CurrentDomain.TypeResolve, New ResolveEventHandler(AddressOf Me.TypeResolver.TypeResolver)

            'Passed this step no errors should be found...
#If DEBUG Then
            Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Starting Define")
#End If

            result = theAss.DefineTypes AndAlso result
            vbnc.Helper.Assert(result, "DefineTypes failed somehow!")

            result = theAss.DefineTypeParameters AndAlso result
            vbnc.Helper.Assert(result, "DefineTypeParameters failed somehow!")

            result = theAss.DefineTypeHierarchy AndAlso result
            vbnc.Helper.Assert(result, "DefineTypeHierarcht failed somehow!")

            result = theAss.DefineMembers AndAlso result
            vbnc.Helper.Assert(result, "DefineMembers failed somehow!")

#If DEBUG Then
            Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Starting Emit")
#End If

            result = theAss.Emit AndAlso result
            vbnc.Helper.Assert(result, "Emit failed somehow")

            'Set the main function / entry point
            result = SetMain() AndAlso result
            If result = False Then GoTo ShowErrors

            'Create the assembly types
            result = theAss.CreateTypes AndAlso result
            vbnc.Helper.Assert(result)

            RemoveHandler AppDomain.CurrentDomain.TypeResolve, New ResolveEventHandler(AddressOf Me.TypeResolver.TypeResolver)

            If result = False Then
                Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Error creating the assembly!")
                GoTo ShowErrors
            End If

#If DEBUGREFLECTION Then
            'Since the assembly save crashes quite often, the finally won't get executed, so dump here as well.
            IO.File.WriteAllText("DebugReflection.vb", vbnc.Helper.DebugReflection_Dump(Me))
#End If

            'Save the assembly
            AssemblyBuilder.Save(IO.Path.GetFileName(m_OutFilename))
            Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, String.Format("Assembly '{0}' saved successfully to '{1}'.", AssemblyBuilder.FullName, m_OutFilename))

#If ENABLECECIL Then

            Mono.Cecil.AssemblyFactory.SaveAssembly(AssemblyBuilderCecil, m_OutFilename)
            Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, String.Format("Assembly '{0}' saved successfully to '{1}'.", AssemblyBuilderCecil.Name.FullName, m_OutFilename))
#End If

            SequenceTime(CompilerSequence.End) = DateTime.Now

ShowErrors:
            VerifyConsistency(result, "ShowErrors")

            If Report.Errors > 0 Or Report.Warnings > 0 Then
                Compiler.Report.WriteLine("There were " & Report.Errors.ToString & " errors and " & Report.Warnings.ToString & " warnings.")
            End If
            If Report.Errors = 0 Then
                Compiler.Report.WriteLine("Compilation successful")
                result = True
            Else
                result = False
            End If

EndOfCompilation:
            result = Report.Errors = 0 AndAlso result

            If result Then
                Return 0
            Else
                Return 1
            End If
        Catch ex As TooManyErrorsException
            Report.ShowMessage(Messages.VBNC30041)
            Return 1
        Catch ex As Exception
            ShowExceptionInfo(ex)
            Return -1
#If DEBUGREFLECTION Then
        Finally
            IO.File.WriteAllText("DebugReflection.vb", vbnc.Helper.DebugReflection_Dump(Me))
#End If
        End Try
        vbnc.Helper.Assert(False, "End of program reached!")
        Return 1
    End Function

    Sub ShowExceptionInfo(ByVal ex As Exception)
#If DEBUG Then
        Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "-------------------------------------------------------------------------------------------------------------------------")
        Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Unhandled exception(" & ex.GetType.ToString & "): " & ex.Message)
        Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, ex.StackTrace)
        If ex.InnerException Is Nothing Then
            Compiler.Report.WriteLine("InnerException: (Nothing)")
        Else
            Compiler.Report.WriteLine("InnerException: " & ex.InnerException.ToString)
        End If
        If ex.GetBaseException Is Nothing Then
            Compiler.Report.WriteLine("GetBaseException: (Nothing)")
        ElseIf ex IsNot ex.GetBaseException Then
            Compiler.Report.WriteLine("GetBaseException: " & ex.GetBaseException.ToString)
        End If
        Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Data.Count: " & ex.Data.Count)
        'Find the line which caused the exception
        Dim strLines(), strLine As String
        If ex.StackTrace IsNot Nothing Then
            strLines = ex.StackTrace.Split(New Char() {VB.Chr(13), VB.Chr(10)}, StringSplitOptions.RemoveEmptyEntries)
            For i As Integer = 0 To strLines.GetUpperBound(0)
                strLine = strLines(i)
                'Remove -at-
                strLine = strLine.Substring(strLine.IndexOf("at ") + 3)
                If strLine.StartsWith("vbnc.", True, Nothing) Then
                    strLine = strLine.Substring(strLine.IndexOf(" in ") + 4)
                    strLine = strLine.Replace(":line ", "(")
                    strLine &= "): " & ex.Message
                    Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, strLine)
                End If
            Next
        End If

        Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Commandline arguments:")
        Compiler.Report.Indent()
        For Each arg As String In CommandLine.AllArguments
            If arg.EndsWith(".vb") = False Then
                Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, arg)
            End If
        Next
        Compiler.Report.Unindent()
        Compiler.Report.WriteLine(ex.Message)

        Dim xml As Xml.XmlTextWriter
        Try
            xml = New Xml.XmlTextWriter(CreateTestOutputFilename(m_OutFilename, "exceptions"), System.Text.Encoding.UTF8)
            xml.Formatting = System.Xml.Formatting.Indented
            xml.WriteStartElement("Sequence")

            For i As Integer = CompilerSequence.Start To CompilerSequence.End
                xml.WriteStartElement(CType(i, CompilerSequence).ToString)
                xml.WriteString(SequenceTime(i).ToLongTimeString())
                xml.WriteEndElement()
            Next

            xml.WriteEndElement()