Some work on types

Author: hagane

ngc/FormGenerator.fs

@@ -24,6 +24,7 @@ open System.Collections.Generic
 open System.Reflection
 open System.Reflection.Emit
 open Naggum.Runtime
+open Naggum.Compiler.Globals
 open Naggum.Compiler.Reader
 open Naggum.Compiler.Context
 open Naggum.Compiler.IGenerator
@@ -259,4 +260,43 @@ type NewObjGenerator(context : Context, typeBuilder : TypeBuilder, typeName : st
             if typeName.StartsWith "System" then
                 [Type.GetType typeName]
             else
-                [context.types.[typeName]]
+                [context.types.[typeName]]
+
+type TypeGenerator(context : Context, typeBuilder : TypeBuilder, typeName : string, parentTypeName: string, members : SExp list, gf : IGeneratorFactory) =
+    let newTypeBuilder = 
+        if parentTypeName = "" then
+            Globals.ModuleBuilder.DefineType(typeName, TypeAttributes.Class ||| TypeAttributes.Public, typeof<obj>)
+        else
+            Globals.ModuleBuilder.DefineType(typeName, TypeAttributes.Class ||| TypeAttributes.Public, context.types.[parentTypeName])
+    let newGeneratorFactory = gf.MakeGeneratorFactory newTypeBuilder
+    let mutable fields : string list = []
+
+    let generate_field field_name =
+        let fieldBuilder = newTypeBuilder.DefineField(field_name,typeof<obj>,FieldAttributes.Public)
+        fields <- List.append fields [field_name]
+    let generate_method method_name method_parms method_body =
+        let method_gen = newTypeBuilder.DefineMethod(method_name,MethodAttributes.Public,
+                            typeof<obj>,
+                            Array.create (List.length method_parms) typeof<obj>)
+        let method_ctx = new Context(context)
+        for parm in method_parms do
+            match parm with
+            | Atom(Symbol parm_name) ->
+                let parm_idx = (List.findIndex (fun (p) -> p = parm) method_parms)
+                method_ctx.locals.[parm_name] <- Arg (parm_idx,typeof<obj>)
+            | other -> failwithf "In method %A%A parameter definition:\nExpected: Atom(Symbol)\nGot: %A" typeName method_name parm
+        let body_gen = newGeneratorFactory.MakeBody method_ctx method_body
+        body_gen.Generate (method_gen.GetILGenerator())
+        (method_gen.GetILGenerator()).Emit(OpCodes.Ret)
+
+    interface IGenerator with
+        member this.Generate ilGen = 
+            for m in members do
+                match m with
+                | List (Atom (Symbol "field") :: Atom (Symbol name) :: []) -> generate_field name
+                | List (Atom (Symbol "field") :: Atom (Symbol access) :: Atom (Symbol name) :: []) -> generate_field name
+                | List (Atom (Symbol "method") :: Atom (Symbol name) :: List parms :: body) -> generate_method name parms body
+                | List (Atom (Symbol "method") :: Atom (Symbol name) :: Atom (Symbol access) :: List parms :: body) -> generate_method name parms body
+                | other -> failwithf "In definition of type %A: \nUnknown member definition: %A" typeName other
+        member this.ReturnTypes () =
+            [typeof<System.Void>]

ngc/Generator.fs

@@ -26,6 +26,7 @@ open System.Collections.Generic
 open System.Reflection
 open System.Reflection.Emit
 
+open Naggum.Compiler.Globals
 open Naggum.Compiler.IGenerator
 open Naggum.Compiler.GeneratorFactory
 open Naggum.Compiler.Reader
@@ -43,8 +44,8 @@ let private epilogue context typeBuilder (ilGen : ILGenerator) =
 let compile (source : Stream) (assemblyName : string) (fileName : string) (asmRefs:string list): unit =
     let assemblyName = new AssemblyName(assemblyName)
     let assemblyBuilder = AppDomain.CurrentDomain.DefineDynamicAssembly(assemblyName, AssemblyBuilderAccess.Save)
-    let moduleBuilder = assemblyBuilder.DefineDynamicModule(assemblyBuilder.GetName().Name, fileName)
-    let typeBuilder = moduleBuilder.DefineType("Program", TypeAttributes.Public ||| TypeAttributes.Class ||| TypeAttributes.BeforeFieldInit)
+    Globals.ModuleBuilder <- assemblyBuilder.DefineDynamicModule(assemblyBuilder.GetName().Name, fileName)
+    let typeBuilder = Globals.ModuleBuilder.DefineType("Program", TypeAttributes.Public ||| TypeAttributes.Class ||| TypeAttributes.BeforeFieldInit)
     let methodBuilder = typeBuilder.DefineMethod("Main", MethodAttributes.Public ||| MethodAttributes.Static, typeof<int>, [| |])
 
     let gf = new GeneratorFactory(typeBuilder) :> IGeneratorFactory

ngc/GeneratorFactory.fs

@@ -124,3 +124,5 @@ type GeneratorFactory(typeBldr:TypeBuilder) =
         member this.MakeSequence context seq = this.makeSequenceGenerator (context,seq) :> IGenerator
 
         member this.MakeBody context body = this.makeBodyGenerator (context,body) :> IGenerator
+
+        member this.MakeGeneratorFactory newTypeBuilder = (new GeneratorFactory (newTypeBuilder)) :> IGeneratorFactory

ngc/Globals.fs

@@ -0,0 +1,24 @@
+(*  Copyright (C) 2011-2012 by ForNeVeR,Hagane
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE. *)
+module Naggum.Compiler.Globals
+
+open System.Reflection.Emit
+
+let mutable ModuleBuilder:ModuleBuilder = null

ngc/IGenerator.fs

@@ -38,4 +38,5 @@ type IGeneratorFactory =
         abstract MakeGenerator : Context -> SExp -> IGenerator
         abstract MakeSequence : Context -> SExp list -> IGenerator
         abstract MakeBody : Context -> SExp list -> IGenerator
+        abstract MakeGeneratorFactory : TypeBuilder -> IGeneratorFactory
     end

ngc/ngc.fsproj

@@ -38,6 +38,7 @@
   <Import Project="$(MSBuildExtensionsPath32)\FSharp\1.0\Microsoft.FSharp.Targets" Condition="!Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
   <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
   <ItemGroup>
+    <Compile Include="Globals.fs" />
     <Compile Include="Reader.fs" />
     <Compile Include="Context.fs" />
     <Compile Include="IGenerator.fs" />