├── .gitignore
├── Lbac.Tests
    ├── MSTest.runsettings
    ├── app.config
    ├── ILTests.fs
    ├── LexerTests.fs
    ├── OptimizeILTests.fs
    ├── CommandLineTests.fs
    ├── CodeGeneratorTests.fs
    ├── EndToEndTests.fs
    ├── Lbac.Tests.fsproj
    └── SyntaxTests.fs
├── Local.testsettings
├── Lbac.vsmdi
├── Lbac.Compiler
    ├── Compiler.fs
    ├── App.config
    ├── OptimizeIL.fs
    ├── CommandLine.fs
    ├── Program.fs
    ├── Lex.fs
    ├── Railway.fs
    ├── CodeGenerator.fs
    ├── Lbac.Compiler.fsproj
    ├── Syntax.fs
    ├── IL.fs
    └── Arg.fs
├── Readme.markdown
├── License.txt
├── TraceAndTestImpact.testsettings
└── Lbac.sln


/.gitignore:
--------------------------------------------------------------------------------
1 | *.suo
2 | *.user
3 | 
4 | bin/
5 | obj/
6 | 
7 | TestResults
8 | 
9 | _ReSharper.Lbac/


--------------------------------------------------------------------------------
/Lbac.Tests/MSTest.runsettings:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="utf-8"?>
2 | <RunSettings>
3 |   <MSTest>
4 |     <ForcedLegacyMode>true</ForcedLegacyMode>
5 |   </MSTest>
6 | </RunSettings>


--------------------------------------------------------------------------------
/Local.testsettings:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="UTF-8"?>
 2 | <TestSettings name="Local" id="9c52b55a-98c9-40f8-87ce-24a545d63e65" xmlns="http://microsoft.com/schemas/VisualStudio/TeamTest/2010">
 3 |   <Description>These are default test settings for a local test run.</Description>
 4 |   <Deployment enabled="false" />
 5 |   <Execution>
 6 |     <TestTypeSpecific />
 7 |     <AgentRule name="Execution Agents">
 8 |     </AgentRule>
 9 |   </Execution>
10 | </TestSettings>


--------------------------------------------------------------------------------
/Lbac.vsmdi:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="UTF-8"?>
2 | <TestLists xmlns="http://microsoft.com/schemas/VisualStudio/TeamTest/2010">
3 |   <TestList name="Lists of Tests" id="8c43106b-9dc1-4907-a29f-aa66a61bf5b6">
4 |     <RunConfiguration id="9c52b55a-98c9-40f8-87ce-24a545d63e65" name="Local" storage="local.testsettings" type="Microsoft.VisualStudio.TestTools.Common.TestRunConfiguration, Microsoft.VisualStudio.QualityTools.Common, Version=10.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
5 |   </TestList>
6 | </TestLists>


--------------------------------------------------------------------------------
/Lbac.Tests/app.config:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="utf-8"?>
 2 | <configuration>
 3 |   <runtime>
 4 |     <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
 5 |       <dependentAssembly>
 6 |         <assemblyIdentity name="FSharp.Core" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
 7 |         <bindingRedirect oldVersion="4.0.0.0" newVersion="4.3.0.0"/>
 8 |         <bindingRedirect oldVersion="2.3.5.0" newVersion="4.3.0.0"/>
 9 |         <bindingRedirect oldVersion="2.0.0.0" newVersion="4.3.0.0"/>
10 |       </dependentAssembly>
11 |     </assemblyBinding>
12 |   </runtime>
13 | </configuration>


--------------------------------------------------------------------------------
/Lbac.Compiler/Compiler.fs:
--------------------------------------------------------------------------------
 1 | module Compiler
 2 |     open System.Reflection
 3 |     open Lex
 4 |     open Syntax
 5 |     open IL
 6 |     open CodeGenerator
 7 |     open Railway
 8 | 
 9 |     let private identity = fun arg -> arg
10 |     let private lex = Lex.tokenize
11 |     let private parse = Syntax.parse
12 |     let private optimize = switch identity
13 |     let private codeGen = CodeGenerator.codegen
14 |     let private optimizeIL = switch OptimizeIL.optimize
15 |     let private methodBuilder = switch(IL.toMethod typedefof<System.Int32>)
16 | 
17 |     let compile = lex >> parse >=> optimize >=> codeGen >=> optimizeIL >=> methodBuilder
18 |     let toIl    = lex >> parse >=> optimize >=> codeGen >=> optimizeIL


--------------------------------------------------------------------------------
/Lbac.Compiler/App.config:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="utf-8"?>
 2 | <configuration>
 3 |   <startup>
 4 |     <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5" />
 5 |   </startup>
 6 |   <runtime>
 7 |     <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
 8 |       <dependentAssembly>
 9 |         <assemblyIdentity name="FSharp.Core" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
10 |         <bindingRedirect oldVersion="2.0.0.0" newVersion="4.3.0.0" />
11 |         <bindingRedirect oldVersion="2.3.5.0" newVersion="4.3.0.0" />
12 |         <bindingRedirect oldVersion="4.0.0.0" newVersion="4.3.0.0" />
13 |       </dependentAssembly>
14 |     </assemblyBinding>
15 |   </runtime>
16 | </configuration>


--------------------------------------------------------------------------------
/Lbac.Tests/ILTests.fs:
--------------------------------------------------------------------------------
 1 | namespace Lbac.Tests 
 2 | 
 3 | open System
 4 | open Microsoft.VisualStudio.TestTools.UnitTesting
 5 | open CodeGenerator
 6 | open Railway
 7 | open IL
 8 | 
 9 | [<TestClass>]
10 | type ILTests() = 
11 |     [<TestMethod>]
12 |     member x.``should produce an executable assembly`` () = 
13 |         let input = { Instructions = [Ldc_I4(1); Ldc_I4(2); instruction.Add]; Locals = [] } // 1 + 2
14 |         let expected = 1 + 2
15 |         let methodInfo = IL.toMethod typedefof<System.Int32> input
16 |         let instance = Activator.CreateInstance(methodInfo.DeclaringType)
17 |         let actual = methodInfo.Invoke(instance, null) :?> System.Int32
18 |         Assert.AreEqual(expected, actual)
19 |     


--------------------------------------------------------------------------------
/Lbac.Tests/LexerTests.fs:
--------------------------------------------------------------------------------
 1 | namespace Lbac.Tests
 2 | 
 3 | open System
 4 | open Microsoft.VisualStudio.TestTools.UnitTesting
 5 | open Lex
 6 | 
 7 | [<TestClass>]
 8 | type LexerTests() = 
 9 |     [<TestMethod>]
10 |     member x.``should lex 11 + 22`` () = 
11 |         let testVal = "11 + 22"
12 |         let expected = [Number(11); Symbol('+'); Number(22)]
13 |         let actual = Lex.tokenize testVal
14 |         Assert.AreEqual(expected, actual)
15 | 
16 |     [<TestMethod>]
17 |     member x.``should lex identifier`` () = 
18 |         let testVal = "foo = 1"
19 |         let expected = [Identifier("foo"); Symbol('='); Number(1)]
20 |         let actual = Lex.tokenize testVal
21 |         Assert.AreEqual(expected, actual)
22 | 
23 |     [<TestMethod>]
24 |     member x.``should lex multiple lines`` () = 
25 |         let testVal = "1\n2"
26 |         let expected = [Number(1); NewLine; Number(2)]
27 |         let actual = Lex.tokenize testVal
28 |         Assert.AreEqual(expected, actual)


--------------------------------------------------------------------------------
/Readme.markdown:
--------------------------------------------------------------------------------
 1 | Let's Build a Compiler... in F#!
 2 | ================================
 3 | 
 4 | F# translation of Jack Crenshaw's Pascal code from his article, "[Let's Build A Compiler](http://compilers.iecc.com/crenshaw/)".
 5 | 
 6 | Have fun!
 7 | 
 8 | Running the Application
 9 | =======================
10 | 
11 | Start by running the tests. 
12 | 
13 | You can also use the compiler interactively. Run the project Lbac.Compiler and it will compile a line after you press enter.
14 | 
15 | Finally, you can run non-interactively, using files:
16 | 
17 | 	> copy con > Foo.txt
18 | 	  1+2
19 | 	  ^C
20 | 	> Lbac.Compiler -i Foo.txt -o Bar.exe
21 | 
22 | This produces a console application which returns the result (3!).
23 | 
24 | License
25 | =======
26 | 
27 | Crenshaw's Pascal and text is Copyright (C) 1988 by Jack W. Crenshaw. All rights reserved. I haven't included any of his material here directly, but it was the basis for this series.
28 | 
29 | My F# code and comments are Copyright 2013 by Craig Stuntz.
30 | You may use this code under terms of the MIT license. See License.txt.


--------------------------------------------------------------------------------
/License.txt:
--------------------------------------------------------------------------------
1 | Licensed under the MIT License
2 | Copyright (c) 2011 Craig Stuntz
3 | 
4 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
5 | 
6 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
7 | 
8 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.


--------------------------------------------------------------------------------
/Lbac.Compiler/OptimizeIL.fs:
--------------------------------------------------------------------------------
 1 | module OptimizeIL
 2 | 
 3 |     open IL
 4 |     open System
 5 | 
 6 |     let private maxByte = Convert.ToInt32 System.Byte.MaxValue
 7 | 
 8 |     let private optimalShortEncodingFor = function
 9 |         | Ldc_I4 0    -> Ldc_I4_0 
