Initial WIP commit

.config/dotnet-tools.json

@@ -0,0 +1,18 @@
+{
+  "version": 1,
+  "isRoot": true,
+  "tools": {
+    "fantomas": {
+      "version": "6.3.0-alpha-005",
+      "commands": [
+        "fantomas"
+      ]
+    },
+    "fsharp-analyzers": {
+      "version": "0.23.0",
+      "commands": [
+        "fsharp-analyzers"
+      ]
+    }
+  }
+}

.editorconfig

@@ -0,0 +1,41 @@
+root=true
+
+[*]
+charset=utf-8
+end_of_line=crlf
+trim_trailing_whitespace=true
+insert_final_newline=true
+indent_style=space
+indent_size=4
+
+# ReSharper properties
+resharper_xml_indent_size=2
+resharper_xml_max_line_length=100
+resharper_xml_tab_width=2
+
+[*.{csproj,fsproj,sqlproj,targets,props,ts,tsx,css,json}]
+indent_style=space
+indent_size=2
+
+[*.{fs,fsi}]
+fsharp_bar_before_discriminated_union_declaration=true
+fsharp_space_before_uppercase_invocation=true
+fsharp_space_before_class_constructor=true
+fsharp_space_before_member=true
+fsharp_space_before_colon=true
+fsharp_space_before_semicolon=true
+fsharp_multiline_bracket_style=aligned
+fsharp_newline_between_type_definition_and_members=true
+fsharp_align_function_signature_to_indentation=true
+fsharp_alternative_long_member_definitions=true
+fsharp_multi_line_lambda_closing_newline=true
+fsharp_experimental_keep_indent_in_branch=true
+fsharp_max_value_binding_width=80
+fsharp_max_record_width=0
+max_line_length=120
+end_of_line=lf
+
+[*.{appxmanifest,build,dtd,nuspec,xaml,xamlx,xoml,xsd}]
+indent_style=space
+indent_size=2
+tab_width=2

.gitignore

@@ -0,0 +1,7 @@
+bin/
+obj/
+/packages/
+riderModule.iml
+/_ReSharper.Caches/
+.idea/
+*.DotSettings.*

PrattParser.Test/PrattParser.Test.fsproj

@@ -0,0 +1,27 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <TargetFramework>net8.0</TargetFramework>
+
+        <IsPackable>false</IsPackable>
+        <IsPublishable>false</IsPublishable>
+        <IsTestProject>true</IsTestProject>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="TestLexer.fs" />
+    </ItemGroup>
+
+    <ItemGroup>
+        <PackageReference Include="FsUnit" Version="6.0.0" />
+        <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.8.0"/>
+        <PackageReference Include="NUnit" Version="4.0.1"/>
+        <PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
+        <PackageReference Include="coverlet.collector" Version="6.0.0"/>
+    </ItemGroup>
+
+    <ItemGroup>
+      <ProjectReference Include="..\PrattParser\PrattParser.fsproj" />
+    </ItemGroup>
+
+</Project>

PrattParser.Test/TestLexer.fs

@@ -0,0 +1,66 @@
+namespace PrattParser.Test
+
+open PrattParser
+open NUnit.Framework
+open FsUnitTyped
+
+[<TestFixture>]
+module TestLexer =
+
+    [<Test>]
+    let ``Lexer looks plausible`` () =
+        let input = "g x y + a * func (b + 100)"
+
+        let expected =
+            [
+                {
+                    Type = TokenType.Var
+                    Trivia = (0, 1)
+                }
+                {
+                    Type = TokenType.Var
+                    Trivia = (2, 1)
+                }
+                {
+                    Type = TokenType.Var
+                    Trivia = (4, 1)
+                }
+                {
+                    Type = TokenType.Plus
+                    Trivia = (6, 1)
+                }
+                {
+                    Type = TokenType.Var
+                    Trivia = (8, 1)
+                }
+                {
+                    Type = TokenType.Times
+                    Trivia = (10, 1)
+                }
+                {
+                    Type = TokenType.Var
+                    Trivia = (12, 4)
+                }
+                {
+                    Type = TokenType.LeftBracket
+                    Trivia = (17, 1)
+                }
+                {
+                    Type = TokenType.Var
+                    Trivia = (18, 1)
+                }
+                {
+                    Type = TokenType.Plus
+                    Trivia = (20, 1)
+                }
+                {
+                    Type = TokenType.ConstInt
+                    Trivia = (22, 3)
+                }
+                {
+                    Type = TokenType.RightBracket
+                    Trivia = (25, 1)
+                }
+            ]
+
+        Lexer.lex input |> shouldEqual expected

