Initial WIP commit

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