10 |         | Ldc_I4 1    -> Ldc_I4_1 
11 |         | Ldc_I4 2    -> Ldc_I4_2 
12 |         | Ldc_I4 3    -> Ldc_I4_3 
13 |         | Ldc_I4 4    -> Ldc_I4_4 
14 |         | Ldc_I4 5    -> Ldc_I4_5 
15 |         | Ldc_I4 6    -> Ldc_I4_6 
16 |         | Ldc_I4 7    -> Ldc_I4_7 
17 |         | Ldc_I4 8    -> Ldc_I4_8 
18 |         | Ldloc 0     -> Ldloc_0  
19 |         | Ldloc 1     -> Ldloc_1  
20 |         | Ldloc 2     -> Ldloc_2  
21 |         | Ldloc 3     -> Ldloc_3
22 |         | Ldloc i when i <= maxByte -> Ldloc_S(Convert.ToByte(i))
23 |         | Stloc 0     -> Stloc_0  
24 |         | Stloc 1     -> Stloc_1  
25 |         | Stloc 2     -> Stloc_2  
26 |         | Stloc 3     -> Stloc_3  
27 |         | Stloc i when i <= maxByte -> Stloc_S(Convert.ToByte(i))
28 |         | instruction -> instruction
29 | 
30 |     let optimize (m : Method) = { m with Instructions = List.map optimalShortEncodingFor m.Instructions }


--------------------------------------------------------------------------------
/Lbac.Compiler/CommandLine.fs:
--------------------------------------------------------------------------------
 1 | module Lbac.CommandLine
 2 | 
 3 |     open Microsoft.FSharp.Text
 4 | 
 5 |     type Arguments = {
 6 |         InFile   : string option
 7 |         OutFile  : string option
 8 |         Valid    : bool }
 9 | 
10 |     let parse (commandLine : string[], outw : System.IO.TextWriter, error : System.IO.TextWriter) = 
11 |         let usage s = outw.WriteLine "Compiler [-in filename] [-out filename] [-help]"
12 |         let inFile = ref None
13 |         let outFile = ref None
14 |         let mutable valid = true
15 |         let specs = 
16 |             [ "-i",       ArgType.String (fun s  -> inFile := Some s),        "Name of input file"
17 |               "-o",       ArgType.String (fun s  -> outFile := Some s),       "Name of output file"
18 |             ] |> List.map (fun (name, action, help) -> ArgInfo(name, action, help))        
19 |         let current = ref 0
20 |         try ArgParser.ParsePartial(current, commandLine, specs, usage) with
21 |             | Bad e ->
22 |                 valid <- false
23 |                 error.WriteLine(e)
24 |             | HelpText h -> 
25 |                 outw.WriteLine(h)
26 |             | e -> 
27 |                 reraise()
28 | 
29 |         { InFile = inFile.Value; OutFile = outFile.Value; Valid = valid }


--------------------------------------------------------------------------------
/Lbac.Compiler/Program.fs:
--------------------------------------------------------------------------------
 1 | module Lbac.Program 
 2 |     
 3 | open System
 4 | open System.IO
 5 | open IL
 6 | open Compiler
 7 | open Railway
 8 | 
 9 | let runInteractive() =
10 |     let input = Console.ReadLine() 
11 |     match Compiler.toIl input with
12 |     | Success il -> printfn "%A" il
13 |     | Failure s    -> Console.Error.WriteLine s
14 |     Console.ReadLine() |> ignore
15 | 
16 | let runWithFiles inFile outFile = 
17 |     let input = File.ReadAllText(inFile)
18 |     match Compiler.toIl input with
19 |     | Success methodWithInstructions -> 
20 |         let moduleName = match outFile with
21 |                          | Some s -> s
22 |                          | None   -> IO.Path.ChangeExtension(inFile, ".exe")
23 |         let (t, ab) = IL.compileMethod moduleName methodWithInstructions.Instructions typeof<int>
24 |         ab.Save(t.Module.ScopeName) |> ignore        
25 |     | Failure s    -> Console.Error.WriteLine s
26 | 
27 | [<EntryPoint>]
28 | let main(args) = 
29 |     let arguments = CommandLine.parse(Array.append [|"Lbac.Compiler.exe"|]  args, Console.Out, Console.Error)
30 |     if arguments.Valid then 
31 |         match arguments.InFile with
32 |         | Some filename -> runWithFiles filename arguments.OutFile
33 |         | _             -> runInteractive()
34 |         0
35 |     else
36 |         1


--------------------------------------------------------------------------------
/Lbac.Tests/OptimizeILTests.fs:
--------------------------------------------------------------------------------
 1 | namespace Lbac.Tests
 2 | 
 3 | open IL
 4 | open OptimizeIL
 5 | open Microsoft.VisualStudio.TestTools.UnitTesting
 6 | 
 7 | [<TestClass>]
 8 | type OptimizeILTests() =
 9 | 
10 |     [<TestMethod>]
11 |     member x.``should change Ldc_I4 2 to LDC_I4_2`` () = 
12 |         let input = { Instructions = [Ldc_I4 2]; Locals = [] }
13 |         let actual = optimize input
14 |         Assert.AreEqual([Ldc_I4_2], actual.Instructions)
15 | 
16 |     [<TestMethod>]
17 |     member x.``should leave Stloc 100000 as Stloc 100000`` () = 
18 |         let input = { Instructions = [Ldc_I4_1; Stloc 100000; Ldloc 100000]; Locals = [] }
19 |         let actual = optimize input
20 |         Assert.AreEqual([Ldc_I4_1; Stloc 100000; Ldloc 100000], actual.Instructions)
21 | 
22 |     [<TestMethod>]
23 |     member x.``should change Stloc 10 to Stloc_S 10`` () = 
24 |         let input = { Instructions = [Ldc_I4_1; Stloc 10; Ldloc 10]; Locals = [] }
25 |         let actual = optimize input
26 |         Assert.AreEqual([Ldc_I4_1; Stloc_S 10uy; Ldloc_S 10uy], actual.Instructions)
27 | 
28 |     [<TestMethod>]
29 |     member x.``should change Stloc 1 to Stloc_1`` () = 
30 |         let input = { Instructions = [Ldc_I4_1; Stloc 1; Ldloc 1]; Locals = [] }
31 |         let actual = optimize input
32 |         Assert.AreEqual([Ldc_I4_1; Stloc_1; Ldloc_1], actual.Instructions)
33 | 


--------------------------------------------------------------------------------
/Lbac.Compiler/Lex.fs:
--------------------------------------------------------------------------------
 1 | module Lex
 2 |     open System
 3 | 
 4 |     type Token =
 5 |         | Identifier of string
 6 |         | Number of int
 7 |         | Symbol of char
 8 |         | NewLine
 9 | 
10 |     let tokenize (input: string) =
11 |         let charIsCrlf c = Set.contains c (set ['\r'; '\n'])
12 |         let rec readIdentifier acc = function
13 |             | c :: rest when Char.IsLetterOrDigit(c) ->
14 |                 readIdentifier (acc + c.ToString()) rest
15 |             | rest -> Identifier(acc), rest
16 |         let rec readNumber acc = function 
17 |             | d :: rest when Char.IsDigit(d) ->
18 |                 readNumber (acc + d.ToString()) rest
19 |             | rest -> Number(Int32.Parse(acc)), rest
20 |         let rec tokenizeLine acc = function 
21 |             | n :: rest when charIsCrlf n     -> 
22 |                 match acc with 
23 |                     | [] -> acc, rest
24 |                     | _  -> (NewLine :: acc), rest
25 |             | d :: rest when Char.IsDigit(d)  ->
26 |                 let num, rest' = readNumber (d.ToString()) rest
27 |                 tokenizeLine (num :: acc) rest'
28 |             | c :: rest when Char.IsLetter(c) ->
29 |                 let ident, rest' = readIdentifier (c.ToString()) rest
30 |                 tokenizeLine (ident ::acc) rest'
31 |             | [] -> acc, []
32 |             | ws :: rest when Char.IsWhiteSpace(ws) -> tokenizeLine acc rest
33 |             | c :: rest -> tokenizeLine (Symbol(c) :: acc) rest
34 |         let rec beginningOfLine acc input =
35 |             match tokenizeLine [] input with 
36 |             | tokens, [] -> tokens @ acc
37 |             | acc', rest -> (beginningOfLine [] rest) @ acc' @acc
38 |         List.rev (beginningOfLine [] (List.ofSeq input))
39 | 


--------------------------------------------------------------------------------
/TraceAndTestImpact.testsettings:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="UTF-8"?>
 2 | <TestSettings name="Trace and Test Impact" id="c6559e31-d56c-467f-a2b6-bd560b3c47f7" xmlns="http://microsoft.com/schemas/VisualStudio/TeamTest/2010">
 3 |   <Description>These are test settings for Trace and Test Impact.</Description>
 4 |   <Execution>
 5 |     <TestTypeSpecific />
 6 |     <AgentRule name="Execution Agents">
 7 |       <DataCollectors>
 8 |         <DataCollector uri="datacollector://microsoft/SystemInfo/1.0" assemblyQualifiedName="Microsoft.VisualStudio.TestTools.DataCollection.SystemInfo.SystemInfoDataCollector, Microsoft.VisualStudio.TestTools.DataCollection.SystemInfo, Version=10.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" friendlyName="System Information">
 9 |         </DataCollector>
