Skip to content

Commit 29de312

Browse files
ForNeVeRForNeVeR
committed
Merge pull request #26 from codingteam/bugfix/main-ret
Fix stack distribution issues.
2 parents 05781e8 + b463c33 commit 29de312

File tree

4 files changed

+72
-52
lines changed

4 files changed

+72
-52
lines changed

‎ngc/FormGenerator.fs‎

Lines changed: 33 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -5,11 +5,8 @@ open System.Collections.Generic
55
open System.Reflection
66
open System.Reflection.Emit
77
open Naggum.Runtime
8-
open Naggum.Compiler.Globals
9-
open Naggum.Compiler.Reader
108
open Naggum.Compiler.Context
119
open Naggum.Compiler.IGenerator
12-
open Naggum.Util.MaybeMonad
1310
open Naggum.Compiler.Reader
1411

1512
type FormGenerator() =
@@ -59,27 +56,34 @@ type SequenceGenerator(context:Context,typeBuilder:TypeBuilder,seq:SExp list, gf
5956
member this.ReturnTypes () =
6057
List.map (fun (sexp) -> List.head ((gf.MakeGenerator context sexp).ReturnTypes())) seq
6158

62-
type BodyGenerator(context:Context,typeBuilder:TypeBuilder,body:SExp list, gf:IGeneratorFactory) =
63-
member private this.gen_body (ilGen:ILGenerator,body:SExp list) =
59+
type BodyGenerator(context : Context,
60+
methodBuilder : MethodBuilder,
61+
body : SExp list,
62+
gf : IGeneratorFactory) =
63+
let rec genBody (ilGen : ILGenerator) (body : SExp list) =
6464
match body with
6565
| [] ->
6666
ilGen.Emit(OpCodes.Ldnull)
6767
| [last] ->
6868
let gen = gf.MakeGenerator context last
69-
let val_type = gen.ReturnTypes()
69+
let stackType = List.head <| gen.ReturnTypes ()
70+
let returnType = methodBuilder.ReturnType
7071
gen.Generate ilGen
71-
if ((List.head val_type) = typeof<System.Void>) then
72-
ilGen.Emit(OpCodes.Ldnull)
72+
match (stackType, returnType) with
73+
| (s, r) when s = typeof<Void> && r = typeof<Void> -> ()
74+
| (s, r) when s = typeof<Void> && r <> typeof<Void> -> ilGen.Emit OpCodes.Ldnull
75+
| (s, r) when s <> typeof<Void> && r = typeof<Void> -> ilGen.Emit OpCodes.Pop
76+
| _ -> ()
7377
| sexp :: rest ->
7478
let gen = gf.MakeGenerator context sexp
7579
let val_type = gen.ReturnTypes()
7680
gen.Generate ilGen
77-
if not (List.head val_type = typeof<System.Void>) then
81+
if List.head val_type <> typeof<Void> then
7882
ilGen.Emit(OpCodes.Pop)
79-
this.gen_body (ilGen,rest)
83+
genBody ilGen rest
8084
interface IGenerator with
81-
member this.Generate ilGen =
82-
this.gen_body (ilGen,body)
85+
member __.Generate ilGen =
86+
genBody ilGen body
8387
member this.ReturnTypes () =
8488
match body with
8589
|[] -> [typeof<System.Void>]
@@ -89,7 +93,12 @@ type BodyGenerator(context:Context,typeBuilder:TypeBuilder,body:SExp list, gf:IG
8993
[typeof<obj>]
9094
else tail_type
9195

92-
type LetGenerator(context:Context,typeBuilder:TypeBuilder,bindings:SExp,body:SExp list,gf:IGeneratorFactory) =
96+
type LetGenerator(context : Context,
97+
typeBuilder : TypeBuilder,
98+
methodBuilder : MethodBuilder,
99+
bindings:SExp,
100+
body : SExp list,
101+
gf : IGeneratorFactory) =
93102
interface IGenerator with
94103
member this.Generate ilGen =
95104
ilGen.BeginScope()
@@ -107,7 +116,7 @@ type LetGenerator(context:Context,typeBuilder:TypeBuilder,bindings:SExp,body:SEx
107116
ilGen.Emit (OpCodes.Stloc,local)
108117
| other -> failwithf "In let bindings: Expected: (name (form))\nGot: %A\n" other
109118
| other -> failwithf "In let form: expected: list of bindings\nGot: %A" other
110-
let bodyGen = (new BodyGenerator (scope_subctx,typeBuilder,body,gf) :> IGenerator)
119+
let bodyGen = new BodyGenerator (scope_subctx, methodBuilder, body, gf) :> IGenerator
111120
bodyGen.Generate ilGen
112121
ilGen.EndScope()
113122
member this.ReturnTypes () =
@@ -124,6 +133,7 @@ type LetGenerator(context:Context,typeBuilder:TypeBuilder,bindings:SExp,body:SEx
124133
(gf.MakeBody type_subctx body).ReturnTypes()
125134

126135
type ReducedIfGenerator(context:Context,typeBuilder:TypeBuilder,condition:SExp,if_true:SExp,gf:IGeneratorFactory) =
136+
let returnTypes = (gf.MakeGenerator context if_true).ReturnTypes()
127137
interface IGenerator with
128138
member this.Generate ilGen =
129139
let cond_gen = gf.MakeGenerator context condition
@@ -132,13 +142,16 @@ type ReducedIfGenerator(context:Context,typeBuilder:TypeBuilder,condition:SExp,i
132142
let end_form = ilGen.DefineLabel()
133143
cond_gen.Generate ilGen
134144
ilGen.Emit (OpCodes.Brtrue, if_true_lbl)
135-
ilGen.Emit OpCodes.Ldnull
136-
ilGen.Emit (OpCodes.Br,end_form)
145+
146+
if List.head returnTypes <> typeof<Void>
147+
then ilGen.Emit OpCodes.Ldnull
148+
149+
ilGen.Emit (OpCodes.Br, end_form)
137150
ilGen.MarkLabel if_true_lbl
138151
if_true_gen.Generate ilGen
139152
ilGen.MarkLabel end_form
140153
member this.ReturnTypes () =
141-
(gf.MakeGenerator context if_true).ReturnTypes()
154+
returnTypes
142155

143156
type FullIfGenerator(context:Context,typeBuilder:TypeBuilder,condition:SExp,if_true:SExp,if_false:SExp,gf:IGeneratorFactory) =
144157
interface IGenerator with
@@ -181,7 +194,8 @@ type DefunGenerator(context:Context,typeBuilder:TypeBuilder,fname:string,paramet
181194
let parm_idx = (List.findIndex (fun (p) -> p = parm) parameters)
182195
fun_ctx.locals.[new Symbol(parm_name)] <- Arg (parm_idx,arg_types.[parm_idx])
183196
| other -> failwithf "In function %A parameter definition:\nExpected: Atom(Symbol)\nGot: %A" fname parm
184-
let bodyGen = gf.MakeBody fun_ctx body
197+
let methodFactory = gf.MakeGeneratorFactory typeBuilder methodGen
198+
let bodyGen = methodFactory.MakeBody fun_ctx body
185199
bodyGen.Generate methodILGen
186200
methodILGen.Emit(OpCodes.Ret)
187201
methodGen :> MethodInfo)
@@ -249,7 +263,6 @@ type TypeGenerator(context : Context, typeBuilder : TypeBuilder, typeName : stri
249263
Globals.ModuleBuilder.DefineType(typeName, TypeAttributes.Class ||| TypeAttributes.Public, typeof<obj>)
250264
else
251265
Globals.ModuleBuilder.DefineType(typeName, TypeAttributes.Class ||| TypeAttributes.Public, context.types.[new Symbol(parentTypeName)])
252-
let newGeneratorFactory = gf.MakeGeneratorFactory newTypeBuilder
253266
let mutable fields : string list = []
254267

255268
let generate_field field_name =
@@ -266,6 +279,7 @@ type TypeGenerator(context : Context, typeBuilder : TypeBuilder, typeName : stri
266279
let parm_idx = (List.findIndex (fun (p) -> p = parm) method_parms)
267280
method_ctx.locals.[new Symbol(parm_name)] <- Arg (parm_idx,typeof<obj>)
268281
| other -> failwithf "In method %A%A parameter definition:\nExpected: Atom(Symbol)\nGot: %A" typeName method_name parm
282+
let newGeneratorFactory = gf.MakeGeneratorFactory newTypeBuilder method_gen
269283
let body_gen = newGeneratorFactory.MakeBody method_ctx method_body
270284
body_gen.Generate (method_gen.GetILGenerator())
271285
(method_gen.GetILGenerator()).Emit(OpCodes.Ret)

‎ngc/Generator.fs‎

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,17 +2,12 @@
22

33
open System
44
open System.IO
5-
open System.Collections.Generic
65
open System.Reflection
76
open System.Reflection.Emit
87

9-
open Naggum.Compiler.Globals
108
open Naggum.Compiler.IGenerator
119
open Naggum.Compiler.GeneratorFactory
1210
open Naggum.Compiler.Reader
13-
open Naggum.Runtime
14-
15-
open Context
1611

1712
let private prologue (ilGen : ILGenerator) =
1813
ilGen.BeginScope()
@@ -38,9 +33,12 @@ let compile (source : Stream) (assemblyName : string) (fileName : string) (asmRe
3833
let assemblyBuilder = AppDomain.CurrentDomain.DefineDynamicAssembly(assemblyName, AssemblyBuilderAccess.Save)
3934
Globals.ModuleBuilder <- assemblyBuilder.DefineDynamicModule(assemblyBuilder.GetName().Name, fileName)
4035
let typeBuilder = Globals.ModuleBuilder.DefineType("Program", TypeAttributes.Public ||| TypeAttributes.Class ||| TypeAttributes.BeforeFieldInit)
41-
let methodBuilder = typeBuilder.DefineMethod("Main", MethodAttributes.Public ||| MethodAttributes.Static, typeof<int>, [| |])
36+
let methodBuilder = typeBuilder.DefineMethod ("Main",
37+
MethodAttributes.Public ||| MethodAttributes.Static,
38+
typeof<Void>,
39+
Array.Empty ())
4240

43-
let gf = new GeneratorFactory(typeBuilder) :> IGeneratorFactory
41+
let gf = new GeneratorFactory(typeBuilder, methodBuilder) :> IGeneratorFactory
4442
assemblyBuilder.SetEntryPoint methodBuilder
4543

4644
let context = Context.create ()

‎ngc/GeneratorFactory.fs‎

Lines changed: 32 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -11,11 +11,11 @@ open Naggum.Util.MaybeMonad
1111
open Naggum.Compiler.Reader
1212
open Naggum.Compiler.MathGenerator
1313
open System
14-
open System.Reflection
1514
open System.Reflection.Emit
1615
open System.Text.RegularExpressions
1716

18-
type GeneratorFactory(typeBldr:TypeBuilder) =
17+
type GeneratorFactory(typeBuilder : TypeBuilder,
18+
methodBuilder : MethodBuilder) =
1919
member private this.makeObjectGenerator(o:obj) =
2020
match o with
2121
| :? System.Int32 ->
@@ -39,40 +39,44 @@ type GeneratorFactory(typeBldr:TypeBuilder) =
3939
member private this.MakeFormGenerator (context:Context, form:SExp list) =
4040
match form with
4141
| (Atom (Symbol "defun") :: Atom (Symbol name) :: List args :: body) ->
42-
new DefunGenerator(context,typeBldr,name,args,body,this) :> IGenerator
42+
new DefunGenerator(context,typeBuilder,name,args,body,this) :> IGenerator
4343
| Atom (Symbol "if") :: condition :: if_true :: if_false :: [] -> //full if form
44-
new FullIfGenerator(context,typeBldr,condition,if_true,if_false,this) :> IGenerator
44+
new FullIfGenerator(context,typeBuilder,condition,if_true,if_false,this) :> IGenerator
4545
| Atom (Symbol "if") :: condition :: if_true :: [] -> //reduced if form
46-
new ReducedIfGenerator(context,typeBldr,condition,if_true,this) :> IGenerator
47-
| Atom (Symbol "let") :: bindings :: body -> //let form
48-
new LetGenerator(context,typeBldr,bindings,body,this) :> IGenerator
46+
new ReducedIfGenerator(context,typeBuilder,condition,if_true,this) :> IGenerator
47+
| Atom (Symbol "let") :: bindings :: body -> // let form
48+
new LetGenerator(context,
49+
typeBuilder,
50+
methodBuilder,
51+
bindings,
52+
body,
53+
this) :> IGenerator
4954
| Atom (Symbol "quote") :: quotedExp :: [] ->
50-
new QuoteGenerator(context,typeBldr,quotedExp,this) :> IGenerator
55+
new QuoteGenerator(context,typeBuilder,quotedExp,this) :> IGenerator
5156
| Atom (Symbol "new") :: Atom (Symbol typeName) :: args ->
52-
new NewObjGenerator(context,typeBldr,typeName,args,this) :> IGenerator
57+
new NewObjGenerator(context,typeBuilder,typeName,args,this) :> IGenerator
5358
| Atom (Symbol "+") :: args ->
54-
new ArithmeticGenerator(context,typeBldr,args,OpCodes.Add,this) :> IGenerator
59+
new ArithmeticGenerator(context,typeBuilder,args,OpCodes.Add,this) :> IGenerator
5560
| Atom (Symbol "-") :: args ->
56-
new ArithmeticGenerator(context,typeBldr,args,OpCodes.Sub,this) :> IGenerator
61+
new ArithmeticGenerator(context,typeBuilder,args,OpCodes.Sub,this) :> IGenerator
5762
| Atom (Symbol "*") :: args ->
58-
new ArithmeticGenerator(context,typeBldr,args,OpCodes.Mul,this) :> IGenerator
63+
new ArithmeticGenerator(context,typeBuilder,args,OpCodes.Mul,this) :> IGenerator
5964
| Atom (Symbol "/") :: args ->
60-
new ArithmeticGenerator(context,typeBldr,args,OpCodes.Div,this) :> IGenerator
65+
new ArithmeticGenerator(context,typeBuilder,args,OpCodes.Div,this) :> IGenerator
6166
| Atom (Symbol "=") :: arg_a :: arg_b :: [] ->
62-
new SimpleLogicGenerator(context,typeBldr,arg_a,arg_b,OpCodes.Ceq,this) :> IGenerator
67+
new SimpleLogicGenerator(context,typeBuilder,arg_a,arg_b,OpCodes.Ceq,this) :> IGenerator
6368
| Atom (Symbol "<") :: arg_a :: arg_b :: [] ->
64-
new SimpleLogicGenerator(context,typeBldr,arg_a,arg_b,OpCodes.Clt,this) :> IGenerator
69+
new SimpleLogicGenerator(context,typeBuilder,arg_a,arg_b,OpCodes.Clt,this) :> IGenerator
6570
| Atom (Symbol ">") :: arg_a :: arg_b :: [] ->
66-
new SimpleLogicGenerator(context,typeBldr,arg_a,arg_b,OpCodes.Cgt,this) :> IGenerator
71+
new SimpleLogicGenerator(context,typeBuilder,arg_a,arg_b,OpCodes.Cgt,this) :> IGenerator
6772
|Atom (Symbol "call") :: Atom (Symbol fname) :: instance :: args ->
68-
new InstanceCallGenerator(context, typeBldr, instance, fname, args, this) :> IGenerator
73+
new InstanceCallGenerator(context, typeBuilder, instance, fname, args, this) :> IGenerator
6974
| Atom (Symbol fname) :: args -> //generic funcall pattern
7075
let tryGetType typeName =
7176
try Some (context.types.[new Symbol(typeName)]) with
7277
| _ ->
7378
try Some (Type.GetType typeName) with
7479
| _ -> None
75-
7680

7781
let callRegex = new Regex(@"([\w\.]+)\.(\w+)", RegexOptions.Compiled)
7882
let callMatch = callRegex.Match fname
@@ -86,16 +90,19 @@ type GeneratorFactory(typeBldr:TypeBuilder) =
8690
if Option.isSome maybeClrType then
8791
let clrType = Option.get maybeClrType
8892
let methodName = callMatch.Groups.[2].Value
89-
new ClrCallGenerator(context, typeBldr, clrType, methodName, args, this) :> IGenerator
93+
new ClrCallGenerator(context, typeBuilder, clrType, methodName, args, this) :> IGenerator
9094
else
91-
new FunCallGenerator(context,typeBldr,fname,args,this) :> IGenerator
95+
new FunCallGenerator(context,typeBuilder,fname,args,this) :> IGenerator
9296
| _ -> failwithf "Form %A is not supported yet" list
9397

9498
member private this.makeSequenceGenerator(context: Context,seq:SExp list) =
95-
new SequenceGenerator(context,typeBldr,seq,(this :> IGeneratorFactory))
99+
new SequenceGenerator(context,typeBuilder,seq,(this :> IGeneratorFactory))
96100

97101
member private this.makeBodyGenerator(context: Context,body:SExp list) =
98-
new BodyGenerator(context,typeBldr,body,(this :> IGeneratorFactory))
102+
new BodyGenerator(context,
103+
methodBuilder,
104+
body,
105+
(this :> IGeneratorFactory))
99106

100107
interface IGeneratorFactory with
101108
member this.MakeGenerator context sexp =
@@ -107,4 +114,6 @@ type GeneratorFactory(typeBldr:TypeBuilder) =
107114

108115
member this.MakeBody context body = this.makeBodyGenerator (context,body) :> IGenerator
109116

110-
member this.MakeGeneratorFactory newTypeBuilder = (new GeneratorFactory (newTypeBuilder)) :> IGeneratorFactory
117+
member this.MakeGeneratorFactory newTypeBuilder newMethodBuilder =
118+
new GeneratorFactory(newTypeBuilder,
119+
newMethodBuilder) :> IGeneratorFactory

‎ngc/IGenerator.fs‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
module Naggum.Compiler.IGenerator
22

33
open System
4-
open System.Reflection
54
open System.Reflection.Emit
65

76
open Naggum.Compiler.Reader
@@ -19,5 +18,5 @@ type IGeneratorFactory =
1918
abstract MakeGenerator : Context -> SExp -> IGenerator
2019
abstract MakeSequence : Context -> SExp list -> IGenerator
2120
abstract MakeBody : Context -> SExp list -> IGenerator
22-
abstract MakeGeneratorFactory : TypeBuilder -> IGeneratorFactory
23-
end
21+
abstract MakeGeneratorFactory : TypeBuilder -> MethodBuilder -> IGeneratorFactory
22+
end

0 commit comments

Comments
 (0)