implemented dynamic overloading of functions

Author: hagane

ngc/ClrGenerator.fs

@@ -74,18 +74,18 @@ let nearestOverload (clrType : Type) methodName types =
 
 type ClrCallGenerator(context : Context, typeBuilder : TypeBuilder, clrType : Type, methodName : string, arguments : SExp list,
                       gf : IGeneratorFactory) =   
+    let args_seq = gf.MakeSequence context arguments
+    let arg_types = args_seq.ReturnTypes()
+    let clrMethod = nearestOverload clrType methodName arg_types
     interface IGenerator with
         member this.Generate ilGen =
-            let args_seq = gf.MakeSequence context arguments
-            let arg_types = args_seq.ReturnTypes()
-            let clrMethod = nearestOverload clrType methodName arg_types
+
             args_seq.Generate ilGen            
             ilGen.Emit(OpCodes.Call, Option.get clrMethod)
+            if (Option.get clrMethod).ReturnType = typeof<Void> then
+                ilGen.Emit(OpCodes.Ldnull);
         member this.ReturnTypes() =
-            let args_seq = gf.MakeSequence context arguments
-            let arg_types = args_seq.ReturnTypes()
-            let clrMethod = nearestOverload clrType methodName arg_types
-            [(Option.get clrMethod).ReturnType]
+            if (Option.get clrMethod).ReturnType = typeof<Void> then [typeof<obj>] else [(Option.get clrMethod).ReturnType]
 
 type InstanceCallGenerator(context : Context, typeBuilder : TypeBuilder, instance : SExp, methodName : string, arguments : SExp list, gf : IGeneratorFactory) =
     interface IGenerator with

ngc/Context.fs

@@ -29,22 +29,22 @@ open Naggum.Compiler.Reader
 
 type ContextValue =
     |Local of LocalBuilder * Type
-    |Arg of int
+    |Arg of int * Type
 
 type Context =
     val types : Dictionary<string,Type>
-    val functions : Dictionary<string, MethodInfo>
+    val functions : Dictionary<string, (Type list -> MethodInfo)>
     val locals : Dictionary<string,ContextValue>
     new (t,f,l) =
         {types = t; functions = f; locals = l}
     new (ctx : Context) =
         let t = new Dictionary<string, Type>(ctx.types)
-        let f = new Dictionary<string, MethodInfo>(ctx.functions)
+        let f = new Dictionary<string, (Type list -> MethodInfo)>(ctx.functions)
         let l = new Dictionary<string,ContextValue>(ctx.locals)
         new Context (t,f,l)
     new() =
         let t = new Dictionary<string, Type>()
-        let f = new Dictionary<string, MethodInfo>()
+        let f = new Dictionary<string, (Type list -> MethodInfo)>()
         let l = new Dictionary<string,ContextValue>()
         new Context (t,f,l)
 

ngc/FormGenerator.fs

@@ -48,16 +48,16 @@ type SymbolGenerator(context:Context,name:string) =
             try
                 let ctxval = context.locals.[name]
                 match ctxval with
-                |Local (local, t) ->
+                |Local (local, _) ->
                     ilGen.Emit(OpCodes.Ldloc,local)
-                |Arg index ->
+                |Arg (index,_) ->
                     ilGen.Emit(OpCodes.Ldarg,(int16 index))
             with
             | :? KeyNotFoundException -> failwithf "Symbol %A not bound." name
         member this.ReturnTypes () =
             match context.locals.[name] with
             |Local (_,t) -> [t]
-            |Arg _ -> [typeof<obj>]
+            |Arg (_,t) -> [t]
 
 
 type SequenceGenerator(context:Context,typeBuilder:TypeBuilder,seq:SExp list, gf:IGeneratorFactory) =
@@ -179,32 +179,33 @@ type FullIfGenerator(context:Context,typeBuilder:TypeBuilder,condition:SExp,if_t
             List.concat (Seq.ofList [true_ret_type; false_ret_type]) //TODO This should return closest common ancestor of these types
 
 type FunCallGenerator(context:Context,typeBuilder:TypeBuilder,fname:string,arguments:SExp list,gf:IGeneratorFactory) =
+    let args_seq = gf.MakeSequence context arguments
+    let func = context.functions.[fname] <| args_seq.ReturnTypes()
     interface IGenerator with
         member this.Generate ilGen =
-            let func = context.functions.[fname]
-            let args_seq = gf.MakeSequence context arguments
-            let arg_types = args_seq.ReturnTypes()
             args_seq.Generate ilGen
             ilGen.Emit(OpCodes.Call,func)
         member this.ReturnTypes () =
-            let func = context.functions.[fname]
             [func.ReturnType]
 
 type DefunGenerator(context:Context,typeBuilder:TypeBuilder,fname:string,parameters:SExp list,body:SExp list,gf:IGeneratorFactory) =
+    do context.functions.[fname] <- (fun arg_types ->
+                                            let methodGen = typeBuilder.DefineMethod(fname, MethodAttributes.Public ||| MethodAttributes.Static, typeof<obj>, (Array.ofList arg_types))
+                                            let methodILGen = (methodGen.GetILGenerator())
+                                            let fun_ctx = new Context(context)
+                                            for parm in parameters do
+                                                match parm with
+                                                | Atom(Symbol parm_name) ->
+                                                    let parm_idx = (List.findIndex (fun (p) -> p = parm) parameters)
+                                                    fun_ctx.locals.[parm_name] <- Arg (parm_idx,arg_types.[parm_idx])
+                                                | other -> failwithf "In function %A parameter definition:\nExpected: Atom(Symbol)\nGot: %A" fname parm
+                                            let bodyGen = gf.MakeBody fun_ctx body
+                                            bodyGen.Generate methodILGen
+                                            methodILGen.Emit(OpCodes.Ret)
+                                            methodGen :> MethodInfo)
     interface IGenerator with
         member this.Generate ilGen =
-            let argsDef = Array.create (List.length parameters) typeof<obj>
-            let methodGen = typeBuilder.DefineMethod(fname, MethodAttributes.Public ||| MethodAttributes.Static, typeof<obj>, argsDef)
-            let methodILGen = (methodGen.GetILGenerator())
-            context.functions.[fname] <- methodGen
-            let fun_ctx = new Context(context)
-            for parm in parameters do
-                match parm with
-                | Atom(Symbol parm_name) -> fun_ctx.locals.[parm_name] <- Arg (List.findIndex (fun (p) -> p = parm) parameters)
-                | other -> failwithf "In function %A parameter definition:\nExpected: Atom(Symbol)\nGot: %A" fname parm
-            let bodyGen = gf.MakeBody fun_ctx body
-            bodyGen.Generate methodILGen
-            methodILGen.Emit(OpCodes.Ret)
+            ()
         member  this.ReturnTypes() = 
             [typeof<Void>]
 

ngc/Generator.fs

@@ -62,9 +62,9 @@ let compile (source : Stream) (assemblyName : string) (fileName : string) (asmRe
 
     prologue ilGenerator
     try
-        Reader.parse fileName source |> List.iter (fun sexp ->
-                                                   let gen = gf.MakeGenerator context sexp
-                                                   gen.Generate ilGenerator) 
+        let body = Reader.parse fileName source
+        let gen = gf.MakeBody context body
+        gen.Generate ilGenerator
     with
     | ex -> printfn "File: %A\nForm: %A\nError: %A" fileName sexp ex.Source
 

tests/test.naggum

@@ -62,6 +62,5 @@
 (test-quote)
 (test-new)
 (test-cons)
-(test-quote)
 (test-instance-call)
 (test-math)