10 |         <DataCollector uri="datacollector://microsoft/HttpProxy/1.0" assemblyQualifiedName="Microsoft.VisualStudio.TraceCollector.HttpProxyCollector, Microsoft.VisualStudio.TraceCollector, Version=10.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" friendlyName="ASP.NET Client Proxy for IntelliTrace and Test Impact">
11 |         </DataCollector>
12 |         <DataCollector uri="datacollector://microsoft/TestImpact/1.0" assemblyQualifiedName="Microsoft.VisualStudio.TraceCollector.TestImpactDataCollector, Microsoft.VisualStudio.TraceCollector, Version=10.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" friendlyName="Test Impact">
13 |         </DataCollector>
14 |         <DataCollector uri="datacollector://microsoft/TraceDebugger/1.0" assemblyQualifiedName="Microsoft.VisualStudio.TraceCollector.TraceDebuggerDataCollector, Microsoft.VisualStudio.TraceCollector, Version=10.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" friendlyName="IntelliTrace">
15 |         </DataCollector>
16 |       </DataCollectors>
17 |     </AgentRule>
18 |   </Execution>
19 | </TestSettings>


--------------------------------------------------------------------------------
/Lbac.Tests/CommandLineTests.fs:
--------------------------------------------------------------------------------
 1 | namespace Lbac.Tests
 2 | 
 3 |     open Microsoft.VisualStudio.TestTools.UnitTesting
 4 |     open System.IO
 5 |     open System.Text
 6 |     open Lbac
 7 | 
 8 |     [<TestClass>]
 9 |     type CommandLineTests() = class
10 |         let parse_with_fake_output args = 
11 |             let outw = new StringBuilder()
12 |             let error = new StringBuilder()
13 | 
14 |             let actual = Lbac.CommandLine.parse(args, new StringWriter(outw), new StringWriter(error))
15 | 
16 |             (actual, outw.ToString(), error.ToString())
17 | 
18 |         [<TestMethod>]
19 |         member x.parse_should_find_inFile() = 
20 |             let expected = "foo.txt"
21 |             let args = [| "programname.exe"; "-i"; expected; "-o"; "bar.exe" |]
22 | 
23 |             let (actual, outw, error) = parse_with_fake_output args
24 | 
25 |             Assert.AreEqual(expected, actual.InFile.Value)
26 |             Assert.IsTrue(System.String.IsNullOrEmpty(outw))
27 |             Assert.IsTrue(System.String.IsNullOrEmpty(error))
28 |             Assert.IsTrue(actual.Valid)
29 | 
30 |         [<TestMethod>]
31 |         member x.parse_should_find_outFile() = 
32 |             let expected = "bar.exe"
33 |             let args = [| "programname.exe"; "-i"; "foo.txt"; "-o"; expected |]
34 | 
35 |             let (actual, out, error) = parse_with_fake_output args
36 | 
37 |             Assert.AreEqual(expected, actual.OutFile.Value)
38 |             Assert.IsTrue(System.String.IsNullOrEmpty(out))
39 |             Assert.IsTrue(System.String.IsNullOrEmpty(error))
40 |             Assert.IsTrue(actual.Valid)
41 | 
42 |         [<TestMethod>]
43 |         member x.parse_should_prompt_for_missing_values() = 
44 |             let expected = Some 1
45 |             let args = [| "programname.exe"; "-i" |]
46 | 
47 |             let (actual, out, error) = parse_with_fake_output args
48 | 
49 |             Assert.IsFalse(System.String.IsNullOrEmpty(error))
50 |             Assert.IsFalse(actual.Valid)
51 | 
52 |     end


--------------------------------------------------------------------------------
/Lbac.Tests/CodeGeneratorTests.fs:
--------------------------------------------------------------------------------
 1 | namespace Lbac.Tests 
 2 | 
 3 | open System
 4 | open Microsoft.VisualStudio.TestTools.UnitTesting
 5 | open CodeGenerator
 6 | open Railway
 7 | open IL
 8 | open Syntax
 9 | 
10 | [<TestClass>]
11 | type CodeGeneratorTests() =
12 |     let shouldFailWith (input, locals) error = 
13 |         match CodeGenerator.codegen({ Lines = [input]; Locals = locals }) with
14 |             | Success _ -> Assert.Fail("Expected error.")
15 |             | Failure e -> Assert.AreEqual(error, e)
16 | 
17 |     let shouldProduceIL (input, locals) expected = 
18 |         let actual = CodeGenerator.codegen({ Lines = [input]; Locals = locals })
19 |         match actual with 
20 |             | Success il -> Assert.AreEqual(expected, il.Instructions)
21 |             | Failure e -> Assert.Fail(e)
22 | 
23 |     let noLocalVariables = Set.empty
24 | 
25 |     [<TestMethod>]
26 |     member x.``should codegen 1 + 2 * 0`` () = 
27 |         let input = Expr.Binary(Expr.Binary(Expr.Number(1), Add, Expr.Number(2)), Multiply, Expr.Number(0))
28 |         let expected = [Ldc_I4 1; Ldc_I4 2; instruction.Add; Ldc_I4 0; Mul]
29 |         (input, noLocalVariables) |> shouldProduceIL <| expected
30 | 
31 |     [<TestMethod>]
32 |     member x.``should fail on undeclared variable`` () =
33 |         let input = Expr.Binary(Expr.Variable("x"), Add, Expr.Number(1))
34 |         let expected = "Undeclared variable x"
35 |         (input, noLocalVariables) |> shouldFailWith <| expected
36 |     
37 |     [<TestMethod>]
38 |     member x.``should codegen x + 1`` () =
39 |         let input = Expr.Binary(Expr.Variable("x"), Add, Expr.Number(1))
40 |         let expected = [DeclareLocal(typedefof<int>); Ldloc 0; Ldc_I4 1; instruction.Add]
41 |         (input, Set.singleton("x")) |> shouldProduceIL <| expected
42 |     
43 |     [<TestMethod>]
44 |     member x.``should codegen x = 1`` () =
45 |         let input = Expr.Assign(Expr.Variable("x"), Expr.Number(1))
46 |         let expected = [DeclareLocal(typedefof<int>); Ldc_I4(1); Stloc 0]
47 |         (input, Set.singleton("x")) |> shouldProduceIL <| expected


--------------------------------------------------------------------------------
/Lbac.Tests/EndToEndTests.fs:
--------------------------------------------------------------------------------
 1 | namespace Lbac.Tests
 2 | 
 3 | open System
 4 | open Microsoft.VisualStudio.TestTools.UnitTesting
 5 | open Compiler
 6 | open Railway
 7 | 
 8 | [<TestClass>]
 9 | type EndToEndTests() = 
10 |     let execute (mi: System.Reflection.MethodInfo) =
11 |         let instance = Activator.CreateInstance(mi.DeclaringType)
12 |         mi.Invoke(instance, null) :?> System.Int32
13 | 
14 |     let shouldEqual output expected = 
15 |         match output with
16 |         | Success mi -> Assert.AreEqual(expected, execute(mi))
17 |         | Failure e -> Assert.Fail(e)
18 |          
19 |     [<TestMethod>]
20 |     member x.``1 + 2 should equal 3`` () = 
21 |         Compiler.compile("1 + 2") |> shouldEqual <| 3
22 | 
23 |     [<TestMethod>]
24 |     member x.``1 - 2 should equal -1`` () = 
25 |         Compiler.compile("1 - 2") |> shouldEqual <| -1
26 | 
27 |     [<TestMethod>]
28 |     member x.``2 * 3 should equal 6`` () = 
29 |         Compiler.compile("2 * 3") |> shouldEqual <| 6
30 | 
31 |     [<TestMethod>]
32 |     member x.``10 - 2 * 3 should equal 4`` () = 
33 |         Compiler.compile("10 - 2 * 3") |> shouldEqual <| 4
34 | 
35 |     [<TestMethod>]
36 |     member x.``(10 - 2) * 3 should equal 24`` () = 
37 |         Compiler.compile("(10 - 2) * 3") |> shouldEqual <| 24
38 | 
39 |     [<TestMethod>]
40 |     member x.``-2 + 2 should equal 0`` () = 
41 |         Compiler.compile("-2 + 2") |> shouldEqual <| 0
42 | 
43 |     [<TestMethod>]
44 |     member x.``2+-3 should equal -1`` () = 
45 |         Compiler.compile("2+-3") |> shouldEqual <| -1
46 | 
47 |     [<TestMethod>]
48 |     member x.``6/2 should equal 3`` () = 
49 |         Compiler.compile("6/2") |> shouldEqual <| 3
50 | 
51 |     [<TestMethod>]
52 |     member x.``Assign and use local var`` () = 
53 |         Compiler.compile("x = 1\nx + 2") |> shouldEqual <| 3
54 | 
55 |     [<TestMethod>]
56 |     member x.``Assign and use 2 local vars`` () = 
57 |         Compiler.compile("x = 1\ny = 2\nx + y") |> shouldEqual <| 3
58 | 
59 |     [<TestMethod>]
60 |     member x.``Ignore extra CRLFs, whitespace`` () = 
61 |         Compiler.compile("""
62 |         x = 1  
63 |         y = 2 
64 |         x + y   
65 |         """) |> shouldEqual <| 3


