Skip to content

Commit 6eca440

Browse files
haganehagane
committed
Merge g:\naggum
Conflicts: tests/test.naggum
2 parents 103db83 + ee7c813 commit 6eca440

4 files changed

Lines changed: 49 additions & 161 deletions

File tree

‎Naggum.Runtime/Cons.cs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,8 @@ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
1919
THE SOFTWARE. */
2020

2121
using System;
22-
using System.Collections.Generic;
23-
using System.Linq;
2422
using System.Text;
23+
using System.Collections;
2524

2625
namespace Naggum.Runtime
2726
{
@@ -117,7 +116,8 @@ bool IEquatable<Cons>.Equals(Cons other)
117116
public static Cons List(params object[] elements)
118117
{
119118
Cons list = null;
120-
foreach (var element in (elements.Reverse()))
119+
Array.Reverse(elements);
120+
foreach (var element in elements)
121121
{
122122
var tmp = new Cons(element, list);
123123
list = tmp;

‎Naggum.Runtime/Symbol.cs‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,4 @@
11
using System;
2-
using System.Collections.Generic;
3-
using System.Linq;
4-
using System.Text;
52

63
namespace Naggum.Runtime
74
{

‎ngc/Generator.fs‎

Lines changed: 6 additions & 142 deletions
Original file line numberDiff line numberDiff line change
@@ -33,148 +33,10 @@ open Naggum.Runtime
3333

3434
open Context
3535

36-
//TODO: Shoot that putrid shit and throw it out.
37-
let rec private generate (context : Context) (typeBuilder : TypeBuilder) (ilGen : ILGenerator) (form : SExp) =
38-
match form with
39-
| List list ->
40-
match list with
41-
| (Atom (Symbol "defun") :: Atom (Symbol name) :: List args :: body) ->
42-
let argsDef = Array.create (List.length args) typeof<obj>
43-
let methodGen = typeBuilder.DefineMethod(name, MethodAttributes.Public ||| MethodAttributes.Static, typeof<obj>, argsDef)
44-
let methodILGen = (methodGen.GetILGenerator())
45-
generateBody context typeBuilder methodILGen body
46-
methodILGen.Emit(OpCodes.Ret)
47-
// Add function to context:
48-
context.functions.[name] <- methodGen
49-
| Atom (Symbol "if") :: condition :: if_true :: if_false :: [] -> //full if form
50-
generate context typeBuilder ilGen condition
51-
let if_true_lbl = ilGen.DefineLabel()
52-
let end_form = ilGen.DefineLabel()
53-
ilGen.Emit (OpCodes.Brtrue, if_true_lbl)
54-
generate context typeBuilder ilGen if_false
55-
ilGen.Emit (OpCodes.Br,end_form)
56-
ilGen.MarkLabel if_true_lbl
57-
generate context typeBuilder ilGen if_true
58-
ilGen.MarkLabel end_form
59-
| Atom (Symbol "if") :: condition :: if_true :: [] -> //reduced if form
60-
generate context typeBuilder ilGen condition
61-
let if_true_lbl = ilGen.DefineLabel()
62-
let end_form = ilGen.DefineLabel()
63-
ilGen.Emit (OpCodes.Brtrue, if_true_lbl)
64-
ilGen.Emit OpCodes.Ldnull
65-
ilGen.Emit (OpCodes.Br,end_form)
66-
ilGen.MarkLabel if_true_lbl
67-
generate context typeBuilder ilGen if_true
68-
ilGen.MarkLabel end_form
69-
| Atom (Symbol "let") :: bindings :: body -> //let form
70-
ilGen.BeginScope()
71-
let scope_subctx = new Context (context)
72-
match bindings with
73-
| List list ->
74-
for binding in list do
75-
match binding with
76-
| List [(Atom (Symbol name)); form] ->
77-
let local = ilGen.DeclareLocal(typeof<obj>)
78-
generate context typeBuilder ilGen form
79-
ilGen.Emit (OpCodes.Stloc,local)
80-
scope_subctx.locals.[name] <- Local (local, typeof<obj>)
81-
| other -> failwithf "In let bindings: Expected: (name (form))\nGot: %A\n" other
82-
| other -> failwithf "In let form: expected: list of bindings\nGot: %A" other
83-
generateBody scope_subctx typeBuilder ilGen body
84-
ilGen.EndScope()
85-
| Atom (Symbol fname) :: args -> //generic funcall pattern
86-
genApply fname context typeBuilder ilGen args
87-
| _ -> failwithf "%A not supported yet." list
88-
| Atom a ->
89-
let genf = new GeneratorFactory(typeBuilder) :> IGeneratorFactory
90-
let gen = genf.MakeGenerator context (Atom a)
91-
ignore (gen.Generate ilGen)
92-
| other -> failwithf "%A form not supported yet." other
93-
and private generateBody context (typeBuilder : TypeBuilder) (ilGen : ILGenerator) (body : SExp list) =
94-
match body with
95-
| [] ->
96-
ilGen.Emit(OpCodes.Ldnull)
97-
| [last] ->
98-
generate context typeBuilder ilGen last
99-
| sexp :: rest ->
100-
generate context typeBuilder ilGen sexp
101-
ilGen.Emit(OpCodes.Pop)
102-
generateBody context typeBuilder ilGen rest
103-
and private generateSeq context (typeBuilder : TypeBuilder) (ilGen : ILGenerator) (seq : SExp list) =
104-
match seq with
105-
| [] ->
106-
ilGen.Emit(OpCodes.Ldnull)
107-
| [last] ->
108-
generate context typeBuilder ilGen last
109-
| sexp :: rest ->
110-
generate context typeBuilder ilGen sexp
111-
generateBody context typeBuilder ilGen rest
112-
and private genApply (funcName : string) (context : Context) (typeBuilder : TypeBuilder) (ilGen : ILGenerator) (argList: SExp list) : unit =
113-
try
114-
let func = context.functions.[funcName]
115-
generateSeq context typeBuilder ilGen argList
116-
ilGen.Emit(OpCodes.Call, func)
117-
with
118-
| :? KeyNotFoundException -> failwithf "Function %A not found." funcName
119-
12036
let private prologue (ilGen : ILGenerator) =
12137
ilGen.BeginScope()
12238

12339
let private epilogue context typeBuilder (ilGen : ILGenerator) =
124-
(* let argGetter = typeof<Value>.GetMethod "get_EmptyList"
125-
let isAtomGetter = typeof<SExp>.GetMethod "get_IsAtom"
126-
let atomItemGetter = typeof<SExp>.GetNestedType("Atom").GetMethod "get_Item"
127-
let isNumberGetter = typeof<Value>.GetMethod "get_IsNumber"
128-
let numberItemGetter = typeof<Value>.GetNestedType("Number").GetMethod "get_Item" *)
129-
130-
//ilGen.Emit(OpCodes.Call, argGetter)
131-
genApply "main" context typeBuilder ilGen ([])
132-
(*
133-
// Analyze value returned from main:
134-
let sexp = ilGen.DeclareLocal(typeof<SExp>)
135-
let value = ilGen.DeclareLocal(typeof<Value>)
136-
137-
let returnZero = ilGen.DefineLabel()
138-
let ``return`` = ilGen.DefineLabel()
139-
140-
// Get SExp:
141-
ilGen.Emit(OpCodes.Castclass, typeof<SExp>)
142-
ilGen.Emit(OpCodes.Stloc, sexp.LocalIndex)
143-
144-
// Check whether SExp is SExp.Atom:
145-
ilGen.Emit(OpCodes.Ldloc, sexp.LocalIndex)
146-
ilGen.Emit(OpCodes.Call, isAtomGetter)
147-
ilGen.Emit(OpCodes.Brfalse, returnZero)
148-
149-
// Cast SExp to SExp.Atom:
150-
ilGen.Emit(OpCodes.Ldloc, sexp.LocalIndex)
151-
ilGen.Emit(OpCodes.Castclass, typeof<SExp>.GetNestedType("Atom"))
152-
153-
// Get Value:
154-
ilGen.Emit(OpCodes.Call, atomItemGetter)
155-
ilGen.Emit(OpCodes.Stloc, value.LocalIndex)
156-
157-
// Check whether Value is Number:
158-
ilGen.Emit(OpCodes.Ldloc, value.LocalIndex)
159-
ilGen.Emit(OpCodes.Call, isNumberGetter)
160-
ilGen.Emit(OpCodes.Brfalse, returnZero)
161-
162-
// Cast Value to Number:
163-
ilGen.Emit(OpCodes.Ldloc, value.LocalIndex)
164-
ilGen.Emit(OpCodes.Castclass, typeof<Value>.GetNestedType("Number"))
165-
166-
// Get float64 value:
167-
ilGen.Emit(OpCodes.Call, numberItemGetter)
168-
169-
// Convert to int32:
170-
ilGen.Emit(OpCodes.Conv_I4)
171-
ilGen.Emit(OpCodes.Br, ``return``)
172-
173-
ilGen.MarkLabel returnZero
174-
ilGen.Emit(OpCodes.Ldc_I4, 0)
175-
176-
ilGen.MarkLabel ``return``
177-
*)
17840
ilGen.Emit OpCodes.Ret
17941
ilGen.EndScope()
18042

@@ -200,10 +62,12 @@ let compile (source : StreamReader) (assemblyName : string) (fileName : string)
20062

20163
prologue ilGenerator
20264
while not source.EndOfStream do
203-
let sexp = Reader.parse source
204-
let gen = gf.MakeGenerator context sexp
205-
ignore(gen.Generate ilGenerator)
206-
//generate context typeBuilder ilGenerator sexp
65+
try
66+
let sexp = Reader.parse source
67+
let gen = gf.MakeGenerator context sexp
68+
gen.Generate ilGenerator
69+
with
70+
| ex -> printfn "File: %A\nForm: %A\nError: %A" fileName sexp ex.Source
20771

20872
epilogue context typeBuilder ilGenerator
20973

‎tests/test.naggum‎

Lines changed: 40 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,40 +1,67 @@
1-
(defun main (args)
2-
(System.Console.WriteLine "Naggum test suite")
1+
(defun test-funcall (test-arg)
2+
(System.Console.WriteLine test-arg))
33

4-
(System.Console.WriteLine "Conditionals")
4+
(defun test-conditionals ()
5+
(System.Console.WriteLine "Conditionals:")
56
(if 1 (System.Console.WriteLine "Reduced if: OK"))
67
(if 1
78
(System.Console.WriteLine "Full if (true branch): OK")
8-
(System.Console.WriteLine "Full if (true branch): FAILURE"))
9+
(System.Console.WriteLine "Full if (true branch): FAILURE"))
910
(if 0
1011
(System.Console.WriteLine "Full if (false branch): FAILURE")
11-
(System.Console.WriteLine "Full if (false branch): OK"))
12-
12+
(System.Console.WriteLine "Full if (false branch): OK")))
13+
14+
(defun test-let ()
1315
(System.Console.Write "Let: ")
1416
(let ((ok "OK"))
15-
(System.Console.WriteLine ok))
16-
17+
(System.Console.WriteLine ok)))
18+
19+
(defun test-quote ()
1720
(System.Console.WriteLine "Quoting:")
1821
(System.Console.Write "Symbol: ") (System.Console.WriteLine (quote OK))
19-
(System.Console.Write "List: ") (System.Console.WriteLine (quote (OK)))
22+
(System.Console.Write "List: ") (System.Console.WriteLine (quote (OK))))
2023

24+
(defun test-new ()
2125
(System.Console.Write "Object construction: ")
2226
(let ((ok-sym (new Naggum.Runtime.Symbol "OK")))
23-
(System.Console.WriteLine ok-sym))
24-
27+
(System.Console.WriteLine ok-sym)))
28+
29+
(defun test-cons ()
2530
(System.Console.WriteLine "Cons:")
2631
(let ((test-car (new Naggum.Runtime.Cons "OK" "FAILURE"))
2732
(test-cdr (new Naggum.Runtime.Cons "FAILURE" "OK")))
2833
(System.Console.Write "CAR: ") (System.Console.WriteLine (Naggum.Runtime.Cons.Car test-car))
29-
(System.Console.Write "CDR: ") (System.Console.WriteLine (Naggum.Runtime.Cons.Cdr test-cdr)))
30-
34+
(System.Console.Write "CDR: ") (System.Console.WriteLine (Naggum.Runtime.Cons.Cdr test-cdr))))
35+
36+
(defun test-math ()
3137
(System.Console.WriteLine "Math:")
38+
(System.Console.WriteLine "Integers:")
3239
(System.Console.Write "2+2=") (System.Console.WriteLine (+ 2 2))
3340
(System.Console.Write "2-2=") (System.Console.WriteLine (- 2 2))
3441
(System.Console.Write "2*3=") (System.Console.WriteLine (* 2 3))
3542
(System.Console.Write "2/2=") (System.Console.WriteLine (/ 2 2))
3643

44+
(System.Console.WriteLine "Floats")
45+
(System.Console.Write "2.0 + 0.5=") (System.Console.WriteLine (+ 2.0 0.5))
46+
(System.Console.Write "3.0 - 1.5=") (System.Console.WriteLine (- 3.0 1.5))
47+
(System.Console.Write "2.0 * 0.7=") (System.Console.WriteLine (* 2.0 0.7))
48+
(System.Console.Write "3.0 / 2.0=") (System.Console.WriteLine (/ 3.0 2.0)))
49+
50+
(defun test-instance-call ()
3751
(System.Console.WriteLine "Instance calls:")
3852
(let ((test-obj (new System.Random)))
3953
(System.Console.Write "Random number:")
4054
(System.Console.WriteLine (call Next test-obj))))
55+
56+
(System.Console.WriteLine "Naggum test suite")
57+
58+
(System.Console.Write "Functions: ")
59+
(test-funcall "OK")
60+
61+
(test-conditionals)
62+
(test-let)
63+
(test-quote)
64+
(test-new)
65+
(test-cons)
66+
(test-math)
67+
(test-instance-call)

0 commit comments

Comments
 (0)