mirror of
https://github.com/Smaug123/WoofWare.PrattParser
synced 2025-10-06 09:58:40 +00:00
More implemented
This commit is contained in:
Smaug123
@@ -1,27 +1,28 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
|
||||
<IsPackable>false</IsPackable>
|
||||
<IsPublishable>false</IsPublishable>
|
||||
<IsTestProject>true</IsTestProject>
|
||||
</PropertyGroup>
|
||||
<IsPackable>false</IsPackable>
|
||||
<IsPublishable>false</IsPublishable>
|
||||
<IsTestProject>true</IsTestProject>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="TestLexer.fs" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<Compile Include="TestLexer.fs"/>
|
||||
<Compile Include="TestParser.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>
|
||||
<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>
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\PrattParser\PrattParser.fsproj"/>
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
||||
@@ -9,7 +9,7 @@ module TestLexer =
|
||||
|
||||
[<Test>]
|
||||
let ``Lexer looks plausible`` () =
|
||||
let input = "g x y + a * func (b + 100)"
|
||||
let input = "g x y! + a * func (b + 100)"
|
||||
|
||||
let expected =
|
||||
[
|
||||
@@ -25,41 +25,45 @@ module TestLexer =
|
||||
Type = TokenType.Var
|
||||
Trivia = (4, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.Factorial
|
||||
Trivia = (5, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.Plus
|
||||
Trivia = (6, 1)
|
||||
Trivia = (7, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.Var
|
||||
Trivia = (8, 1)
|
||||
Trivia = (9, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.Times
|
||||
Trivia = (10, 1)
|
||||
Trivia = (11, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.Var
|
||||
Trivia = (12, 4)
|
||||
Trivia = (13, 4)
|
||||
}
|
||||
{
|
||||
Type = TokenType.LeftBracket
|
||||
Trivia = (17, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.Var
|
||||
Trivia = (18, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.Var
|
||||
Trivia = (19, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.Plus
|
||||
Trivia = (20, 1)
|
||||
Trivia = (21, 1)
|
||||
}
|
||||
{
|
||||
Type = TokenType.ConstInt
|
||||
Trivia = (22, 3)
|
||||
Trivia = (23, 3)
|
||||
}
|
||||
{
|
||||
Type = TokenType.RightBracket
|
||||
Trivia = (25, 1)
|
||||
Trivia = (26, 1)
|
||||
}
|
||||
]
|
||||
|
||||
|
||||
39
PrattParser.Test/TestParser.fs
Normal file
39
PrattParser.Test/TestParser.fs
Normal file
@@ -0,0 +1,39 @@
|
||||
namespace PrattParser.Test
|
||||
|
||||
open PrattParser
|
||||
open NUnit.Framework
|
||||
open FsUnitTyped
|
||||
|
||||
[<TestFixture>]
|
||||
module TestParser =
|
||||
|
||||
let parserTestCases =
|
||||
[
|
||||
"1", Expr.constInt 1
|
||||
"a", Expr.var "a"
|
||||
"-1", Expr.unaryMinus (Expr.constInt 1)
|
||||
"-a", Expr.unaryMinus (Expr.var "a")
|
||||
"-a!", Expr.unaryMinus (Expr.factorial (Expr.var "a"))
|
||||
"-a! + b", Expr.plus (Expr.unaryMinus (Expr.factorial (Expr.var "a"))) (Expr.var "b")
|
||||
"(-a)! + b", Expr.plus (Expr.factorial (Expr.paren (Expr.unaryMinus (Expr.var "a")))) (Expr.var "b")
|
||||
// TODO: if-then-else
|
||||
|
||||
"g x y + a * (func b c)",
|
||||
let gXY =
|
||||
Expr.functionCall (Expr.functionCall (Expr.var "g") (Expr.var "x")) (Expr.var "y")
|
||||
|
||||
let fAPlusB =
|
||||
Expr.functionCall (Expr.Var "func") (Expr.plus (Expr.Var "b") (Expr.Var "c"))
|
||||
|
||||
Expr.plus gXY (Expr.times (Expr.Var "a") fAPlusB)
|
||||
|
||||
]
|
||||
|> List.map TestCaseData
|
||||
|
||||
[<TestCaseSource(nameof parserTestCases)>]
|
||||
let ``Parser looks plausible`` (input : string, expected : Expr) =
|
||||
let tokens = Lexer.lex input |> List.ofSeq
|
||||
|
||||
let expr, remaining = Parser.parse input tokens
|
||||
expr |> shouldEqual expected
|
||||
remaining |> shouldEqual []
|
||||
@@ -5,18 +5,28 @@ type Expr =
|
||||
| Plus of Expr * Expr
|
||||
| Times of Expr * Expr
|
||||
| UnaryMinus of Expr
|
||||
| Minus of Expr * Expr
|
||||
| Int of int
|
||||
| FunctionCall of Expr * Expr
|
||||
| Var of string
|
||||
| Factorial of Expr
|
||||
| Paren of Expr
|
||||
| IfThenElse of Expr * Expr * Expr
|
||||
|
||||
[<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 minus a b = Expr.Minus (a, b)
|
||||
let constInt a = Expr.Int a
|
||||
let functionCall f x = Expr.FunctionCall (f, x)
|
||||
let var name = Expr.Var name
|
||||
let factorial a = Expr.Factorial a
|
||||
let paren a = Expr.Paren a
|
||||
|
||||
let ifThenElse ifClause thenClause elseClause =
|
||||
Expr.IfThenElse (ifClause, thenClause, elseClause)
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
type TokenType =
|
||||
@@ -27,6 +37,10 @@ type TokenType =
|
||||
| LeftBracket
|
||||
| RightBracket
|
||||
| Var
|
||||
| Factorial
|
||||
| If
|
||||
| Then
|
||||
| Else
|
||||
|
||||
type Token =
|
||||
{
|
||||
@@ -56,4 +70,23 @@ module Token =
|
||||
| '*' -> standalone' TokenType.Times i |> Some
|
||||
| '+' -> standalone' TokenType.Plus i |> Some
|
||||
| '-' -> standalone' TokenType.Minus i |> Some
|
||||
| '!' -> standalone' TokenType.Factorial i |> Some
|
||||
| _ -> None
|
||||
|
||||
let infixPrecedence (token : TokenType) : (int * int) option =
|
||||
match token with
|
||||
| TokenType.Plus
|
||||
| TokenType.Minus -> Some (1, 2)
|
||||
| TokenType.Times -> Some (3, 4)
|
||||
| _ -> None
|
||||
|
||||
let prefixPrecedence (token : TokenType) : (unit * int) option =
|
||||
match token with
|
||||
| TokenType.Plus
|
||||
| TokenType.Minus -> Some ((), 5)
|
||||
| _ -> None
|
||||
|
||||
let postfixPrecedence (token : TokenType) : (int * unit) option =
|
||||
match token with
|
||||
| TokenType.Factorial -> Some (7, ())
|
||||
| _ -> None
|
||||
|
||||
@@ -21,19 +21,28 @@ module Lexer =
|
||||
i <- i + 1
|
||||
let mutable shouldBreak = false
|
||||
|
||||
while not shouldBreak do
|
||||
while i < s.Length && not shouldBreak do
|
||||
match s.[i] with
|
||||
| Digit _ -> i <- i + 1
|
||||
| _ -> shouldBreak <- true
|
||||
|
||||
yield Token.standalone TokenType.ConstInt startI (i - startI)
|
||||
| _, ' ' -> i <- i + 1
|
||||
| _, 'i' when i < s.Length - 1 && s.[i + 1] = 'f' ->
|
||||
yield Token.standalone TokenType.If i 2
|
||||
i <- i + 2
|
||||
| _, 't' when i < s.Length - 3 && s.[i + 1 .. i + 3] = "hen" ->
|
||||
yield Token.standalone TokenType.Then i 4
|
||||
i <- i + 4
|
||||
| _, 'e' when i < s.Length - 3 && s.[i + 1 .. i + 3] = "lse" ->
|
||||
yield Token.standalone TokenType.Else i 4
|
||||
i <- i + 4
|
||||
| startI, c ->
|
||||
if ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z') then
|
||||
i <- i + 1
|
||||
let mutable shouldBreak = false
|
||||
|
||||
while not shouldBreak do
|
||||
while i < s.Length && not shouldBreak do
|
||||
let c = s.[i]
|
||||
|
||||
if ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z') || ('0' <= c && c <= '9') then
|
||||
|
||||
116
PrattParser/Parser.fs
Normal file
116
PrattParser/Parser.fs
Normal file
@@ -0,0 +1,116 @@
|
||||
namespace PrattParser
|
||||
|
||||
open System
|
||||
open System.Globalization
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Parser =
|
||||
let atom (inputString : string) (token : Token) : Expr option =
|
||||
match token.Type with
|
||||
| TokenType.ConstInt ->
|
||||
let start, len = token.Trivia
|
||||
|
||||
Some (
|
||||
Expr.constInt (
|
||||
Int32.Parse (
|
||||
inputString.AsSpan().Slice (start, len),
|
||||
NumberStyles.None,
|
||||
CultureInfo.InvariantCulture
|
||||
)
|
||||
)
|
||||
)
|
||||
| TokenType.Var ->
|
||||
let start, len = token.Trivia
|
||||
Some (Expr.var (inputString.Substring (start, len)))
|
||||
| TokenType.Plus
|
||||
| TokenType.Minus
|
||||
| TokenType.Times
|
||||
| TokenType.Factorial
|
||||
| TokenType.If
|
||||
| TokenType.Then
|
||||
| TokenType.Else
|
||||
| TokenType.LeftBracket
|
||||
| TokenType.RightBracket -> None
|
||||
|
||||
let buildBinary (op : TokenType) (lhs : Expr) (rhs : Expr) : Expr =
|
||||
match op with
|
||||
| TokenType.Plus -> Expr.plus lhs rhs
|
||||
| TokenType.Minus -> Expr.minus lhs rhs
|
||||
| TokenType.Times -> Expr.times lhs rhs
|
||||
| _ -> failwithf "unexpected operation %+A seems not to be a binary op" op
|
||||
|
||||
let buildUnary (op : TokenType) (expr : Expr) : Expr =
|
||||
match op with
|
||||
| TokenType.Plus -> expr
|
||||
| TokenType.Minus -> Expr.unaryMinus expr
|
||||
| TokenType.Factorial -> Expr.factorial expr
|
||||
| _ -> failwithf "not a prefix op: %+A" op
|
||||
|
||||
/// The input string is only required so that the tokens
|
||||
/// have something to slice into.
|
||||
let rec parseInner (inputString : string) (tokens : Token list) (minBinding : int) : Expr * Token list =
|
||||
match tokens with
|
||||
| [] -> failwith "cannot parse an empty list of tokens"
|
||||
| firstToken :: rest ->
|
||||
|
||||
let lhs, rest =
|
||||
match atom inputString firstToken with
|
||||
| Some token ->
|
||||
printfn "Parsed an atom: %+A" token
|
||||
token, rest
|
||||
| None ->
|
||||
|
||||
if firstToken.Type = TokenType.LeftBracket then
|
||||
let contents, rest = parseInner inputString rest 0
|
||||
|
||||
match rest with
|
||||
| [] -> failwith "unterminated bracket"
|
||||
| head :: _ when head.Type <> TokenType.RightBracket ->
|
||||
failwithf "bracketed expression not followed by a right bracket, got: %+A" head
|
||||
| _ :: rest ->
|
||||
|
||||
Expr.paren contents, rest
|
||||
|
||||
else
|
||||
|
||||
match Token.prefixPrecedence firstToken.Type with
|
||||
| Some ((), precedence) ->
|
||||
printfn "Parsing a prefix op: %+A" firstToken
|
||||
let rhs, rest = parseInner inputString rest precedence
|
||||
printfn "Returning to parse of prefix op: %+A, remaining tokens: %+A" firstToken rest
|
||||
buildUnary firstToken.Type rhs, rest
|
||||
| None -> failwithf "didn't get an atom or prefix, got: %+A" firstToken
|
||||
|
||||
let rec go (lhs : Expr) (tokens : Token list) : Expr * Token list =
|
||||
match tokens with
|
||||
| [] -> lhs, []
|
||||
| op :: rest ->
|
||||
|
||||
match Token.postfixPrecedence op.Type with
|
||||
| Some (precedence, ()) ->
|
||||
if precedence < minBinding then
|
||||
printfn "Hit a postfix op which does not bind: %+A" op
|
||||
lhs, rest
|
||||
else
|
||||
printfn "Hit a postfix op which binds: %+A" op
|
||||
go (buildUnary op.Type lhs) rest
|
||||
| None ->
|
||||
|
||||
match Token.infixPrecedence op.Type with
|
||||
| None -> lhs, op :: rest
|
||||
| Some (leftBinding, rightBinding) ->
|
||||
|
||||
if leftBinding < minBinding then
|
||||
printfn "Hit an infix op which does not bind on the left: %+A" op
|
||||
lhs, op :: rest
|
||||
else
|
||||
|
||||
printfn "Hit an infix op which binds on the left: %+A" op
|
||||
|
||||
let rhs, remainingTokens = parseInner inputString rest rightBinding
|
||||
|
||||
go (buildBinary op.Type lhs rhs) remainingTokens
|
||||
|
||||
go lhs rest
|
||||
|
||||
let parse inputString tokens = parseInner inputString tokens 0
|
||||
@@ -1,13 +1,14 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="Domain.fs" />
|
||||
<Compile Include="Lexer.fs" />
|
||||
<None Include="Program.fs"/>
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<Compile Include="Domain.fs"/>
|
||||
<Compile Include="Lexer.fs"/>
|
||||
<Compile Include="Parser.fs"/>
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
||||
@@ -1,95 +0,0 @@
|
||||
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
|
||||
Reference in New Issue
Block a user