--------------------------------------------------------------------------------
/Lbac.Compiler/Railway.fs:
--------------------------------------------------------------------------------
 1 | module Railway
 2 |     // This code largely "borrowed" from http://fsharpforfunandprofit.com/posts/recipe-part2/
 3 | 
 4 |     // the two-track type
 5 |     type Result<'TSuccess,'TFailure> = 
 6 |         | Success of 'TSuccess
 7 |         | Failure of 'TFailure
 8 | 
 9 |     // convert a single value into a two-track result
10 |     let succeed x = 
11 |         Success x
12 | 
13 |     // convert a single value into a two-track result
14 |     let fail x = 
15 |         Failure x
16 | 
17 |     // apply either a success function or failure function
18 |     let either successFunc failureFunc twoTrackInput =
19 |         match twoTrackInput with
20 |         | Success s -> successFunc s
21 |         | Failure f -> failureFunc f
22 | 
23 |     // convert a switch function into a two-track function
24 |     let bind f = 
25 |         either f fail
26 | 
27 |     // pipe a two-track value into a switch function 
28 |     let (>>=) x f = 
29 |         bind f x
30 | 
31 |     // compose two switches into another switch
32 |     let (>=>) s1 s2 = 
33 |         s1 >> bind s2
34 | 
35 |     // convert a one-track function into a switch
36 |     let switch f = 
37 |         f >> succeed
38 | 
39 |     // convert a one-track function into a two-track function
40 |     let map f = 
41 |         either (f >> succeed) fail
42 | 
43 |     // convert a dead-end function into a one-track function
44 |     let tee f x = 
45 |         f x; x 
46 | 
47 |     // convert a one-track function into a switch with exception handling
48 |     let tryCatch f exnHandler x =
49 |         try
50 |             f x |> succeed
51 |         with
52 |         | ex -> exnHandler ex |> fail
53 | 
54 |     // convert two one-track functions into a two-track function
55 |     let doubleMap successFunc failureFunc =
56 |         either (successFunc >> succeed) (failureFunc >> fail)
57 | 
58 |     // add two switches in parallel
59 |     let plus addSuccess addFailure switch1 switch2 x = 
60 |         match (switch1 x),(switch2 x) with
61 |         | Success s1,Success s2 -> Success (addSuccess s1 s2)
62 |         | Failure f1,Success _  -> Failure f1
63 |         | Success _ ,Failure f2 -> Failure f2
64 |         | Failure f1,Failure f2 -> Failure (addFailure f1 f2)
65 | 
66 | 


--------------------------------------------------------------------------------
/Lbac.sln:
--------------------------------------------------------------------------------
 1 | 
 2 | Microsoft Visual Studio Solution File, Format Version 12.00
 3 | # Visual Studio 2012
 4 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{E64BB80B-07D0-49EF-8058-8A5D235EB083}"
 5 | 	ProjectSection(SolutionItems) = preProject
 6 | 		Lbac.vsmdi = Lbac.vsmdi
 7 | 		License.txt = License.txt
 8 | 		Local.testsettings = Local.testsettings
 9 | 		Readme.markdown = Readme.markdown
10 | 		TraceAndTestImpact.testsettings = TraceAndTestImpact.testsettings
11 | 	EndProjectSection
12 | EndProject
13 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Lbac.Compiler", "Lbac.Compiler\Lbac.Compiler.fsproj", "{C26A4E00-2873-46AB-963C-27ADD62B42EE}"
14 | EndProject
15 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Lbac.Tests", "Lbac.Tests\Lbac.Tests.fsproj", "{1F3EDE6E-7D84-45BD-9B0C-00198760A714}"
16 | EndProject
17 | Global
18 | 	GlobalSection(TestCaseManagementSettings) = postSolution
19 | 		CategoryFile = Lbac.vsmdi
20 | 	EndGlobalSection
21 | 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
22 | 		Debug|Any CPU = Debug|Any CPU
23 | 		Debug|Mixed Platforms = Debug|Mixed Platforms
24 | 		Debug|x86 = Debug|x86
25 | 		Release|Any CPU = Release|Any CPU
26 | 		Release|Mixed Platforms = Release|Mixed Platforms
27 | 		Release|x86 = Release|x86
28 | 	EndGlobalSection
29 | 	GlobalSection(ProjectConfigurationPlatforms) = postSolution
30 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Debug|Any CPU.ActiveCfg = Debug|x86
31 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Debug|Mixed Platforms.ActiveCfg = Debug|x86
32 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Debug|Mixed Platforms.Build.0 = Debug|x86
33 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Debug|x86.ActiveCfg = Debug|x86
34 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Debug|x86.Build.0 = Debug|x86
35 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Release|Any CPU.ActiveCfg = Release|x86
36 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Release|Mixed Platforms.ActiveCfg = Release|x86
37 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Release|Mixed Platforms.Build.0 = Release|x86
38 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Release|x86.ActiveCfg = Release|x86
39 | 		{C26A4E00-2873-46AB-963C-27ADD62B42EE}.Release|x86.Build.0 = Release|x86
40 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
41 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Debug|Any CPU.Build.0 = Debug|Any CPU
42 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU
43 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU
44 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Debug|x86.ActiveCfg = Debug|Any CPU
45 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Release|Any CPU.ActiveCfg = Release|Any CPU
46 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Release|Any CPU.Build.0 = Release|Any CPU
47 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU
48 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Release|Mixed Platforms.Build.0 = Release|Any CPU
49 | 		{1F3EDE6E-7D84-45BD-9B0C-00198760A714}.Release|x86.ActiveCfg = Release|Any CPU
50 | 	EndGlobalSection
51 | 	GlobalSection(SolutionProperties) = preSolution
52 | 		HideSolutionNode = FALSE
53 | 	EndGlobalSection
54 | EndGlobal
55 | 


--------------------------------------------------------------------------------
/Lbac.Tests/Lbac.Tests.fsproj:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="utf-8"?>
 2 | <Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
 3 |   <PropertyGroup>
 4 |     <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
 5 |     <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
 6 |     <SchemaVersion>2.0</SchemaVersion>
 7 |     <ProjectGuid>1f3ede6e-7d84-45bd-9b0c-00198760a714</ProjectGuid>
 8 |     <OutputType>Library</OutputType>
 9 |     <RootNamespace>Lbac.Tests</RootNamespace>
10 |     <AssemblyName>Lbac.Tests</AssemblyName>
11 |     <targetframeworkversion>4.5</targetframeworkversion>
12 |     <Name>FsUnitTest</Name>
13 |   </PropertyGroup>
14 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
15 |     <DebugSymbols>true</DebugSymbols>
16 |     <DebugType>full</DebugType>
17 |     <Optimize>false</Optimize>
18 |     <Tailcalls>false</Tailcalls>
19 |     <OutputPath>bin\Debug\</OutputPath>
20 |     <DefineConstants>DEBUG;TRACE</DefineConstants>
21 |     <WarningLevel>3</WarningLevel>
22 |     <DocumentationFile>bin\Debug\FsUnitTest.XML</DocumentationFile>
23 |     <PlatformTarget>x86</PlatformTarget>
24 |   </PropertyGroup>
25 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
26 |     <DebugType>pdbonly</DebugType>
27 |     <Optimize>true</Optimize>
28 |     <Tailcalls>true</Tailcalls>
29 |     <OutputPath>bin\Release\</OutputPath>
30 |     <DefineConstants>TRACE</DefineConstants>
31 |     <WarningLevel>3</WarningLevel>
32 |     <DocumentationFile>bin\Release\FsUnitTest.XML</DocumentationFile>
33 |   </PropertyGroup>
34 |   <ItemGroup>
35 |     <Reference Include="Microsoft.VisualStudio.QualityTools.UnitTestFramework, Version=10.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
36 |     <Reference Include="mscorlib" />
37 |     <Reference Include="FSharp.Core, Version=4.3.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
38 |       <Private>True</Private>
39 |     </Reference>
40 |     <Reference Include="System" />
41 |     <Reference Include="System.Core" />
42 |     <Reference Include="System.Numerics" />
43 |   </ItemGroup>
44 |   <ItemGroup>
45 |     <None Include="App.config" />
46 |     <None Include="MSTest.runsettings" />
47 |     <Compile Include="ILTests.fs" />
48 |     <Compile Include="LexerTests.fs" />
49 |     <Compile Include="SyntaxTests.fs" />
50 |     <Compile Include="CodeGeneratorTests.fs" />
51 |     <Compile Include="OptimizeILTests.fs" />
52 |     <Compile Include="CommandLineTests.fs" />
53 |     <Compile Include="EndToEndTests.fs" />
54 |   </ItemGroup>
55 |   <ItemGroup>
56 |     <ProjectReference Include="..\Lbac.Compiler\Lbac.Compiler.fsproj">
57 |       <Name>Lbac.Compiler</Name>
58 |       <Project>{c26a4e00-2873-46ab-963c-27add62b42ee}</Project>
59 |       <Private>True</Private>
60 |     </ProjectReference>
61 |   </ItemGroup>
62 |   <PropertyGroup>
63 |     <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
64 |   </PropertyGroup>
65 |   <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')" />
66 |   <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
67 |        Other similar extension points exist, see Microsoft.Common.targets.
68 |   <Target Name="BeforeBuild">
69 |   </Target>
70 |   <Target Name="AfterBuild">
71 |   </Target>
72 |   -->
73 | </Project>


