diff --git a/Naggum.Assembler/Assembler.fs b/Naggum.Assembler/Assembler.fs index 2c6d593..ff437ec 100644 --- a/Naggum.Assembler/Assembler.fs +++ b/Naggum.Assembler/Assembler.fs @@ -28,8 +28,9 @@ let private buildMethodBody (m : MethodDefinition) (builder : MethodBuilder) = | Call signature -> let methodInfo = findMethod signature generator.Emit (OpCodes.Call, methodInfo) + | LdcI4 i -> generator.Emit (OpCodes.Ldc_I4, i) | Ldstr string -> generator.Emit (OpCodes.Ldstr, string) - | Ret -> generator.Emit (OpCodes.Ret)) + | SimpleInstruction r -> generator.Emit r) let private assembleUnit (assemblyBuilder : AssemblyBuilder) (builder : ModuleBuilder) = function | Method m -> @@ -45,11 +46,12 @@ let private assembleUnit (assemblyBuilder : AssemblyBuilder) (builder : ModuleBu assemblyBuilder.SetEntryPoint methodBuilder buildMethodBody m methodBuilder -let private assembleAssembly (assembly : Assembly) = +/// Assembles the intermediate program representation. Returns an assembled +/// module. +let assemble (mode : AssemblyBuilderAccess) (assembly : Assembly) = let name = AssemblyName assembly.Name let domain = AppDomain.CurrentDomain - let builder = domain.DefineDynamicAssembly (name, - AssemblyBuilderAccess.Save) + let builder = domain.DefineDynamicAssembly (name, mode) let fileName = assembly.Name + ".dll" // TODO: Proper file naming let moduleBuilder = builder.DefineDynamicModule (assembly.Name, fileName) assembly.Units |> List.iter (assembleUnit builder moduleBuilder) @@ -58,6 +60,7 @@ let private assembleAssembly (assembly : Assembly) = /// Assembles the intermediate program representation. Returns a list of /// assemblies ready for saving. -let assemble (assemblies : Assembly seq) : AssemblyBuilder seq = +let assembleAll (mode : AssemblyBuilderAccess) + (assemblies : Assembly seq) : AssemblyBuilder seq = assemblies - |> Seq.map assembleAssembly + |> Seq.map (assemble mode) diff --git a/Naggum.Assembler/Processor.fs b/Naggum.Assembler/Processor.fs index 2551eed..557c84f 100644 --- a/Naggum.Assembler/Processor.fs +++ b/Naggum.Assembler/Processor.fs @@ -3,11 +3,20 @@ open System open System.IO open System.Reflection +open System.Reflection.Emit open Naggum.Assembler.Representation open Naggum.Backend open Naggum.Backend.Matchers +let private (|SimpleOpCode|_|) = function + | Symbol "add" -> Some (SimpleInstruction OpCodes.Add) + | Symbol "div" -> Some (SimpleInstruction OpCodes.Div) + | Symbol "mul" -> Some (SimpleInstruction OpCodes.Mul) + | Symbol "ret" -> Some (SimpleInstruction OpCodes.Ret) + | Symbol "sub" -> Some (SimpleInstruction OpCodes.Sub) + | _ -> None + let private processMetadataItem = function | Symbol ".entrypoint" -> EntryPoint | other -> failwithf "Unrecognized metadata item definition: %A" other @@ -42,10 +51,11 @@ let private processMethodSignature = function let private processInstruction = function | List [Symbol "ldstr"; String s] -> Ldstr s + | List [Symbol "ldc.i4"; Integer i] -> LdcI4 i | List [Symbol "call"; List calleeSignature] -> let signature = processMethodSignature calleeSignature Call signature - | List [Symbol "ret"] -> Ret + | List [SimpleOpCode r] -> r | other -> failwithf "Unrecognized instruction: %A" other let private addMetadata metadata method' = diff --git a/Naggum.Assembler/Program.fs b/Naggum.Assembler/Program.fs index acff804..c1466e4 100644 --- a/Naggum.Assembler/Program.fs +++ b/Naggum.Assembler/Program.fs @@ -26,7 +26,7 @@ let private save (assembly : AssemblyBuilder) = let private assemble fileName = use stream = File.OpenRead fileName let repr = Processor.prepare fileName stream - let assemblies = Assembler.assemble repr + let assemblies = Assembler.assembleAll AssemblyBuilderAccess.Save repr assemblies |> Seq.iter save let private nga = diff --git a/Naggum.Assembler/Representation.fs b/Naggum.Assembler/Representation.fs index fd6d92a..3fb8049 100644 --- a/Naggum.Assembler/Representation.fs +++ b/Naggum.Assembler/Representation.fs @@ -1,6 +1,7 @@ namespace Naggum.Assembler.Representation open System.Reflection +open System.Reflection.Emit type MetadataItem = | EntryPoint @@ -20,7 +21,8 @@ type MethodSignature = type Instruction = | Call of MethodSignature | Ldstr of string - | Ret + | LdcI4 of int + | SimpleInstruction of OpCode type MethodDefinition = { Metadata : Set diff --git a/Naggum.Backend/Matchers.fs b/Naggum.Backend/Matchers.fs index c5b013a..7baa31e 100644 --- a/Naggum.Backend/Matchers.fs +++ b/Naggum.Backend/Matchers.fs @@ -5,6 +5,10 @@ let (|Symbol|Object|List|) = function | Reader.Atom (Reader.Symbol x) -> Symbol x | Reader.List l -> List l +let (|Integer|_|) = function + | Object (:? int as i) -> Some i + | _ -> None + let (|String|_|) = function | Object (:? string as s) -> Some s | _ -> None diff --git a/Naggum.Test/AssemblerTests.fs b/Naggum.Test/AssemblerTests.fs index c75129e..55fa98e 100644 --- a/Naggum.Test/AssemblerTests.fs +++ b/Naggum.Test/AssemblerTests.fs @@ -1,6 +1,7 @@ module Naggum.Test.AssemblerTests open System.IO +open System.Reflection.Emit open System.Text open Xunit @@ -10,12 +11,11 @@ open Naggum.Assembler let assemble (source : string) = use stream = new MemoryStream(Encoding.UTF8.GetBytes source) let repr = Processor.prepare "file.ngi" stream - let assemblies = Assembler.assemble repr - List.ofSeq assemblies + Assembler.assemble AssemblyBuilderAccess.Save (Seq.exactlyOne repr) let execute source = let fileName = "file.exe" - let assembly = (Seq.exactlyOne << assemble) source + let assembly = assemble source assembly.Save fileName Process.run fileName @@ -24,10 +24,10 @@ let execute source = let ``Empty assembly should be assembled`` () = let source = "(.assembly Empty)" let result = assemble source - Assert.Equal (1, result.Length) + Assert.NotNull result [] -let ``Hello world should be executed`` () = +let ``Hello world program should be executed`` () = let source = "(.assembly Hello (.method Main () System.Void (.entrypoint) (ldstr \"Hello, world!\") @@ -36,3 +36,18 @@ let ``Hello world should be executed`` () = " let output = execute source Assert.Equal ("Hello, world!\n", output) + +[] +let ``Sum program should be executed`` () = + let source = "(.assembly Sum + (.method Main () System.Void (.entrypoint) + (ldc.i4 10) + (ldc.i4 20) + (ldc.i4 30) + (add) + (add) + (call (mscorlib System.Console WriteLine (System.Int32) System.Void)) + (ret))) +" + let output = execute source + Assert.Equal ("60\n", output) diff --git a/Naggum.Test/InstructionTests.fs b/Naggum.Test/InstructionTests.fs new file mode 100644 index 0000000..5ad59e4 --- /dev/null +++ b/Naggum.Test/InstructionTests.fs @@ -0,0 +1,35 @@ +module Naggum.Test.InstructionTests + +open System.IO +open System.Reflection.Emit +open System.Text + +open Xunit + +open Naggum.Assembler + +let checkResult (body : string) (expectedResult : obj) = + // TODO: FSCheck tests + let source = + sprintf + <| "(.assembly Hello + (.method Test () %s () + %s) +)" + <| (expectedResult.GetType().FullName) + <| body + use stream = new MemoryStream(Encoding.UTF8.GetBytes source) + let repr = Processor.prepare "file.ngi" stream |> Seq.exactlyOne + let assembly = Assembler.assemble AssemblyBuilderAccess.RunAndCollect repr + let ``module`` = assembly.GetModules () |> Seq.last // TODO: More proper check for *our* module. Why are there 2? + let ``method`` = ``module``.GetMethod "Test" + let result = ``method``.Invoke (null, [| |]) + Assert.Equal (expectedResult, result) + +[] +[] +[] +[] +[] +let ``Integer math should work properly`` (code, result) = + checkResult code result diff --git a/Naggum.Test/Naggum.Test.fsproj b/Naggum.Test/Naggum.Test.fsproj index 07906c2..75ec8d1 100644 --- a/Naggum.Test/Naggum.Test.fsproj +++ b/Naggum.Test/Naggum.Test.fsproj @@ -54,8 +54,9 @@ - + + diff --git a/Naggum.Test/ProcessorTests.fs b/Naggum.Test/ProcessorTests.fs index b5ffa24..aba348c 100644 --- a/Naggum.Test/ProcessorTests.fs +++ b/Naggum.Test/ProcessorTests.fs @@ -3,6 +3,7 @@ open System open System.IO open System.Reflection +open System.Reflection.Emit open System.Text open Xunit @@ -17,7 +18,7 @@ let mainMethodDefinition = Visibility = Public Name = "Main" ArgumentTypes = List.empty - ReturnType = typeof + ReturnType = typeof Body = List.empty } let consoleWriteLine = @@ -48,8 +49,8 @@ let ``Simplest method should be processed`` () = " let result = { Name = "Stub" - Units = [Method { mainMethodDefinition with - Body = [ Ret ] } ] } + Units = [Method { mainMethodDefinition with + Body = [ SimpleInstruction OpCodes.Ret ] } ] } checkPreparationResult source [result] [] @@ -66,8 +67,8 @@ let ``Hello world assembly should be processed`` () = Visibility = Public Name = "Main" ArgumentTypes = List.empty - ReturnType = typeof + ReturnType = typeof Body = [ Ldstr "Hello, world!" Call consoleWriteLine - Ret ] } ] } + SimpleInstruction OpCodes.Ret ] } ] } checkPreparationResult source [result]