taught compiler to perform instance calls and fixed some things

Author: hagane

ngc/ClrGenerator.fs

@@ -86,3 +86,22 @@ type ClrCallGenerator(context : Context, typeBuilder : TypeBuilder, clrType : Ty
             let arg_types = args_seq.ReturnTypes()
             let clrMethod = nearestOverload clrType methodName arg_types
             [(Option.get clrMethod).ReturnType]
+
+type InstanceCallGenerator(context : Context, typeBuilder : TypeBuilder, instance : SExp, methodName : string, arguments : SExp list, gf : IGeneratorFactory) =
+    interface IGenerator with
+        member this.Generate ilGen =
+            let inst_gen = gf.MakeGenerator context instance
+            let args_gen = gf.MakeSequence context arguments
+            let methodInfo = nearestOverload (inst_gen.ReturnTypes() |> List.head) methodName (args_gen.ReturnTypes())
+            if Option.isSome methodInfo then
+                inst_gen.Generate ilGen
+                args_gen.Generate ilGen
+                ilGen.Emit(OpCodes.Callvirt,Option.get methodInfo)
+            else failwithf "No overload found for method %A with types %A" methodName (args_gen.ReturnTypes())
+        member this.ReturnTypes () =
+            let inst_gen = gf.MakeGenerator context instance
+            let args_gen = gf.MakeSequence context arguments
+            let methodInfo = nearestOverload (inst_gen.ReturnTypes() |> List.head) methodName (args_gen.ReturnTypes())
+            if Option.isSome methodInfo then
+                [(Option.get methodInfo).ReturnType]
+            else failwithf "No overload found for method %A with types %A" methodName (args_gen.ReturnTypes())

ngc/FormGenerator.fs

@@ -64,7 +64,7 @@ type SequenceGenerator(context:Context,typeBuilder:TypeBuilder,seq:SExp list, gf
     member private this.gen_seq (ilGen:ILGenerator,seq:SExp list) =
         match seq with
             | [] -> 
-                ilGen.Emit(OpCodes.Ldnull)
+                ()
             | [last] ->
                 let gen = gf.MakeGenerator context last
                 gen.Generate ilGen
@@ -247,8 +247,15 @@ type NewObjGenerator(context : Context, typeBuilder : TypeBuilder, typeName : st
         member this.Generate ilGen =
             let args_gen = gf.MakeSequence context arguments
             let argTypes = args_gen.ReturnTypes()
-            let objType = context.types.[typeName]
+            let objType = 
+                 if typeName.StartsWith "System" then
+                    Type.GetType typeName
+                 else
+                    context.types.[typeName]
             let arg_types = args_gen.Generate ilGen
             ilGen.Emit(OpCodes.Newobj,objType.GetConstructor(Array.ofList argTypes))
         member this.ReturnTypes () =
-            [context.types.[typeName]]
+            if typeName.StartsWith "System" then
+                [Type.GetType typeName]
+            else
+                [context.types.[typeName]]

ngc/GeneratorFactory.fs

@@ -82,6 +82,8 @@ type GeneratorFactory(typeBldr:TypeBuilder) =
             new SimpleLogicGenerator(context,typeBldr,arg_a,arg_b,OpCodes.Clt,this) :> IGenerator
         | Atom (Symbol ">") :: arg_a :: arg_b :: [] ->
             new SimpleLogicGenerator(context,typeBldr,arg_a,arg_b,OpCodes.Cgt,this) :> IGenerator
+        |Atom (Symbol "call") :: Atom (Symbol fname) :: instance :: args ->
+            new InstanceCallGenerator(context, typeBldr, instance, fname, args, this) :> IGenerator
         | Atom (Symbol fname) :: args -> //generic funcall pattern
             let tryGetType typeName =
                 try Some (context.types.[typeName]) with
@@ -104,7 +106,7 @@ type GeneratorFactory(typeBldr:TypeBuilder) =
                 let methodName = callMatch.Groups.[2].Value
                 new ClrCallGenerator(context, typeBldr, clrType, methodName, args, this) :> IGenerator
             else
-                new FunCallGenerator(context,typeBldr,fname,args,this) :> IGenerator            
+                new FunCallGenerator(context,typeBldr,fname,args,this) :> IGenerator
         | _ -> failwithf "Form %A is not supported yet" list
 
     member private this.makeSequenceGenerator(context: Context,seq:SExp list) =

ngc/ngc.fsproj

@@ -23,6 +23,7 @@
     <WarningLevel>3</WarningLevel>
     <PlatformTarget>AnyCPU</PlatformTarget>
     <DocumentationFile>bin\Debug\ngc.XML</DocumentationFile>
+    <StartArguments>..\tests\test.naggum</StartArguments>
   </PropertyGroup>
   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
     <DebugType>pdbonly</DebugType>

tests/test.naggum

@@ -32,4 +32,9 @@
   (System.Console.Write "2+2=") (System.Console.WriteLine (+ 2 2))
   (System.Console.Write "2-2=") (System.Console.WriteLine (- 2 2))
   (System.Console.Write "2*3=") (System.Console.WriteLine (* 2 3))
-  (System.Console.Write "2/2=") (System.Console.WriteLine (/ 2 2)))
+  (System.Console.Write "2/2=") (System.Console.WriteLine (/ 2 2))
+
+  (System.Console.WriteLine "Instance calls:")
+  (let ((test-obj (new System.Random)))
+    (System.Console.Write "Random number:")
+	(System.Console.WriteLine (call Next test-obj))))