added PruneMerge

Bluebonnet.sln

@@ -27,6 +27,8 @@ Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Tests", "Tests\Tests.csproj
 		{085399FC-1934-43A4-A9C8-EC3137BAEA8E} = {085399FC-1934-43A4-A9C8-EC3137BAEA8E}
 	EndProjectSection
 EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "PruneMerge", "PruneMerge\PruneMerge.fsproj", "{2F6C6AAD-44DA-4993-BDDB-F6B3F3424916}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -53,6 +55,10 @@ Global
 		{408EA5F6-2A53-4472-90DA-CC80D5ACEA13}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{408EA5F6-2A53-4472-90DA-CC80D5ACEA13}.Release|Any CPU.ActiveCfg = Release|Any CPU
 		{408EA5F6-2A53-4472-90DA-CC80D5ACEA13}.Release|Any CPU.Build.0 = Release|Any CPU
+		{2F6C6AAD-44DA-4993-BDDB-F6B3F3424916}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{2F6C6AAD-44DA-4993-BDDB-F6B3F3424916}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{2F6C6AAD-44DA-4993-BDDB-F6B3F3424916}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{2F6C6AAD-44DA-4993-BDDB-F6B3F3424916}.Release|Any CPU.Build.0 = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE

JavaBinary/src/JavaConstantPool.cs

@@ -96,6 +96,10 @@ namespace SpaceFlint.JavaBinary
 
 
 
+        public int Count => pool.Count;
+
+
+
         public JavaConstant Get(int index)
         {
             return ((index > 0 && index < pool.Count) ? pool[index] : null);

JavaBinary/src/JavaReader.cs

@@ -10,6 +10,13 @@ namespace SpaceFlint.JavaBinary
     public class JavaReader
     {
 
+        public class JavaClassEx
+        {
+            public JavaClass JavaClass;
+            public JavaConstantPool Constants;
+            public byte[] RawBytes;
+        }
+
         internal JavaClass Class;
         internal JavaException.Where Where;
 
@@ -31,12 +38,11 @@ namespace SpaceFlint.JavaBinary
 
 
 
-        public static JavaClass ReadClass(System.IO.Compression.ZipArchiveEntry entry,
-                                          bool withCode = true)
+        public static JavaClassEx ReadClassEx(System.IO.Compression.ZipArchiveEntry entry,
+                                              bool withCode = true)
         {
-            JavaClass jclass = null;
-            if (    (! string.IsNullOrEmpty(Path.GetFileName(entry.FullName)))
-                 && entry.Length > 4)
+            if (entry.Length > 4 &&
+                    (! string.IsNullOrEmpty(Path.GetFileName(entry.FullName))))
             {
                 using (var stream = entry.Open())
                 {
@@ -54,22 +60,35 @@ namespace SpaceFlint.JavaBinary
                             stream2.Position = 0;
 
                             var whereText = $"entry '{entry.FullName}' in archive";
-                            jclass = (new JavaReader(stream2, whereText, withCode)).Class;
+                            var rdr = new JavaReader(stream2, whereText, withCode);
 
-                            if (jclass != null)
+                            if (rdr.Class != null)
                             {
-                                jclass.PackageNameLength =
+                                rdr.Class.PackageNameLength =
                                         (short) Path.GetDirectoryName(entry.FullName).Length;
+
+                                return new JavaClassEx
+                                {
+                                    JavaClass = rdr.Class,
+                                    Constants = rdr.constants,
+                                    RawBytes = stream2.ToArray()
+                                };
                             }
                         }
                     }
                 }
             }
-            return jclass;
+            return null;
         }
 
 
 