--------------------------------------------------------------------------------
/Lbac.Tests/SyntaxTests.fs:
--------------------------------------------------------------------------------
 1 | namespace Lbac.Tests
 2 | 
 3 | open System
 4 | open Microsoft.VisualStudio.TestTools.UnitTesting
 5 | open Railway
 6 | open Lex
 7 | open Syntax
 8 | 
 9 | [<TestClass>]
10 | type SyntaxTests() = 
11 |     let shouldFailWith input expected = 
12 |         match Syntax.parse(input) with
13 |             | Failure actual -> Assert.AreEqual(expected, actual)
14 |             | Success actual -> Assert.Fail(sprintf "Expected %A, got %A." expected actual) 
15 | 
16 |     let shouldParseTo input (expected : Expr list) = 
17 |         match Syntax.parse(input) with
18 |             | Failure actual -> Assert.Fail(actual)
19 |             | Success actual -> // This test isn't strictly necessary, but it does improve the error reporting
20 |                                 if actual.Lines.Length <> expected.Length then 
21 |                                     Assert.Fail(sprintf "Expected %A, got %A." expected actual.Lines)
22 |                                 let itemMatches exp act = Assert.AreEqual(exp, act, sprintf "Expected %A, got %A." expected act)
23 |                                 List.iter (fun (e, a) -> itemMatches e a) (List.zip expected actual.Lines)
24 | 
25 |     [<TestMethod>]
26 |     member x.``should parse 11`` () = 
27 |         [Token.Number(11)] |> shouldParseTo <| [ Expr.Number(11) ]
28 | 
29 |     [<TestMethod>]
30 |     member x.``should error on garbage`` () = 
31 |         [Symbol('x')] |> shouldFailWith <| "Identifier expected"
32 | 
33 |     [<TestMethod>]
34 |     member x.``should parse 11 + 22`` () = 
35 |         [Token.Number(11); Symbol('+'); Token.Number(22)] |> shouldParseTo <| [ Expr.Binary(Expr.Number(11), Operator.Add, Expr.Number(22)) ]
36 | 
37 |     [<TestMethod>]
38 |     member x.``should parse 2 * 3`` () = 
39 |         [Token.Number(2); Symbol('*'); Token.Number(3)] |> shouldParseTo <| [ Expr.Binary(Expr.Number(2), Operator.Multiply, Expr.Number(3)) ]
40 | 
41 |     [<TestMethod>]
42 |     member x.``(10 - 2 * 3 should fail with mismatched (`` () = 
43 |         [Symbol('('); Token.Number(10); Symbol('-'); Token.Number(2); Symbol('*'); Token.Number(3)] 
44 |             |> shouldFailWith <| "')' expected."
45 |             
46 |     [<TestMethod>]
47 |     member x.``should parse -1`` () = 
48 |         [Symbol('-'); Token.Number(1)] |> shouldParseTo <| [ Expr.Minus(Expr.Number(1)) ]
49 | 
50 |     [<TestMethod>]
51 |     member x.``should parse x + 1`` () = 
52 |         [Identifier("x"); Symbol('='); Token.Number(1); NewLine; Identifier("x"); Symbol('+'); Token.Number(1)] 
53 |             |> shouldParseTo <| [ Expr.Assign(Expr.Variable("x"), Number(1)); Expr.Binary(Expr.Variable("x"), Operator.Add, Expr.Number(1)) ]
54 | 
55 |     [<TestMethod>]
56 |     member x.``should parse x() + 1`` () = 
57 |         [Identifier("x"); Symbol('('); Symbol(')'); Symbol('+'); Token.Number(1)] 
58 |             |> shouldParseTo <| [ Expr.Binary(Expr.Invoke("x"), Operator.Add, Expr.Number(1)) ]
59 | 
60 |     [<TestMethod>]
61 |     member x.``should parse x = 1``() =
62 |         [Identifier("x"); Symbol('='); Token.Number(1)] |> shouldParseTo <| [ Expr.Assign(Expr.Variable("x"), Expr.Number(1)) ]
63 | 
64 |     [<TestMethod>]
65 |     member x.``should parse multiple lines``() =
66 |         [Token.Number(1); NewLine; Token.Number(2)] |> shouldParseTo <| [ Expr.Number(1); Expr.Number(2) ]
67 | 
68 |     [<TestMethod>]
69 |     member x.``should fail with undeclared local``() =
70 |         [Token.Identifier("x")] |> shouldFailWith <| "Variable \"x\" not declared"
71 | 
72 |     [<TestMethod>]
73 |     member x.``1 = 2 should fail``() =
74 |         [Token.Number(1); Symbol('='); Token.Number(2)] |> shouldFailWith <| "Unexpected token: Symbol '='"


--------------------------------------------------------------------------------
/Lbac.Compiler/CodeGenerator.fs:
--------------------------------------------------------------------------------
 1 | module CodeGenerator
 2 | 
 3 |     open Railway
 4 |     open IL
 5 |     open Syntax
 6 | 
 7 |     let private localVarIndex locals name = 
 8 |         List.tryFindIndex (fun l -> System.String.Equals(l, name, System.StringComparison.Ordinal)) locals
 9 | 
10 |     let private codegenAssign locals name =
11 |         match localVarIndex locals name with
12 |             | None   -> Failure ("Undeclared variable " + name)
13 |             | Some i -> Success(Stloc i)
14 | 
15 |     let private codegenOper = function
16 |         | Add      -> instruction.Add
17 |         | Subtract -> instruction.Sub
18 |         | Multiply -> instruction.Mul
19 |         | Divide   -> instruction.Div
20 | 
21 |     let private tryLdLoc ((locals : string list), (name : string)) = 
22 |         match localVarIndex locals name with
23 |             | None   -> Failure ("Undeclared variable " + name)
24 |             | Some i -> Success(Ldloc i)
25 | 
26 |     let rec codegenExpr (acc : Method) (expr : Expr) = 
27 |         match expr with
28 |         | Variable v -> 
29 |             match tryLdLoc (acc.Locals, v) with 
30 |             | Success inst -> Success({ acc with Instructions = acc.Instructions @ [inst] })
31 |             | Failure   err  -> Failure err
32 |         | Invoke m -> Failure "Sorry; no can do"
33 |         | Minus e -> 
34 |             match codegenExpr acc e with
35 |             | Success m -> Success({ m with Instructions = m.Instructions @ [Neg] })
36 |             | err -> err
37 |         | Number n -> Success({ acc with Instructions = acc.Instructions @ [Ldc_I4 n] })
38 |         | Assign (n, rhs) -> 
39 |             let rhsMethod = codegenExpr { acc with Instructions = [] } rhs
40 |             match (n, rhsMethod) with 
41 |             | (Variable name, Success r) -> 
42 |                 match codegenAssign r.Locals name with 
43 |                 | Success assign_inst -> 
44 |                     let insts = List.concat [ r.Instructions; [ assign_inst ] ]
45 |                     Success({ Instructions = acc.Instructions @ insts; Locals = r.Locals })
46 |                 | Failure a -> Failure(a)
47 |             | (_, Success r) -> failwith "A variable is required on the left hand side of an assignment." // Should never happen; parser should not emit this
48 |             | (_, Failure r) -> rhsMethod
49 |         | Binary (lhs, oper, rhs) -> 
50 |             let lhsMethod = codegenExpr { acc with Instructions = [] } lhs
51 |             let rhsMethod = codegenExpr { acc with Instructions = [] } rhs
52 |             let operInst = codegenOper oper
53 |             match (lhsMethod, rhsMethod) with
54 |                 | (Success l, Success r) -> 
55 |                     let insts       = List.concat [ l.Instructions; r.Instructions; [operInst] ]
56 |                     let mergeLocals = List.concat [ l.Locals; List.filter (fun i2 -> not (List.exists (fun i1 -> i1 = i2) l.Locals)) r.Locals]
57 |                     Success({ Instructions = acc.Instructions @ insts; Locals = mergeLocals })
58 |                 | (Failure l, _) -> lhsMethod
59 |                 | (_, Failure r) -> rhsMethod
60 |         | Error _ -> failwith "Sorry, you can't pass an Error here!"
61 | 
62 |     let rec codegen (parsed : ParseResult) =
63 |         let locals = 
64 |             parsed.Locals 
65 |             |> List.ofSeq
66 |         let tryCodeGenLine acc line = 
67 |             match acc, line with
68 |             | Success accMethod, expr -> codegenExpr accMethod expr
69 |             | Failure err, _ -> Failure err
70 |         let localDeclarations = [for name in locals -> DeclareLocal(typedefof<int>)]
71 |         let emptyMethod = Success( { Instructions = localDeclarations; Locals = locals } )
72 |         List.fold tryCodeGenLine emptyMethod parsed.Lines
73 | 


--------------------------------------------------------------------------------
/Lbac.Compiler/Lbac.Compiler.fsproj:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="utf-8"?>
 2 | <Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
 3 |   <PropertyGroup>
 4 |     <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
 5 |     <Platform Condition=" '$(Platform)' == '' ">x86</Platform>
 6 |     <ProductVersion>8.0.30703</ProductVersion>
 7 |     <SchemaVersion>2.0</SchemaVersion>
 8 |     <ProjectGuid>{c26a4e00-2873-46ab-963c-27add62b42ee}</ProjectGuid>
 9 |     <OutputType>Exe</OutputType>
10 |     <RootNamespace>Lbac.Compiler</RootNamespace>
11 |     <AssemblyName>Lbac.Compiler</AssemblyName>
12 |     <TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
13 |     <TargetFrameworkProfile>
14 |     </TargetFrameworkProfile>
15 |     <Name>Lbac.Compiler</Name>
16 |   </PropertyGroup>
17 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x86' ">
18 |     <DebugSymbols>true</DebugSymbols>
19 |     <DebugType>full</DebugType>
20 |     <Optimize>false</Optimize>
21 |     <Tailcalls>false</Tailcalls>
22 |     <OutputPath>bin\Debug\</OutputPath>
23 |     <DefineConstants>DEBUG;TRACE</DefineConstants>
24 |     <WarningLevel>3</WarningLevel>
25 |     <PlatformTarget>x86</PlatformTarget>
26 |     <DocumentationFile>bin\Debug\Lbac.Compiler.XML</DocumentationFile>
27 |     <StartArguments>
28 |     </StartArguments>
29 |     <TreatWarningsAsErrors>true</TreatWarningsAsErrors>
30 |     <WarningsAsErrors />
31 |   </PropertyGroup>
32 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|x86' ">
33 |     <DebugType>pdbonly</DebugType>
34 |     <Optimize>true</Optimize>
35 |     <Tailcalls>true</Tailcalls>
36 |     <OutputPath>bin\Release\</OutputPath>
37 |     <DefineConstants>TRACE</DefineConstants>
38 |     <WarningLevel>3</WarningLevel>
39 |     <PlatformTarget>x86</PlatformTarget>
40 |     <DocumentationFile>bin\Release\Lbac.Compiler.XML</DocumentationFile>
41 |   </PropertyGroup>
42 |   <PropertyGroup>
43 |     <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
44 |   </PropertyGroup>
45 |   <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets" Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')" />
46 |   <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets" Condition="(!Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')) And (Exists('$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets'))" />
47 |   <Import Project="$(MSBuildExtensionsPath32)\FSharp\1.0\Microsoft.FSharp.Targets" Condition="(!Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')) And (!Exists('$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets')) And (Exists('$(MSBuildExtensionsPath32)\FSharp\1.0\Microsoft.FSharp.Targets'))" />
48 |   <ItemGroup>
49 |     <None Include="App.config">
50 |       <CopyToOutputDirectory>Always</CopyToOutputDirectory>
51 |     </None>
52 |     <Compile Include="Railway.fs" />
53 |     <Compile Include="IL.fs" />
54 |     <Compile Include="Lex.fs" />
55 |     <Compile Include="Syntax.fs" />
56 |     <Compile Include="CodeGenerator.fs" />
57 |     <Compile Include="OptimizeIL.fs" />
58 |     <Compile Include="Compiler.fs" />
59 |     <Compile Include="Arg.fs" />
60 |     <Compile Include="CommandLine.fs" />
61 |     <Compile Include="Program.fs" />
62 |   </ItemGroup>
63 |   <ItemGroup>
64 |     <Reference Include="mscorlib" />
65 |     <Reference Include="FSharp.Core" />
66 |     <Reference Include="System" />
67 |     <Reference Include="System.Core" />
68 |     <Reference Include="System.Numerics" />
69 |   </ItemGroup>
70 |   <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
71 | 	     Other similar extension points exist, see Microsoft.Common.targets.
72 | 	<Target Name="BeforeBuild">
73 | 	</Target>
74 | 	<Target Name="AfterBuild">
75 | 	</Target>
76 | 	-->
77 | </Project>


--------------------------------------------------------------------------------
/Lbac.Compiler/Syntax.fs:
--------------------------------------------------------------------------------
  1 | module Syntax
  2 |     
  3 |     open Railway
  4 |     open Lex
  5 | 
  6 |     type Operator =
  7 |         | Add
  8 |         | Subtract
  9 |         | Multiply
 10 |         | Divide
 11 | 
 12 |     type Expr =
 13 |         | Number   of int
 14 |         | Variable of string
 15 |         | Invoke   of string
 16 |         | Minus    of Expr
 17 |         | Assign   of Expr * Expr
 18 |         | Binary   of Expr * Operator * Expr
 19 |         | Error of string
 20 | 
 21 |     type ParseResult = { Lines: Expr list; Locals: Set<string> } 
 22 | 
 23 |     /// Converts token list to Success(AST) if valid or Error if not
 24 |     let rec parseLine (acc: ParseResult) (tokens: Token list): ParseResult =
 25 | 
 26 |         /// Returns Some(oper) if head of input is a + or - token
 27 |         let toAddOp = function
 28 |             | Token.Symbol('+') :: _ -> Some(Add)
 29 |             | Token.Symbol('-') :: _ -> Some(Subtract)
 30 |             | _                      -> None
 31 | 
 32 |         /// Returns Some(oper) if head of input is a * or / token
 33 |         let toMulOp = function
 34 |             | Token.Symbol('*') :: _ -> Some(Multiply)
 35 |             | Token.Symbol('/') :: _ -> Some(Divide)
 36 |             | _                      -> None
 37 | 
 38 |         /// factor ::= (expression) | number | ident
 39 |         let rec factor acc = function
 40 |             | Symbol '(' :: rest   -> 
 41 |                 match expression acc rest with 
 42 |                 | exp, Symbol ')' :: rest', acc' -> exp, rest', acc'
 43 |                 | _, rest', acc'                 -> Error("')' expected."), rest', acc'
 44 |             | Token.Number n :: ts -> Number(n), ts, acc
 45 |             | tokens               -> ident acc tokens
 46 | 
 47 |         /// ident = function() | variable
 48 |         and ident acc = function
 49 |             | Identifier id :: rest ->
 50 |                 match rest with 
 51 |                 | Symbol '(' :: rest' -> // function invocation
 52 |                     match rest' with 
 53 |                     // No support for argument passing yet. 
 54 |                     // Only valid function invocation is empty parens: foo()
 55 |                     | Symbol ')' :: rest'' -> Invoke(id), rest'', acc
 56 |                     | _                    -> Error ("')' expected"), rest', acc
 57 |                 | _                   -> // dereference       
 58 |                     match acc.Locals.Contains(id) with
 59 |                     | true  -> Variable(id), rest, acc
 60 |                     | false -> Error(sprintf "Variable %A not declared" id), rest, acc
 61 |             | _ -> Error("Identifier expected"), [], acc
 62 |             
 63 |         /// term ::= factor  [ mulop factor ]*
 64 |         and term acc (tokens: Token list) = 
 65 |             let left, rightTokens, acc' = factor acc tokens
 66 |             match rightTokens, toMulOp rightTokens with
 67 |                 | mulOpSym :: ts, Some mulOp -> 
 68 |                     let right, rest, acc'' = expression acc' ts
 69 |                     Binary(left, mulOp, right), rest, acc''
 70 |                 | _ -> left, rightTokens, acc'
 71 | 
 72 |         and unary acc = function
 73 |             | Symbol '-' :: rest -> 
 74 |                 match term acc rest with
 75 |                 | e, rest', acc' -> Minus(e), rest', acc'
 76 |             | tokens -> term acc tokens
 77 | 
 78 |         and assign acc = function 
 79 |             | Identifier name :: rest ->
 80 |                 match rest with
 81 |                 | Symbol('=') :: rest' -> 
 82 |                     let rhs, rest'', acc' = expression { acc with Locals = acc.Locals.Add(name) } rest'
 83 |                     Some(Assign(Variable(name), rhs), rest'', acc')
 84 |                 | _ -> None
 85 |             | _ -> None
 86 |                 
 87 |         /// expression ::= [addop] term [addop term]* 
 88 |         and expression acc tokens = 
 89 |             match assign acc tokens with 
 90 |                 | Some assignment -> assignment
 91 |                 | None -> 
 92 |                     let leftExpr, rightTokens, acc' = unary acc tokens
 93 |                     match rightTokens, toAddOp rightTokens with
 94 |                         | addOpSym :: ts, Some addOp -> 
 95 |                             let right, rest, acc'' = expression acc' ts
 96 |                             Binary(leftExpr, addOp, right), rest, acc''
 97 |                         | _ -> leftExpr, rightTokens, acc'
 98 | 
 99 |         let ast, rest, acc' = expression acc tokens 
100 | 
101 |         match rest with 
102 |         | [] 
103 |         | NewLine :: []    -> { acc' with Lines = acc.Lines @ [ast] } // done!
104 |         | NewLine :: rest' -> parseLine { acc' with Lines = acc.Lines @ [ast] } rest' 
105 |         // If anything remains on line, it's a syntax error
106 |         | wrong   :: _     -> { acc' with Lines = [ Error("Unexpected token: " + (sprintf "%A" wrong)) ] }
107 | 
108 |     let tryParse (tokens: Token list): ParseResult =
109 |         parseLine { Lines = []; Locals = Set.empty } tokens 
110 | 
111 |     let errorMessagesFor expr = 
112 |         let rec errorMessagesForImpl acc = function 
113 |             | Minus  expr                -> acc @ errorMessagesForImpl acc expr 
114 |             | Assign (name, value)       -> acc @ errorMessagesForImpl acc value @ errorMessagesForImpl acc name
115 |             | Binary (left, oper, right) -> acc @ errorMessagesForImpl acc right @ errorMessagesForImpl acc left
116 |             | Error  message          -> [message]
117 |             | Number   _ 
118 |             | Variable _ 
119 |             | Invoke   _                 -> acc
120 |         errorMessagesForImpl [] expr
121 | 
122 |     let errorsForLines (lines: Expr list) =
123 |         List.collect errorMessagesFor lines
124 |         
125 |     let parse (tokens: Token list): Result<ParseResult, string> = 
126 |         let result = tryParse tokens
127 |         match errorsForLines result.Lines with
128 |         | []     -> Success(result)
129 |         | errors -> Failure(System.String.Join(System.Environment.NewLine, errors))


--------------------------------------------------------------------------------
/Lbac.Compiler/IL.fs:
--------------------------------------------------------------------------------
  1 | module IL
  2 |     open System
  3 |     open System.Reflection
  4 |     open System.Reflection.Emit
  5 | 
  6 |     type instruction = 
  7 |         | Add 
  8 |         | Call         of System.Reflection.MethodInfo
  9 |         | Callvirt     of System.Reflection.MethodInfo
 10 |         | DeclareLocal of System.Type
 11 |         | Div
 12 |         | Ldc_I4       of int
 13 |         | Ldc_I4_0
 14 |         | Ldc_I4_1
 15 |         | Ldc_I4_2
 16 |         | Ldc_I4_3
 17 |         | Ldc_I4_4
 18 |         | Ldc_I4_5
 19 |         | Ldc_I4_6
 20 |         | Ldc_I4_7
 21 |         | Ldc_I4_8
 22 |         | Ldloc        of int
 23 |         | Ldloc_0
 24 |         | Ldloc_1
 25 |         | Ldloc_2
 26 |         | Ldloc_3
 27 |         | Ldloc_S      of byte
 28 |         | Mul
 29 |         | Neg
 30 |         | Newobj       of System.Reflection.ConstructorInfo
 31 |         | Nop
 32 |         | Pop
 33 |         | Refanyval
 34 |         | Ret
 35 |         | Stloc        of int
 36 |         | Stloc_0
 37 |         | Stloc_1
 38 |         | Stloc_2
 39 |         | Stloc_3
 40 |         | Stloc_S      of byte
 41 |         | Sub
 42 | 
 43 |     type Method = { Instructions: instruction list; Locals: string list } 
 44 |      
 45 |     let private emit (ilg : Emit.ILGenerator) inst = 
 46 |         match inst with 
 47 |         | Add            -> ilg.Emit(OpCodes.Add)
 48 |         | Call mi        -> ilg.Emit(OpCodes.Call, mi)
 49 |         | Callvirt mi    -> ilg.Emit(OpCodes.Callvirt, mi)
 50 |         | DeclareLocal t -> ignore(ilg.DeclareLocal(t))
 51 |         | Div            -> ilg.Emit(OpCodes.Div)
 52 |         | Ldc_I4 n       -> ilg.Emit(OpCodes.Ldc_I4, n)
 53 |         | Ldc_I4_0       -> ilg.Emit(OpCodes.Ldc_I4_0)
 54 |         | Ldc_I4_1       -> ilg.Emit(OpCodes.Ldc_I4_1)
 55 |         | Ldc_I4_2       -> ilg.Emit(OpCodes.Ldc_I4_2)
 56 |         | Ldc_I4_3       -> ilg.Emit(OpCodes.Ldc_I4_3)
 57 |         | Ldc_I4_4       -> ilg.Emit(OpCodes.Ldc_I4_4)
 58 |         | Ldc_I4_5       -> ilg.Emit(OpCodes.Ldc_I4_5)
 59 |         | Ldc_I4_6       -> ilg.Emit(OpCodes.Ldc_I4_6)
 60 |         | Ldc_I4_7       -> ilg.Emit(OpCodes.Ldc_I4_7)
 61 |         | Ldc_I4_8       -> ilg.Emit(OpCodes.Ldc_I4_8)
 62 |         | Ldloc    i     -> ilg.Emit(OpCodes.Ldloc, i)
 63 |         | Ldloc_0        -> ilg.Emit(OpCodes.Ldloc_0)
 64 |         | Ldloc_1        -> ilg.Emit(OpCodes.Ldloc_1)
 65 |         | Ldloc_2        -> ilg.Emit(OpCodes.Ldloc_2)
 66 |         | Ldloc_3        -> ilg.Emit(OpCodes.Ldloc_3)
 67 |         | Ldloc_S  i     -> ilg.Emit(OpCodes.Ldloc_S, i)
 68 |         | Mul            -> ilg.Emit(OpCodes.Mul)
 69 |         | Neg            -> ilg.Emit(OpCodes.Neg)
 70 |         | Newobj   ci    -> ilg.Emit(OpCodes.Newobj, ci)
 71 |         | Nop            -> ilg.Emit(OpCodes.Nop)
 72 |         | Pop            -> ilg.Emit(OpCodes.Pop)
 73 |         | Refanyval      -> ilg.Emit(OpCodes.Refanyval)
 74 |         | Ret            -> ilg.Emit(OpCodes.Ret)
 75 |         | Stloc    i     -> ilg.Emit(OpCodes.Stloc, i)
 76 |         | Stloc_0        -> ilg.Emit(OpCodes.Stloc_0)
 77 |         | Stloc_1        -> ilg.Emit(OpCodes.Stloc_1)
 78 |         | Stloc_2        -> ilg.Emit(OpCodes.Stloc_2)
 79 |         | Stloc_3        -> ilg.Emit(OpCodes.Stloc_3)
 80 |         | Stloc_S  i     -> ilg.Emit(OpCodes.Stloc_S, i)
 81 |         | Sub            -> ilg.Emit(OpCodes.Sub)
 82 | 
 83 |     let private compileEntryPoint (moduleContainingMethod : ModuleBuilder) (methodToCall: MethodBuilder) = 
 84 |         let mb = 
 85 |             let tb = 
 86 |                 let className = "Program"
 87 |                 let ta = TypeAttributes.NotPublic ||| TypeAttributes.AutoLayout ||| TypeAttributes.AnsiClass ||| TypeAttributes.BeforeFieldInit
 88 |                 moduleContainingMethod.DefineType(className, ta)
 89 |             let ma = MethodAttributes.Public ||| MethodAttributes.Static 
 90 |             let methodName = "Main"
 91 |             tb.DefineMethod(methodName, ma)
 92 |         let ilg = mb.GetILGenerator() |> emit
 93 |         let ci = methodToCall.ReflectedType.GetConstructor([||])
 94 |         ilg (Newobj ci)
 95 |         ilg (Call methodToCall)
 96 |         if methodToCall.ReturnType <> null then
 97 |             ilg (DeclareLocal methodToCall.ReturnType)
 98 |             ilg Stloc_0
 99 |             ilg (Ldloc_S 0uy)
100 |             let mi = methodToCall.ReturnType.GetMethod("ToString", [||])
101 |             ilg (Call mi)
102 |             let writeln = typeof<System.Console>.GetMethod("WriteLine", [| typeof<System.String> |])
103 |             ilg (Call writeln)
104 |         ilg Ret
105 |         mb
106 | 
107 |     let private entryPointMethodName = "__Main"
108 | 
109 |     let compileMethod(moduleName: string) (instructions: seq<instruction>) (methodResultType) =
110 |         let assemblyBuilder = 
111 |             let assemblyName = AssemblyName(moduleName)
112 |             AppDomain.CurrentDomain.DefineDynamicAssembly(assemblyName, AssemblyBuilderAccess.RunAndSave)
113 |         let moduleBuilder = assemblyBuilder.DefineDynamicModule(moduleName)
114 |         let typeBuilder = 
115 |             let className = "__CompiledMethods"
116 |             let typeAttributes = TypeAttributes.Public ||| TypeAttributes.AutoLayout ||| TypeAttributes.AnsiClass ||| TypeAttributes.BeforeFieldInit
117 |             moduleBuilder.DefineType(className, typeAttributes)
118 |         let methodBuilder = 
119 |             let methodAttributes = MethodAttributes.Public ||| MethodAttributes.HideBySig
120 |             typeBuilder.DefineMethod(entryPointMethodName, methodAttributes, methodResultType, System.Type.EmptyTypes)
121 |         let ilg = methodBuilder.GetILGenerator() |> emit
122 |         Seq.iter ilg instructions 
123 |         ilg Ret
124 |         
125 |         let entryPointType = typeBuilder.CreateType()
126 |         let entryPoint = compileEntryPoint moduleBuilder methodBuilder
127 |         assemblyBuilder.SetEntryPoint(entryPoint, PEFileKinds.ConsoleApplication)
128 |         moduleBuilder.CreateGlobalFunctions()
129 |         (entryPointType, assemblyBuilder)
130 | 
131 |     let toMethod resultType methodWithInstructions =
132 |         let moduleName = "test.exe"
133 |         let (t, _) = compileMethod moduleName methodWithInstructions.Instructions resultType
134 |         t.GetMethod(entryPointMethodName)
135 | 
136 |     let execute<'TMethodResultType> (instructions, saveAs) =
137 |         let moduleName = match saveAs with
138 |                          | Some s -> s
139 |                          | None   -> "test.exe"
140 |         let (entryPointType, assemblyBuilder) = compileMethod moduleName instructions typeof<'TMethodResultType>
141 |         if saveAs.IsSome then 
142 |             assemblyBuilder.Save(entryPointType.Module.ScopeName)
143 |         let instance = Activator.CreateInstance(entryPointType)
144 |         entryPointType.GetMethod(entryPointMethodName).Invoke(instance, null) :?> 'TMethodResultType
145 | 
146 |     let print (instructions: seq<instruction>) =
147 |         let p = sprintf "%A"
148 |         Seq.map p instructions        


--------------------------------------------------------------------------------
/Lbac.Compiler/Arg.fs:
--------------------------------------------------------------------------------
  1 | // This file is from the F# PowerPack, which is licensed under the Apache license.
  2 | // Original source: http://fsharppowerpack.codeplex.com/SourceControl/changeset/view/66957#685014
  3 | // See http://fsharppowerpack.codeplex.com/license, or scroll to end of file for full license
  4 | 
  5 | // (c) Microsoft Corporation 2005-2009. 
  6 | 
  7 | #if INTERNALIZED_POWER_PACK
  8 | namespace Internal.Utilities
  9 | #else
 10 | namespace Microsoft.FSharp.Text
 11 | #endif
 12 | 
 13 | 
 14 | type ArgType = 
 15 |  | ClearArg of bool ref
 16 |  | FloatArg of (float -> unit)
 17 |  | IntArg of (int -> unit)
 18 |  | RestArg of (string -> unit)
 19 |  | SetArg of bool ref
 20 |  | StringArg of (string -> unit)
 21 |  | UnitArg of (unit -> unit)
 22 |  static member Clear  r = ClearArg r
 23 |  static member Float  r = FloatArg r
 24 |  static member Int    r = IntArg r
 25 |  static member Rest   r = RestArg r
 26 |  static member Set    r = SetArg r
 27 |  static member String r = StringArg r
 28 |  static member Unit   r = UnitArg r
 29 | 
 30 | 
 31 | type ArgInfo (name,action,help) = 
 32 |  member x.Name = name
 33 |  member x.ArgType = action
 34 |  member x.HelpText = help
 35 |  
 36 | exception Bad of string
 37 | exception HelpText of string
 38 | 
 39 | [<Sealed>]
 40 | type ArgParser() = 
 41 |    static let getUsage specs u =  
 42 |      let sbuf = new System.Text.StringBuilder 100  
 43 |      let pstring (s:string) = sbuf.Append s |> ignore 
 44 |      let pendline s = pstring s; pstring "\n" 
 45 |      pendline u;
 46 |      List.iter (fun (arg:ArgInfo) -> 
 47 |        match arg.Name, arg.ArgType, arg.HelpText with
 48 |        | (s, (UnitArg _ | SetArg _ | ClearArg _), helpText) -> pstring "\t"; pstring s; pstring ": "; pendline helpText
 49 |        | (s, StringArg _, helpText) -> pstring "\t"; pstring s; pstring " <string>: "; pendline helpText
 50 |        | (s, IntArg _, helpText) -> pstring "\t"; pstring s; pstring " <int>: "; pendline helpText
 51 |        | (s, FloatArg _, helpText) ->  pstring "\t"; pstring s; pstring " <float>: "; pendline helpText
 52 |        | (s, RestArg _, helpText) -> pstring "\t"; pstring s; pstring " ...: "; pendline helpText)
 53 |        specs;
 54 |      pstring "\t"; pstring "--help"; pstring ": "; pendline "display this list of options";
 55 |      pstring "\t"; pstring "-help"; pstring ": "; pendline "display this list of options";
 56 |      sbuf.ToString()
 57 | 
 58 | 
 59 |    static member ParsePartial(cursor,argv,argSpecs:seq<ArgInfo>,?other,?usageText) =
 60 |        let other = defaultArg other (fun _ -> ())
 61 |        let usageText = defaultArg usageText ""
 62 |        let nargs = Array.length argv 
 63 |        incr cursor;
 64 |        let argSpecs = argSpecs |> Seq.toList
 65 |        let specs = argSpecs |> List.map (fun (arg:ArgInfo) -> arg.Name, arg.ArgType)
 66 |        while !cursor < nargs do
 67 |          let arg = argv.[!cursor] 
 68 |          let rec findMatchingArg args = 
 69 |            match args with
 70 |            | ((s, action) :: _) when s = arg -> 
 71 |               let getSecondArg () = 
 72 |                   if !cursor + 1 >= nargs then 
 73 |                     raise(Bad("option "+s+" needs an argument.\n"+getUsage argSpecs usageText));
 74 |                   argv.[!cursor+1] 
 75 |                 
 76 |               match action with 
 77 |               | UnitArg f -> 
 78 |                 f (); 
 79 |                 incr cursor
 80 |               | SetArg f ->
 81 |                 f := true; 
 82 |                 incr cursor
 83 |               | ClearArg f -> 
 84 |                 f := false; 
 85 |                 incr cursor
 86 |               | StringArg f-> 
 87 |                 let arg2 = getSecondArg() 
 88 |                 f arg2; 
 89 |                 cursor := !cursor + 2
 90 |               | IntArg f -> 
 91 |                 let arg2 = getSecondArg () 
 92 |                 let arg2 = try int32 arg2 with _ -> raise(Bad(getUsage argSpecs usageText)) in  
 93 |                 f arg2;
 94 |                 cursor := !cursor + 2;
 95 |               | FloatArg f -> 
 96 |                 let arg2 = getSecondArg() 
 97 |                 let arg2 = try float arg2 with _ -> raise(Bad(getUsage argSpecs usageText)) in 
 98 |                 f arg2; 
 99 |                 cursor := !cursor + 2;
100 |               | RestArg f -> 
101 |                 incr cursor;
102 |                 while !cursor < nargs do
103 |                     f (argv.[!cursor]);
104 |                     incr cursor;
105 | 
106 |            | (_ :: more)  -> findMatchingArg more 
107 |            | [] -> 
108 |                if arg = "-help" || arg = "--help" || arg = "/help" || arg = "/help" || arg = "/?" then
109 |                    raise (HelpText (getUsage argSpecs usageText))
110 |                // Note: for '/abc/def' does not count as an argument
111 |                // Note: '/abc' does
112 |                elif arg.Length>0 && (arg.[0] = '-' || (arg.[0] = '/' && not (arg.Length > 1 && arg.[1..].Contains ("/")))) then
113 |                    raise (Bad ("unrecognized argument: "+ arg + "\n" + getUsage argSpecs usageText))
114 |                else 
115 |                   other arg;
116 |                   incr cursor
117 |          findMatchingArg specs 
118 | 
119 |    static member Usage (specs,?usage) = 
120 |        let usage = defaultArg usage ""
121 |        System.Console.Error.WriteLine (getUsage (Seq.toList specs) usage)
122 | 
123 |    #if FX_NO_COMMAND_LINE_ARGS
124 |    #else
125 |    static member Parse (specs,?other,?usageText) = 
126 |        let current = ref 0
127 |        let argv = System.Environment.GetCommandLineArgs() 
128 |        try ArgParser.ParsePartial (current, argv, specs, ?other=other, ?usageText=usageText)
129 |        with 
130 |          | Bad h 
131 |          | HelpText h -> 
132 |              System.Console.Error.WriteLine h; 
133 |              System.Console.Error.Flush();  
134 |              System.Environment.Exit(1); 
135 |          | e -> 
136 |              reraise()
137 |    #endif
138 | 
139 | (*
140 | Apache License
141 | Version 2.0, January 2004
142 | http://www.apache.org/licenses/
143 | 
144 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
145 | 
146 | 1. Definitions.
147 | 
148 | "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document.
149 | 
150 | "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License.
151 | 
152 | "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity.
153 | 
154 | "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License.
155 | 
156 | "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files.
157 | 
158 | "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types.
159 | 
160 | "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below).
161 | 
162 | "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof.
163 | 
164 | "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution."
165 | 
166 | "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work.
167 | 
168 | 2. Grant of Copyright License.
169 | 
170 | Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form.
171 | 
172 | 3. Grant of Patent License.
173 | 
174 | Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed.
175 | 
176 | 4. Redistribution.
177 | 
178 | You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions:
179 | 
180 | 1. You must give any other recipients of the Work or Derivative Works a copy of this License; and
181 | 
182 | 2. You must cause any modified files to carry prominent notices stating that You changed the files; and
183 | 
184 | 3. You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and
185 | 
186 | 4. If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License.
187 | 
188 | You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License.
189 | 
190 | 5. Submission of Contributions.
191 | 
192 | Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions.
193 | 
194 | 6. Trademarks.
195 | 
196 | This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file.
197 | 
198 | 7. Disclaimer of Warranty.
199 | 
200 | Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License.
201 | 
202 | 8. Limitation of Liability.
203 | 
204 | In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages.
205 | 
206 | 9. Accepting Warranty or Additional Liability.
207 | 
208 | While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability.
209 | *)


--------------------------------------------------------------------------------