namespace Microsoft.FSharp.Compiler.CodeDom.Internal open System open System.IO open System.Text open System.Text.RegularExpressions open System.Collections open System.Diagnostics open System.CodeDom open System.Security open System.Security.Permissions open System.CodeDom.Compiler module internal AssemblyAttributes = //[] do() //------------------------------------------------------------------------------------------------- module internal Global = let debug_commandline_args = true let (++) x y = Path.Combine(x,y) // search for "fsc.exe" let FscExeBaseName = "fsc.exe" let FSharpRunningVersion = Internal.Utilities.FSharpEnvironment.FSharpRunningVersion let FSharpBinFromRegistry = Internal.Utilities.FSharpEnvironment.FSharpRunningBinFolder let FSharpBinFromEnvironmentVariable = try match System.Environment.GetEnvironmentVariable("FSHARP_BIN") with | null -> None | s -> Some(s) with _ -> None // Note: this techniue is now deprecated by FSharpBinFromRegistry above let FSharpBinFromInstallLocationGuess = try match FSharpRunningVersion with | Some v -> Some(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) ++ "FSharp-" + v) | _ -> None with _ -> None let FscPath = let tryFscPath x = match x with | None -> None | Some dir -> let fscName = dir ++ FscExeBaseName if File.Exists(fscName) then Some(fscName) else None let search0 = tryFscPath(FSharpBinFromRegistry) in match search0 with | Some(res) -> res | None -> let search1 = tryFscPath(FSharpBinFromEnvironmentVariable) match search1 with | Some(res) -> res | None -> let search2 = tryFscPath(FSharpBinFromInstallLocationGuess) match search2 with | Some(res) -> res | None -> FscExeBaseName // regular expressions for parsing result let regParseFsOutput = Regex(@"(?[^\(]*)\((?[0-9]*),(?[0-9]*)\):\s(?[^:]*)\s(?[^:]*):\s(?.*)", RegexOptions.Compiled); let regParseFsOutputNoNum = Regex(@"(?[^\(]*)\((?[0-9]*),(?[0-9]*)\):\s(?[^:]*)\s(?.*)", RegexOptions.Compiled); //------------------------------------------------------------------------------------------------- module internal Compiler = let id a = a let (+>) (ctx:StringBuilder) (foo:StringBuilder -> StringBuilder) = foo ctx; let (--) (ctx:StringBuilder) (str:String) = ctx.Append(str) let untyped_fold f col st = Seq.fold f st (Seq.cast col) // Generate command-line arguments for FSC let cmdArgsFromParameters (o:CompilerParameters) filenames = let sb = new StringBuilder(50) (sb +> if (not o.GenerateExecutable) then (fun ctx -> ctx -- "-a ") else id +> untyped_fold (fun ctx e -> ctx -- "-r:\"" -- e -- "\" ") o.ReferencedAssemblies -- "--nologo -o:\"" -- o.OutputAssembly -- "\" " +> if (o.IncludeDebugInformation) then (fun ctx -> ctx -- "--debug+ ") else id +> if (o.Win32Resource <> null) then (fun ctx -> ctx -- "--win32res \"" -- o.Win32Resource -- "\" ") else id +> if (o.CompilerOptions <> null) then (fun ctx -> ctx -- o.CompilerOptions -- " ") else id) // Never treat warnings as errors - this overrides "#nowarn", but the generated code // will contain some warnings in almost any case... // +> if (o.TreatWarningsAsErrors) then (fun ctx -> ctx -- "--warnaserror ") else id |> ignore filenames |> Array.iter ( fun (fn:string) -> ignore (sb.AppendFormat(" \"{0}\"", fn)) ) sb.ToString(); // Process FSC output let processMsg msg (res:CompilerResults) = let m = let t1 = Global.regParseFsOutput.Match(msg) in if (t1.Success) then t1 else Global.regParseFsOutputNoNum.Match(msg) let ce = if (m.Success) then let errNo = (if (m.Groups.Item("err") <> null) then (m.Groups.Item("err")).Value else "") let ce = CompilerError(m.Groups.Item("file").Value, Int32.Parse(m.Groups.Item("line").Value), Int32.Parse(m.Groups.Item("col").Value), errNo, m.Groups.Item("msg").Value); ce.IsWarning <- ((m.Groups.Item("type")).Value = "warning"); ce else new CompilerError("unknown-file", 0, 0, "0", msg); res.Errors.Add(ce) |> ignore // Invoke FSC compiler and parse output let compileFiles args (res:CompilerResults) = let p = new Process() in p.StartInfo.FileName <- Global.FscPath; p.StartInfo.UseShellExecute <- false; p.StartInfo.Arguments <- args; p.StartInfo.RedirectStandardError <- true; p.StartInfo.CreateNoWindow <- true; p.Start() |> ignore // useful when debugging if (Global.debug_commandline_args) then let s = res.TempFiles.AddExtension("cmdargs") use sw = new StreamWriter(s); sw.WriteLine(args); let mutable serr = "" let mutable smsg = "" while (serr <- p.StandardError.ReadLine(); serr <> null) do if (serr.Trim().Length = 0 && smsg <> "") then processMsg smsg res; smsg <- ""; else smsg <- smsg + " " + (serr.Trim()); if (smsg <> "") then processMsg smsg res; p.WaitForExit(); res.NativeCompilerReturnValue <- p.ExitCode; // Compile assembly from given array of files let compileAssemblyFromFileBatch (options:CompilerParameters) (fileNames:string array) (results:CompilerResults) sortf : CompilerResults = // Call 'fix' sorting function let fileNames = sortf fileNames let createdAssembly = if (options.OutputAssembly = null || options.OutputAssembly.Length = 0) then begin let extension = if (options.GenerateExecutable) then "exe" else "dll" options.OutputAssembly <- results.TempFiles.AddExtension(extension, not options.GenerateInMemory) // Create an empty assembly, so the file can be later accessed using current credential. let fs = new FileStream(options.OutputAssembly, FileMode.Create, FileAccess.ReadWrite) in fs.Close(); true; end else false in ignore(results.TempFiles.AddExtension("pdb")); // Compile.. let args = cmdArgsFromParameters options fileNames compileFiles args results; if (options.GenerateInMemory) then use fs = new FileStream(options.OutputAssembly, FileMode.Open, FileAccess.Read, FileShare.Read) let count = int32 fs.Length if (count > 0) then let buffer = (Array.zeroCreate count) fs.Read(buffer, 0, count) |> ignore (new SecurityPermission(SecurityPermissionFlag.ControlEvidence)).Assert(); try results.CompiledAssembly <- System.Reflection.Assembly.Load(buffer, null, options.Evidence); finally CodeAccessPermission.RevertAssert(); else results.PathToAssembly <- options.OutputAssembly; // Delete the assembly if we created it if (createdAssembly) then File.Delete(options.OutputAssembly); results