Integer arithmetic

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)

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' =

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 =

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<MetadataItem>

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

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
 
 [<Fact>]
-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)
+
+[<Fact>]
+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)

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)
+
+[<Theory>]
+[<InlineData("(ldc.i4 1) (ldc.i4 2) (add) (ret)", 3)>]
+[<InlineData("(ldc.i4 10) (ldc.i4 20) (sub) (ret)", -10)>]
+[<InlineData("(ldc.i4 5) (ldc.i4 30) (mul) (ret)", 150)>]
+[<InlineData("(ldc.i4 9) (ldc.i4 4) (div) (ret)", 2)>]
+let ``Integer math should work properly`` (code, result) =
+    checkResult code result

Naggum.Test/Naggum.Test.fsproj

@@ -54,8 +54,9 @@
     <Content Include="packages.config" />
     <Compile Include="Process.fs" />
     <Compile Include="CompilerTest.fs" />
-    <Compile Include="AssemblerTests.fs" />
+    <Compile Include="InstructionTests.fs" />
     <Compile Include="ProcessorTests.fs" />
+    <Compile Include="AssemblerTests.fs" />
     <Compile Include="MatchersTests.fs" />
   </ItemGroup>
   <ItemGroup>

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<Void> 
+      ReturnType = typeof<Void>
       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]
 
 [<Fact>]
@@ -66,8 +67,8 @@ let ``Hello world assembly should be processed`` () =
                             Visibility = Public
                             Name = "Main"
                             ArgumentTypes = List.empty
-                            ReturnType = typeof<Void> 
+                            ReturnType = typeof<Void>
                             Body = [ Ldstr "Hello, world!"
                                      Call consoleWriteLine
-                                     Ret ] } ] }
+                                     SimpleInstruction OpCodes.Ret ] } ] }
     checkPreparationResult source [result]