From 29eff24d741d68b6e8a84e74428309d8ebd15b3b Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 19 Dec 2015 11:43:54 +0600 Subject: [PATCH 1/2] ngc: more proper stack management (do not emit ldnull when returning from the void method). --- ngc/FormGenerator.fs | 42 +++++++++++++++++++------------ ngc/Generator.fs | 12 ++++----- ngc/GeneratorFactory.fs | 55 ++++++++++++++++++++++++----------------- ngc/IGenerator.fs | 5 ++-- 4 files changed, 65 insertions(+), 49 deletions(-) diff --git a/ngc/FormGenerator.fs b/ngc/FormGenerator.fs index 9121d25..1b1d77c 100644 --- a/ngc/FormGenerator.fs +++ b/ngc/FormGenerator.fs @@ -5,11 +5,8 @@ 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 -open Naggum.Util.MaybeMonad open Naggum.Compiler.Reader type FormGenerator() = @@ -59,27 +56,34 @@ type SequenceGenerator(context:Context,typeBuilder:TypeBuilder,seq:SExp list, gf member this.ReturnTypes () = List.map (fun (sexp) -> List.head ((gf.MakeGenerator context sexp).ReturnTypes())) seq -type BodyGenerator(context:Context,typeBuilder:TypeBuilder,body:SExp list, gf:IGeneratorFactory) = - member private this.gen_body (ilGen:ILGenerator,body:SExp list) = +type BodyGenerator(context : Context, + methodBuilder : MethodBuilder, + body : SExp list, + gf : IGeneratorFactory) = + let rec genBody (ilGen : ILGenerator) (body : SExp list) = match body with | [] -> ilGen.Emit(OpCodes.Ldnull) | [last] -> let gen = gf.MakeGenerator context last - let val_type = gen.ReturnTypes() + let stackType = Seq.head <| gen.ReturnTypes () + let returnType = methodBuilder.ReturnType gen.Generate ilGen - if ((List.head val_type) = typeof) then - ilGen.Emit(OpCodes.Ldnull) + match (stackType, returnType) with + | (s, r) when s = typeof && r = typeof -> () + | (s, r) when s = typeof && r <> typeof -> ilGen.Emit OpCodes.Ldnull + | (s, r) when s <> typeof && r = typeof -> ilGen.Emit OpCodes.Pop + | _ -> () | sexp :: rest -> let gen = gf.MakeGenerator context sexp let val_type = gen.ReturnTypes() gen.Generate ilGen - if not (List.head val_type = typeof) then + if List.head val_type <> typeof then ilGen.Emit(OpCodes.Pop) - this.gen_body (ilGen,rest) + genBody ilGen rest interface IGenerator with - member this.Generate ilGen = - this.gen_body (ilGen,body) + member __.Generate ilGen = + genBody ilGen body member this.ReturnTypes () = match body with |[] -> [typeof] @@ -89,7 +93,12 @@ type BodyGenerator(context:Context,typeBuilder:TypeBuilder,body:SExp list, gf:IG [typeof] else tail_type -type LetGenerator(context:Context,typeBuilder:TypeBuilder,bindings:SExp,body:SExp list,gf:IGeneratorFactory) = +type LetGenerator(context : Context, + typeBuilder : TypeBuilder, + methodBuilder : MethodBuilder, + bindings:SExp, + body : SExp list, + gf : IGeneratorFactory) = interface IGenerator with member this.Generate ilGen = ilGen.BeginScope() @@ -107,7 +116,7 @@ type LetGenerator(context:Context,typeBuilder:TypeBuilder,bindings:SExp,body:SEx ilGen.Emit (OpCodes.Stloc,local) | other -> failwithf "In let bindings: Expected: (name (form))\nGot: %A\n" other | other -> failwithf "In let form: expected: list of bindings\nGot: %A" other - let bodyGen = (new BodyGenerator (scope_subctx,typeBuilder,body,gf) :> IGenerator) + let bodyGen = new BodyGenerator (scope_subctx, methodBuilder, body, gf) :> IGenerator bodyGen.Generate ilGen ilGen.EndScope() member this.ReturnTypes () = @@ -181,7 +190,8 @@ type DefunGenerator(context:Context,typeBuilder:TypeBuilder,fname:string,paramet let parm_idx = (List.findIndex (fun (p) -> p = parm) parameters) fun_ctx.locals.[new Symbol(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 + let methodFactory = gf.MakeGeneratorFactory typeBuilder methodGen + let bodyGen = methodFactory.MakeBody fun_ctx body bodyGen.Generate methodILGen methodILGen.Emit(OpCodes.Ret) methodGen :> MethodInfo) @@ -249,7 +259,6 @@ type TypeGenerator(context : Context, typeBuilder : TypeBuilder, typeName : stri Globals.ModuleBuilder.DefineType(typeName, TypeAttributes.Class ||| TypeAttributes.Public, typeof) else Globals.ModuleBuilder.DefineType(typeName, TypeAttributes.Class ||| TypeAttributes.Public, context.types.[new Symbol(parentTypeName)]) - let newGeneratorFactory = gf.MakeGeneratorFactory newTypeBuilder let mutable fields : string list = [] let generate_field field_name = @@ -266,6 +275,7 @@ type TypeGenerator(context : Context, typeBuilder : TypeBuilder, typeName : stri let parm_idx = (List.findIndex (fun (p) -> p = parm) method_parms) method_ctx.locals.[new Symbol(parm_name)] <- Arg (parm_idx,typeof) | other -> failwithf "In method %A%A parameter definition:\nExpected: Atom(Symbol)\nGot: %A" typeName method_name parm + let newGeneratorFactory = gf.MakeGeneratorFactory newTypeBuilder method_gen let body_gen = newGeneratorFactory.MakeBody method_ctx method_body body_gen.Generate (method_gen.GetILGenerator()) (method_gen.GetILGenerator()).Emit(OpCodes.Ret) diff --git a/ngc/Generator.fs b/ngc/Generator.fs index 97c8c30..f7134c8 100644 --- a/ngc/Generator.fs +++ b/ngc/Generator.fs @@ -2,17 +2,12 @@ open System open System.IO -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 -open Naggum.Runtime - -open Context let private prologue (ilGen : ILGenerator) = ilGen.BeginScope() @@ -38,9 +33,12 @@ let compile (source : Stream) (assemblyName : string) (fileName : string) (asmRe let assemblyBuilder = AppDomain.CurrentDomain.DefineDynamicAssembly(assemblyName, AssemblyBuilderAccess.Save) 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, [| |]) + let methodBuilder = typeBuilder.DefineMethod ("Main", + MethodAttributes.Public ||| MethodAttributes.Static, + typeof, + Array.Empty ()) - let gf = new GeneratorFactory(typeBuilder) :> IGeneratorFactory + let gf = new GeneratorFactory(typeBuilder, methodBuilder) :> IGeneratorFactory assemblyBuilder.SetEntryPoint methodBuilder let context = Context.create () diff --git a/ngc/GeneratorFactory.fs b/ngc/GeneratorFactory.fs index c6ef35b..f8741b2 100644 --- a/ngc/GeneratorFactory.fs +++ b/ngc/GeneratorFactory.fs @@ -11,11 +11,11 @@ open Naggum.Util.MaybeMonad open Naggum.Compiler.Reader open Naggum.Compiler.MathGenerator open System -open System.Reflection open System.Reflection.Emit open System.Text.RegularExpressions -type GeneratorFactory(typeBldr:TypeBuilder) = +type GeneratorFactory(typeBuilder : TypeBuilder, + methodBuilder : MethodBuilder) = member private this.makeObjectGenerator(o:obj) = match o with | :? System.Int32 -> @@ -39,40 +39,44 @@ type GeneratorFactory(typeBldr:TypeBuilder) = member private this.MakeFormGenerator (context:Context, form:SExp list) = match form with | (Atom (Symbol "defun") :: Atom (Symbol name) :: List args :: body) -> - new DefunGenerator(context,typeBldr,name,args,body,this) :> IGenerator + new DefunGenerator(context,typeBuilder,name,args,body,this) :> IGenerator | Atom (Symbol "if") :: condition :: if_true :: if_false :: [] -> //full if form - new FullIfGenerator(context,typeBldr,condition,if_true,if_false,this) :> IGenerator + new FullIfGenerator(context,typeBuilder,condition,if_true,if_false,this) :> IGenerator | Atom (Symbol "if") :: condition :: if_true :: [] -> //reduced if form - new ReducedIfGenerator(context,typeBldr,condition,if_true,this) :> IGenerator - | Atom (Symbol "let") :: bindings :: body -> //let form - new LetGenerator(context,typeBldr,bindings,body,this) :> IGenerator + new ReducedIfGenerator(context,typeBuilder,condition,if_true,this) :> IGenerator + | Atom (Symbol "let") :: bindings :: body -> // let form + new LetGenerator(context, + typeBuilder, + methodBuilder, + bindings, + body, + this) :> IGenerator | Atom (Symbol "quote") :: quotedExp :: [] -> - new QuoteGenerator(context,typeBldr,quotedExp,this) :> IGenerator + new QuoteGenerator(context,typeBuilder,quotedExp,this) :> IGenerator | Atom (Symbol "new") :: Atom (Symbol typeName) :: args -> - new NewObjGenerator(context,typeBldr,typeName,args,this) :> IGenerator + new NewObjGenerator(context,typeBuilder,typeName,args,this) :> IGenerator | Atom (Symbol "+") :: args -> - new ArithmeticGenerator(context,typeBldr,args,OpCodes.Add,this) :> IGenerator + new ArithmeticGenerator(context,typeBuilder,args,OpCodes.Add,this) :> IGenerator | Atom (Symbol "-") :: args -> - new ArithmeticGenerator(context,typeBldr,args,OpCodes.Sub,this) :> IGenerator + new ArithmeticGenerator(context,typeBuilder,args,OpCodes.Sub,this) :> IGenerator | Atom (Symbol "*") :: args -> - new ArithmeticGenerator(context,typeBldr,args,OpCodes.Mul,this) :> IGenerator + new ArithmeticGenerator(context,typeBuilder,args,OpCodes.Mul,this) :> IGenerator | Atom (Symbol "/") :: args -> - new ArithmeticGenerator(context,typeBldr,args,OpCodes.Div,this) :> IGenerator + new ArithmeticGenerator(context,typeBuilder,args,OpCodes.Div,this) :> IGenerator | Atom (Symbol "=") :: arg_a :: arg_b :: [] -> - new SimpleLogicGenerator(context,typeBldr,arg_a,arg_b,OpCodes.Ceq,this) :> IGenerator + new SimpleLogicGenerator(context,typeBuilder,arg_a,arg_b,OpCodes.Ceq,this) :> IGenerator | Atom (Symbol "<") :: arg_a :: arg_b :: [] -> - new SimpleLogicGenerator(context,typeBldr,arg_a,arg_b,OpCodes.Clt,this) :> IGenerator + new SimpleLogicGenerator(context,typeBuilder,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 + new SimpleLogicGenerator(context,typeBuilder,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 + new InstanceCallGenerator(context, typeBuilder, instance, fname, args, this) :> IGenerator | Atom (Symbol fname) :: args -> //generic funcall pattern let tryGetType typeName = try Some (context.types.[new Symbol(typeName)]) with | _ -> try Some (Type.GetType typeName) with | _ -> None - let callRegex = new Regex(@"([\w\.]+)\.(\w+)", RegexOptions.Compiled) let callMatch = callRegex.Match fname @@ -86,16 +90,19 @@ type GeneratorFactory(typeBldr:TypeBuilder) = if Option.isSome maybeClrType then let clrType = Option.get maybeClrType let methodName = callMatch.Groups.[2].Value - new ClrCallGenerator(context, typeBldr, clrType, methodName, args, this) :> IGenerator + new ClrCallGenerator(context, typeBuilder, clrType, methodName, args, this) :> IGenerator else - new FunCallGenerator(context,typeBldr,fname,args,this) :> IGenerator + new FunCallGenerator(context,typeBuilder,fname,args,this) :> IGenerator | _ -> failwithf "Form %A is not supported yet" list member private this.makeSequenceGenerator(context: Context,seq:SExp list) = - new SequenceGenerator(context,typeBldr,seq,(this :> IGeneratorFactory)) + new SequenceGenerator(context,typeBuilder,seq,(this :> IGeneratorFactory)) member private this.makeBodyGenerator(context: Context,body:SExp list) = - new BodyGenerator(context,typeBldr,body,(this :> IGeneratorFactory)) + new BodyGenerator(context, + methodBuilder, + body, + (this :> IGeneratorFactory)) interface IGeneratorFactory with member this.MakeGenerator context sexp = @@ -107,4 +114,6 @@ type GeneratorFactory(typeBldr:TypeBuilder) = member this.MakeBody context body = this.makeBodyGenerator (context,body) :> IGenerator - member this.MakeGeneratorFactory newTypeBuilder = (new GeneratorFactory (newTypeBuilder)) :> IGeneratorFactory + member this.MakeGeneratorFactory newTypeBuilder newMethodBuilder = + new GeneratorFactory(newTypeBuilder, + newMethodBuilder) :> IGeneratorFactory diff --git a/ngc/IGenerator.fs b/ngc/IGenerator.fs index c747ef2..fc35fb1 100644 --- a/ngc/IGenerator.fs +++ b/ngc/IGenerator.fs @@ -1,7 +1,6 @@ module Naggum.Compiler.IGenerator open System -open System.Reflection open System.Reflection.Emit open Naggum.Compiler.Reader @@ -19,5 +18,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 \ No newline at end of file + abstract MakeGeneratorFactory : TypeBuilder -> MethodBuilder -> IGeneratorFactory + end From b463c335d372b1cebd033f2a2b2bb49cd72407af Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 19 Dec 2015 11:54:16 +0600 Subject: [PATCH 2/2] ngc: fix stack inconsistency bug when calling void methods from the reduced if body. --- ngc/FormGenerator.fs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/ngc/FormGenerator.fs b/ngc/FormGenerator.fs index 1b1d77c..cfd0281 100644 --- a/ngc/FormGenerator.fs +++ b/ngc/FormGenerator.fs @@ -66,7 +66,7 @@ type BodyGenerator(context : Context, ilGen.Emit(OpCodes.Ldnull) | [last] -> let gen = gf.MakeGenerator context last - let stackType = Seq.head <| gen.ReturnTypes () + let stackType = List.head <| gen.ReturnTypes () let returnType = methodBuilder.ReturnType gen.Generate ilGen match (stackType, returnType) with @@ -133,6 +133,7 @@ type LetGenerator(context : Context, (gf.MakeBody type_subctx body).ReturnTypes() type ReducedIfGenerator(context:Context,typeBuilder:TypeBuilder,condition:SExp,if_true:SExp,gf:IGeneratorFactory) = + let returnTypes = (gf.MakeGenerator context if_true).ReturnTypes() interface IGenerator with member this.Generate ilGen = let cond_gen = gf.MakeGenerator context condition @@ -141,13 +142,16 @@ type ReducedIfGenerator(context:Context,typeBuilder:TypeBuilder,condition:SExp,i let end_form = ilGen.DefineLabel() cond_gen.Generate ilGen ilGen.Emit (OpCodes.Brtrue, if_true_lbl) - ilGen.Emit OpCodes.Ldnull - ilGen.Emit (OpCodes.Br,end_form) + + if List.head returnTypes <> typeof + then ilGen.Emit OpCodes.Ldnull + + ilGen.Emit (OpCodes.Br, end_form) ilGen.MarkLabel if_true_lbl if_true_gen.Generate ilGen ilGen.MarkLabel end_form member this.ReturnTypes () = - (gf.MakeGenerator context if_true).ReturnTypes() + returnTypes type FullIfGenerator(context:Context,typeBuilder:TypeBuilder,condition:SExp,if_true:SExp,if_false:SExp,gf:IGeneratorFactory) = interface IGenerator with