+        public static JavaClass ReadClass(System.IO.Compression.ZipArchiveEntry entry,
+                                          bool withCode = true)
+            => ReadClassEx(entry, withCode)?.JavaClass;
+
+
+
         JavaReader(Stream _stream, string whereText, bool withCode)
         {
             Where = new JavaException.Where();

JavaBinary/src/JavaStackMap.cs

@@ -562,7 +562,7 @@ namespace SpaceFlint.JavaBinary
 
             ushort lastOffset = 0xFFFF;
             if (! frames.TryGetValue(0, out var lastFrame))
-                throw new Exception("stackmap does not include frame for offset 0");
+                throw wtr.Where.Exception("stackmap does not include frame for offset 0");
 
             var frames3 = new List<JavaAttribute.StackMapTable.Item>();
             foreach (var kvp in frames2)

PruneMerge/Cmdline.fs

@@ -0,0 +1,32 @@
+
+module Cmdline
+
+type Cmdline = {
+    Inputs: string list
+    Output: string
+    Roots:  string list
+}
+
+let private exeName = System.Diagnostics.Process.GetCurrentProcess().MainModule.ModuleName
+
+let private usage () =
+    printfn "usage: %s inputfile [inputfile2..] outputfile :keepclass [:keepclass2..]" exeName
+    printfn "Merges one or more input JARs into one output JAR, while pruning unreferenced classes."
+    None
+
+let private parseArgsList (args: string list) =
+    let (classes, args) = args |> List.partition (fun arg -> arg.Length > 1 && arg.StartsWith ":")
+    let (files, args) = args |> List.partition (fun arg -> arg.Length > 0 && not (arg.StartsWith ":"))
+    if files.Length >= 2 && classes.Length >= 1 && args.Length = 0
+    then Some { Inputs = List.take (files.Length - 1) files
+                Output = List.last files
+                Roots = classes |> List.map (fun arg -> arg.Substring 1)
+              }
+    else usage()
+
+let print format =
+    Printf.ksprintf (fun msg -> printfn "%s: %s" exeName msg) format
+
+let parse args =
+    if isNull args then usage ()
+    else Array.toList args |> parseArgsList

PruneMerge/Program.fs

@@ -0,0 +1,93 @@
+
+module PruneMerge
+
+open System
+open System.IO
+open System.IO.Compression
+open System.Collections.Generic
+open SpaceFlint.JavaBinary
+
+let private SuccessExitCode: int = 0
+let private ErrorExitCode: int = 1
+exception IoError of string * Exception
+
+let readJar path =
+    try
+        use file = File.OpenRead path
+        use jar = new ZipArchive (file, ZipArchiveMode.Read)
+        jar.Entries |> Seq.choose (fun entry -> JavaReader.ReadClassEx (entry, false) |> Option.ofObj)
+                    |> Seq.toList
+    with
+    | ex -> raise (IoError ((sprintf "reading '%s'" path), ex))
+
+let readJarsIntoMap inputs =
+    let known = HashSet()
+    inputs |> List.map readJar |> List.concat
+           |> List.map (fun clsex ->
+                            let cls = clsex.JavaClass
+                            if not (known.Add cls.Name)
+                                then failwithf "duplicate class '%s'" cls.Name
+                                else (cls.Name, clsex))
+           |> Map.ofList
+
+let writeListIntoJar (allClasses: Map<string, JavaReader.JavaClassEx>) keepClasses path =
+    try
+        use file = File.Open (path, FileMode.CreateNew)
+        use jar = new ZipArchive (file, ZipArchiveMode.Update)
+        keepClasses |> Set.iter (fun name ->
+            let bytes = (allClasses |> Map.find name).RawBytes
+            let name = name.Replace('.', '/') + ".class"
+            let entry = jar.CreateEntry (name, CompressionLevel.Optimal)
+            use entryStream = entry.Open()
+            entryStream.Write(bytes, 0, bytes.Length)
+        )
+    with
+    | ex -> raise (IoError ((sprintf "writing '%s'" path), ex))
+
+let shrink (allClasses: Map<string, JavaReader.JavaClassEx>) (filterNames: string list) =
+
+    let getClassRefName (constpool: JavaConstantPool) idx =
+        match constpool.Get (idx) with
+        | :? JavaConstant.Class as c ->
+                match constpool.Get (int (c.stringIndex)) with
+                | :? JavaConstant.Utf8 as u -> u.str
+                | _ -> ""
+        | _ -> ""
+
+    let extractClassRefs name (constpool: JavaConstantPool) =
+        let mutable refs = List.empty
+        for i = constpool.Count - 1 downto 0 do
+            let name2 = getClassRefName constpool i
+            if name2.Length > 0
+                then refs <- name2.Replace('/', '.') :: refs
+        refs
+
+    let rec addClass name keep important =
+        if Set.contains name keep then keep
+        else match allClasses |> Map.tryFind name with
+             | None -> if important 
+                       then failwithf "class '%s' not found in input" name
+                       else keep
+             | Some clsex -> extractClassRefs name clsex.Constants
+                             |> List.fold (fun keep name -> addClass name keep false)
+                                          (Set.add name keep)
+
+    filterNames |> List.fold (fun keep name -> addClass name keep true) Set.empty
+
+[<EntryPoint>]
+let main args =
+    Cmdline.parse args |> Option.exists (fun cmd ->
+        if File.Exists cmd.Output then
+            Cmdline.print "error: output file '%s' already exists" cmd.Output
+            false
+        else try
+                let allClasses = readJarsIntoMap cmd.Inputs
+                let keepClasses = shrink allClasses cmd.Roots
+                Cmdline.print "%d classes in input, %d classes in output" allClasses.Count keepClasses.Count 
+                writeListIntoJar allClasses keepClasses cmd.Output
+                true
+             with
+             | Failure msg          -> Cmdline.print "error: %s" msg; false
+             | IoError (path, ex)   -> Cmdline.print "error %s: %s: %s" path (ex.GetType().Name) ex.Message ; false
+             | (* any *) ex         -> Cmdline.print "%s: %s" (ex.GetType().Name) ex.Message ; false
+    ) |> (fun ok -> if ok then 0 else 1) // program exit code

PruneMerge/PruneMerge.fsproj

@@ -0,0 +1,28 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+  <PropertyGroup>
+    <ProjectGuid>{2F6C6AAD-44DA-4993-BDDB-F6B3F3424916}</ProjectGuid>
+    <OutputType>Exe</OutputType>
+    <RootNamespace>SpaceFlint.PruneMerge</RootNamespace>
+    <AssemblyName>PruneMerge</AssemblyName>
+    <GenerateTargetFrameworkAttribute>false</GenerateTargetFrameworkAttribute>
+    <ProjectLanguage>FSharp</ProjectLanguage>
+    <RunPostBuildEvent>OnOutputUpdated</RunPostBuildEvent>
+  </PropertyGroup>
+  <Import Project="..\Solution.project" />
+  <ItemGroup>
+    <Compile Include="Cmdline.fs" />
+    <Compile Include="Program.fs" />
+    <Content Include="packages.config" />
+  </ItemGroup>
+  <ItemGroup>
+    <ProjectReference Include="..\JavaBinary\JavaBinary.csproj">
+      <Project>{e9ad82d2-f50f-47d0-af81-98fae604d910}</Project>
+      <Name>JavaBinary</Name>
+    </ProjectReference>
+    <Reference Include="FSharp.Core">
+      <HintPath>..\packages\FSharp.Core.4.7.2\lib\net45\FSharp.Core.dll</HintPath>
+    </Reference>
+    <Reference Include="System.IO.Compression" />
+  </ItemGroup>
+</Project>

PruneMerge/packages.config

@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="utf-8"?>
+<packages>
+  <package id="FSharp.Core" version="4.7.2" targetFramework="net472" />
+</packages>

Tests/src/TestException.cs

@@ -372,6 +372,7 @@ namespace Tests
 
 
 
+
         void TestNestedTry7()
         {
             try
@@ -386,6 +387,7 @@ namespace Tests
                 {
                     Console.WriteLine("Try2.Finally");
                 }
+                #pragma warning disable 0162
                 Console.WriteLine("Try1.Stmt2");
             }
             finally