PrattParser.sln

@@ -0,0 +1,22 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "PrattParser", "PrattParser\PrattParser.fsproj", "{C8FBFA6B-2195-4350-BD05-709476A278D9}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "PrattParser.Test", "PrattParser.Test\PrattParser.Test.fsproj", "{7317F801-6AB2-4C33-B6B2-DCB006880B42}"
+EndProject
+Global
+	GlobalSection(SolutionConfigurationPlatforms) = preSolution
+		Debug|Any CPU = Debug|Any CPU
+		Release|Any CPU = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(ProjectConfigurationPlatforms) = postSolution
+		{C8FBFA6B-2195-4350-BD05-709476A278D9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{C8FBFA6B-2195-4350-BD05-709476A278D9}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{C8FBFA6B-2195-4350-BD05-709476A278D9}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{C8FBFA6B-2195-4350-BD05-709476A278D9}.Release|Any CPU.Build.0 = Release|Any CPU
+		{7317F801-6AB2-4C33-B6B2-DCB006880B42}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{7317F801-6AB2-4C33-B6B2-DCB006880B42}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{7317F801-6AB2-4C33-B6B2-DCB006880B42}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{7317F801-6AB2-4C33-B6B2-DCB006880B42}.Release|Any CPU.Build.0 = Release|Any CPU
+	EndGlobalSection
+EndGlobal

PrattParser/Domain.fs

@@ -0,0 +1,59 @@
+namespace PrattParser
+
+[<RequireQualifiedAccess>]
+type Expr =
+    | Plus of Expr * Expr
+    | Times of Expr * Expr
+    | UnaryMinus of Expr
+    | Int of int
+    | FunctionCall of Expr * Expr
+    | Var of string
+
+[<RequireQualifiedAccess>]
+module Expr =
+    let plus a b = Expr.Plus (a, b)
+    let times a b = Expr.Times (a, b)
+    let unaryMinus a = Expr.UnaryMinus a
+    let constInt a = Expr.Int a
+    let functionCall f x = Expr.FunctionCall (f, x)
+    let var name = Expr.Var name
+
+[<RequireQualifiedAccess>]
+type TokenType =
+    | Plus
+    | Minus
+    | Times
+    | ConstInt
+    | LeftBracket
+    | RightBracket
+    | Var
+
+type Token =
+    {
+        Type : TokenType
+        /// The token is represented in the string as s.[left .. left + len], i.e. inclusive.
+        Trivia : int * int
+    }
+
+[<RequireQualifiedAccess>]
+module Token =
+    let standalone (ty : TokenType) (left : int) (len : int) =
+        {
+            Type = ty
+            Trivia = (left, len)
+        }
+
+    let standalone' (ty : TokenType) (singleCharPos : int) =
+        {
+            Type = ty
+            Trivia = (singleCharPos, 1)
+        }
+
+    let (|SingleChar|_|) (i : int, c : char) : Token option =
+        match c with
+        | '(' -> standalone' TokenType.LeftBracket i |> Some
+        | ')' -> standalone' TokenType.RightBracket i |> Some
+        | '*' -> standalone' TokenType.Times i |> Some
+        | '+' -> standalone' TokenType.Plus i |> Some
+        | '-' -> standalone' TokenType.Minus i |> Some
+        | _ -> None

PrattParser/Lexer.fs

@@ -0,0 +1,47 @@
+namespace PrattParser
+
+[<RequireQualifiedAccess>]
+module Lexer =
+    let private (|Digit|_|) (c : char) : byte option =
+        if '0' <= c && c <= '9' then
+            Some (byte c - byte '0')
+        else
+            None
+
+    let lex (s : string) : Token seq =
+        seq {
+            let mutable i = 0
+
+            while i < s.Length do
+                match i, s.[i] with
+                | Token.SingleChar token ->
+                    i <- i + 1
+                    yield token
+                | startI, Digit _ ->
+                    i <- i + 1
+                    let mutable shouldBreak = false
+
+                    while not shouldBreak do
+                        match s.[i] with
+                        | Digit _ -> i <- i + 1
+                        | _ -> shouldBreak <- true
+
+                    yield Token.standalone TokenType.ConstInt startI (i - startI)
+                | _, ' ' -> i <- i + 1
+                | startI, c ->
+                    if ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z') then
+                        i <- i + 1
+                        let mutable shouldBreak = false
+
+                        while not shouldBreak do
+                            let c = s.[i]
+
+                            if ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z') || ('0' <= c && c <= '9') then
+                                i <- i + 1
+                            else
+                                shouldBreak <- true
+
+                        yield Token.standalone TokenType.Var startI (i - startI)
+                    else
+                        failwithf "Could not tokenize, char %c, at position %i" c startI
+        }

PrattParser/PrattParser.fsproj

@@ -0,0 +1,13 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <TargetFramework>net8.0</TargetFramework>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="Domain.fs" />
+        <Compile Include="Lexer.fs" />
+        <None Include="Program.fs"/>
+    </ItemGroup>
+
+</Project>

PrattParser/Program.fs

@@ -0,0 +1,95 @@
+namespace PrattParser
+
+open System.Collections.Generic
+
+type Parser<'parser> = 'parser -> Token -> Expr option
+
+type ParserSpec<'parser> =
+    private
+        {
+            Prefixes : (Token -> Parser<'parser> option) list
+        }
+
+[<RequireQualifiedAccess>]
+module ParserSpec =
+    let empty<'parser> () =
+        {
+            Prefixes = []
+        }
+
+    // TODO this is essentially duplicated which is a bit sad
+    let private processPrefix (prefixOperation : Token) (operand : Expr) : Expr =
+        match prefixOperation with
+        | Token.Minus -> Expr.unaryMinus operand
+        | token -> failwithf "logic error, this should not have happened: %+A, %+A" token operand
+
+    let addPrefixParser<'parser> (input : Token) (spec : ParserSpec<'parser>) =
+        let parser (token : Token) =
+            if token = input then
+                Some (fun parser processPrefix token )
+            else
+                None
+        { spec with
+            Prefixes = parser :: spec.Prefixes
+        }
+
+[<RequireQualifiedAccess>]
+module Parse =
+
+    /// Takes the current token.
+    let prefixParser (parse : 'parser -> Expr) (toMatch : Token) : Parser<'parser> =
+        fun parser token ->
+            if token = toMatch then
+                let operand = parse parser
+                Some (processPrefix token operand)
+            else None
+
+    let varParser (parse : 'parser -> Expr) (toMatch : Token) : Parser<'parser> =
+        fun _ token ->
+            match token with
+            | Token.Var x -> Some (Expr.Var x)
+            | _ -> None
+
+    let parserLookup (token : Token) (parser : ParserSpec<'parser>) : Parser<'parser> option =
+        match parser.Prefixes token with
+        | Some parser -> Some parser
+        | None -> None
+
+    let parserSpec =
+        ParserSpec.empty ()
+        |> ParserSpec.addPrefixParser Token.Minus
+
+    let parseExpression (tokens : Token IEnumerator) : Expr =
+        let token = tokens.MoveNext ()
+
+module Program =
+
+    [<EntryPoint>]
+    let main argv =
+        // g x y + a * f (b + c)
+        let tokens =
+            [
+                Token.Var "g"
+                Token.Var "x"
+                Token.Var "y"
+                Token.Plus
+                Token.Var "a"
+                Token.Times
+                Token.Var "f"
+                Token.LeftBracket
+                Token.Var "b"
+                Token.Plus
+                Token.Var "c"
+                Token.RightBracket
+            ]
+
+        let expected =
+            let gXY =
+                Expr.functionCall (Expr.functionCall (Expr.var "g") (Expr.var "x")) (Expr.var "y")
+
+            let fAPlusB =
+                Expr.functionCall (Expr.Var "f") (Expr.plus (Expr.Var "b") (Expr.Var "c"))
+
+            Expr.plus gXY (Expr.times (Expr.Var "a") fAPlusB)
+
+        0