diff --git a/Naggum.Backend/Reader.fs b/Naggum.Backend/Reader.fs index 662eaf6..773d3db 100644 --- a/Naggum.Backend/Reader.fs +++ b/Naggum.Backend/Reader.fs @@ -41,7 +41,7 @@ let string = let normalChar = satisfy (fun c -> c <> '\"') between (pstring "\"") (pstring "\"") (manyChars normalChar) |>> (fun str -> str :> obj) |>> Object -let symChars = (anyOf "+-*/=<>!?.") //chars that are valid in the symbol name +let symChars = (anyOf "+-*/=<>!?._") //chars that are valid in the symbol name let symbol = (many1Chars (letter <|> digit <|> symChars)) |>> Symbol let atom = (pnumber <|> string <|> symbol) |>> Atom let listElement = choice [ atom; list ] diff --git a/Naggum.Compiler/FormGenerator.fs b/Naggum.Compiler/FormGenerator.fs index bb96a24..e64f561 100644 --- a/Naggum.Compiler/FormGenerator.fs +++ b/Naggum.Compiler/FormGenerator.fs @@ -59,19 +59,19 @@ type SequenceGenerator(context:Context,typeBuilder:TypeBuilder,seq:SExp list, gf List.map (fun (sexp) -> List.head ((gf.MakeGenerator context sexp).ReturnTypes())) seq type BodyGenerator(context : Context, - methodBuilder : MethodBuilder, + resultType : Type, body : SExp list, gf : IGeneratorFactory) = let rec genBody (ilGen : ILGenerator) (body : SExp list) = match body with | [] -> - ilGen.Emit(OpCodes.Ldnull) + if resultType <> typeof then + ilGen.Emit(OpCodes.Ldnull) | [last] -> let gen = gf.MakeGenerator context last let stackType = List.head <| gen.ReturnTypes () - let returnType = methodBuilder.ReturnType gen.Generate ilGen - match (stackType, returnType) with + match (stackType, resultType) 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 @@ -86,18 +86,13 @@ type BodyGenerator(context : Context, interface IGenerator with member __.Generate ilGen = genBody ilGen body - member this.ReturnTypes () = + member __.ReturnTypes () = match body with - |[] -> [typeof] - |somelist -> - let tail_type = (gf.MakeGenerator context (List.rev body |> List.head)).ReturnTypes() - if tail_type = [typeof] then - [typeof] - else tail_type + | [] -> [typeof] + | _ -> (gf.MakeGenerator context (List.rev body |> List.head)).ReturnTypes() type LetGenerator(context : Context, - typeBuilder : TypeBuilder, - methodBuilder : MethodBuilder, + resultType : Type, bindings:SExp, body : SExp list, gf : IGeneratorFactory) = @@ -118,7 +113,7 @@ type LetGenerator(context : Context, 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, methodBuilder, body, gf) :> IGenerator + let bodyGen = new BodyGenerator (scope_subctx, resultType, body, gf) :> IGenerator bodyGen.Generate ilGen ilGen.EndScope() member this.ReturnTypes () = diff --git a/Naggum.Compiler/GeneratorFactory.fs b/Naggum.Compiler/GeneratorFactory.fs index 51960a0..9901f21 100644 --- a/Naggum.Compiler/GeneratorFactory.fs +++ b/Naggum.Compiler/GeneratorFactory.fs @@ -48,12 +48,11 @@ type GeneratorFactory(typeBuilder : TypeBuilder, | [Symbol "if"; condition; if_true] -> // reduced if form new ReducedIfGenerator(context,typeBuilder,condition,if_true,this) :> IGenerator | Symbol "let" :: bindings :: body -> // let form - new LetGenerator(context, - typeBuilder, - methodBuilder, - bindings, - body, - this) :> IGenerator + upcast new LetGenerator(context, + typeof, + bindings, + body, + this) | [Symbol "quote"; quotedExp] -> new QuoteGenerator(context,typeBuilder,quotedExp,this) :> IGenerator | Symbol "new" :: Symbol typeName :: args -> @@ -102,10 +101,7 @@ type GeneratorFactory(typeBuilder : TypeBuilder, new SequenceGenerator(context,typeBuilder,seq,(this :> IGeneratorFactory)) member private this.makeBodyGenerator(context: Context,body:SExp list) = - new BodyGenerator(context, - methodBuilder, - body, - (this :> IGeneratorFactory)) + new BodyGenerator(context, methodBuilder.ReturnType, body, this) interface IGeneratorFactory with member this.MakeGenerator context sexp = diff --git a/Naggum.Compiler/Naggum.Compiler.fsproj b/Naggum.Compiler/Naggum.Compiler.fsproj index 39baec1..aeb7feb 100644 --- a/Naggum.Compiler/Naggum.Compiler.fsproj +++ b/Naggum.Compiler/Naggum.Compiler.fsproj @@ -28,7 +28,7 @@ 3 AnyCPU bin\Debug\Naggum.Compiler.XML - ..\tests\test.naggum + ..\..\..\tests\test.naggum pdbonly @@ -105,4 +105,4 @@ --> - + \ No newline at end of file diff --git a/Naggum.Test/CompilerTest.fs b/Naggum.Test/CompilerTest.fs index 6e86fa1..b5c4b2f 100644 --- a/Naggum.Test/CompilerTest.fs +++ b/Naggum.Test/CompilerTest.fs @@ -12,9 +12,9 @@ type CompilerTest() = static let testExtension = "naggum" static let resultExtension = "result" static let executableExtension = "exe" - + static let directory = Path.Combine ("..", "..", "..", "tests") - static let filenames = [@"comment"; @"test"] + static let filenames = [@"comment"; @"test"; "let-funcall"] static member private RunTest testName = let basePath = Path.Combine(directory, testName) diff --git a/Naggum.sln b/Naggum.sln index 3fc9572..b707909 100644 --- a/Naggum.sln +++ b/Naggum.sln @@ -7,6 +7,8 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Test programs", "Test progr ProjectSection(SolutionItems) = preProject tests\comment.naggum = tests\comment.naggum tests\comment.result = tests\comment.result + tests\let-funcall.naggum = tests\let-funcall.naggum + tests\let-funcall.result = tests\let-funcall.result tests\test.naggum = tests\test.naggum tests\test.result = tests\test.result EndProjectSection diff --git a/tests/let-funcall.naggum b/tests/let-funcall.naggum new file mode 100644 index 0000000..21824cc --- /dev/null +++ b/tests/let-funcall.naggum @@ -0,0 +1,12 @@ +(defun test-let () + (System.Console.Write "Let: ") + (let ((ok "OK")) + (System.Console.WriteLine ok))) +(System.Console.WriteLine "Naggum test suite") + +(let ((thread (System.Threading.Thread.get_CurrentThread)) + (culture (System.Globalization.CultureInfo.get_InvariantCulture))) + (System.Console.WriteLine "Setting up an environment...") + (call set_CurrentCulture thread culture)) + +(test-let) diff --git a/tests/let-funcall.result b/tests/let-funcall.result new file mode 100644 index 0000000..5047923 --- /dev/null +++ b/tests/let-funcall.result @@ -0,0 +1,3 @@ +Naggum test suite +Setting up an environment... +Let: OK diff --git a/tests/test.naggum b/tests/test.naggum index 1324f42..15a4aea 100644 --- a/tests/test.naggum +++ b/tests/test.naggum @@ -56,6 +56,11 @@ (System.Console.WriteLine "Naggum test suite") +(let ((thread (System.Threading.Thread.get_CurrentThread)) + (culture (System.Globalization.CultureInfo.get_InvariantCulture))) + (System.Console.WriteLine "Setting up an environment...") + (call set_CurrentCulture thread culture)) + (test-funcall "OK") (test-conditionals) (test-let) diff --git a/tests/test.result b/tests/test.result index 2a8f22c..ff42194 100644 --- a/tests/test.result +++ b/tests/test.result @@ -1,4 +1,5 @@ Naggum test suite +Setting up an environment... Functions: OK Conditionals: Reduced if: OK