mirror of
https://github.com/Smaug123/WoofWare.PrattParser
synced 2025-10-05 09:28:41 +00:00
Downgrade FSharp.Core (#22)
This commit is contained in:
9
PrattParser/Map.fs
Normal file
9
PrattParser/Map.fs
Normal file
@@ -0,0 +1,9 @@
|
|||||||
|
namespace WoofWare.PrattParser
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal Map =
|
||||||
|
// For compat reasons, we target a very low FSharp.Core.
|
||||||
|
let change k f m =
|
||||||
|
match f (Map.tryFind k m) with
|
||||||
|
| None -> Map.remove k m
|
||||||
|
| Some v -> Map.add k v m
|
@@ -252,8 +252,8 @@ module Parser =
|
|||||||
| Some token -> token, rest
|
| Some token -> token, rest
|
||||||
| None ->
|
| None ->
|
||||||
|
|
||||||
match parser.BracketLike.TryGetValue (parser.GetTag firstToken) with
|
match Map.tryFind (parser.GetTag firstToken) parser.BracketLike with
|
||||||
| true, parse ->
|
| Some parse ->
|
||||||
// This is an ambiguous parse if multiple parsers genuinely matched.
|
// This is an ambiguous parse if multiple parsers genuinely matched.
|
||||||
// (We already filter to the longest possible matching parser.)
|
// (We already filter to the longest possible matching parser.)
|
||||||
match parseBracketLike parser inputString parse [] rest with
|
match parseBracketLike parser inputString parse [] rest with
|
||||||
@@ -263,13 +263,13 @@ module Parser =
|
|||||||
failwithf
|
failwithf
|
||||||
"Ambiguous parse for bracket-like construct. You should restrict the grammar. %+A"
|
"Ambiguous parse for bracket-like construct. You should restrict the grammar. %+A"
|
||||||
firstToken
|
firstToken
|
||||||
| false, _ ->
|
| None ->
|
||||||
|
|
||||||
match parser.UnaryPrefix.TryGetValue (parser.GetTag firstToken) with
|
match Map.tryFind (parser.GetTag firstToken) parser.UnaryPrefix with
|
||||||
| true, (((), precedence), assemble) ->
|
| Some (((), precedence), assemble) ->
|
||||||
let rhs, rest = parseInner parser inputString rest precedence
|
let rhs, rest = parseInner parser inputString rest precedence
|
||||||
assemble rhs, rest
|
assemble rhs, rest
|
||||||
| false, _ -> failwithf "didn't get an atom or prefix, got: %+A" firstToken
|
| None -> failwithf "didn't get an atom or prefix, got: %+A" firstToken
|
||||||
|
|
||||||
let rec go (lhs : 'expr) (tokens : 'token list) : 'expr * 'token list =
|
let rec go (lhs : 'expr) (tokens : 'token list) : 'expr * 'token list =
|
||||||
match tokens with
|
match tokens with
|
||||||
@@ -277,30 +277,30 @@ module Parser =
|
|||||||
| op :: rest ->
|
| op :: rest ->
|
||||||
|
|
||||||
let fromBracketed =
|
let fromBracketed =
|
||||||
match parser.BracketLike.TryGetValue (parser.GetTag op) with
|
match Map.tryFind (parser.GetTag op) parser.BracketLike with
|
||||||
| true, parse ->
|
| Some parse ->
|
||||||
let parse = parse |> List.filter _.ConsumeBeforeInitialToken
|
let parse = parse |> List.filter _.ConsumeBeforeInitialToken
|
||||||
|
|
||||||
match parseBracketLike parser inputString parse [ lhs ] rest with
|
match parseBracketLike parser inputString parse [ lhs ] rest with
|
||||||
| [ result ] -> Some result
|
| [ result ] -> Some result
|
||||||
| _ :: _ -> failwithf "Ambiguous parse (multiple matches) at token %+A" op
|
| _ :: _ -> failwithf "Ambiguous parse (multiple matches) at token %+A" op
|
||||||
| [] -> None
|
| [] -> None
|
||||||
| false, _ -> None
|
| None -> None
|
||||||
|
|
||||||
match fromBracketed with
|
match fromBracketed with
|
||||||
| Some (lhs, rest) -> go lhs rest
|
| Some (lhs, rest) -> go lhs rest
|
||||||
| None ->
|
| None ->
|
||||||
|
|
||||||
match parser.UnaryPostfix.TryGetValue (parser.GetTag op) with
|
match Map.tryFind (parser.GetTag op) parser.UnaryPostfix with
|
||||||
| true, ((precedence, ()), construct) ->
|
| Some ((precedence, ()), construct) ->
|
||||||
if precedence < minBinding then
|
if precedence < minBinding then
|
||||||
lhs, rest
|
lhs, rest
|
||||||
else
|
else
|
||||||
go (construct lhs) rest
|
go (construct lhs) rest
|
||||||
| false, _ ->
|
| None ->
|
||||||
|
|
||||||
match parser.Infix.TryGetValue (parser.GetTag op) with
|
match Map.tryFind (parser.GetTag op) parser.Infix with
|
||||||
| true, ((leftBinding, rightBinding), construct) ->
|
| Some ((leftBinding, rightBinding), construct) ->
|
||||||
if leftBinding < minBinding then
|
if leftBinding < minBinding then
|
||||||
lhs, op :: rest
|
lhs, op :: rest
|
||||||
else
|
else
|
||||||
@@ -308,7 +308,7 @@ module Parser =
|
|||||||
let rhs, remainingTokens = parseInner parser inputString rest rightBinding
|
let rhs, remainingTokens = parseInner parser inputString rest rightBinding
|
||||||
|
|
||||||
go (construct lhs rhs) remainingTokens
|
go (construct lhs rhs) remainingTokens
|
||||||
| false, _ ->
|
| None ->
|
||||||
// TODO: This could be function application!
|
// TODO: This could be function application!
|
||||||
lhs, op :: rest
|
lhs, op :: rest
|
||||||
|
|
||||||
|
@@ -18,6 +18,7 @@
|
|||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
|
<Compile Include="Map.fs" />
|
||||||
<Compile Include="Parser.fs"/>
|
<Compile Include="Parser.fs"/>
|
||||||
<EmbeddedResource Include="version.json" />
|
<EmbeddedResource Include="version.json" />
|
||||||
<EmbeddedResource Include="SurfaceBaseline.txt"/>
|
<EmbeddedResource Include="SurfaceBaseline.txt"/>
|
||||||
@@ -32,7 +33,7 @@
|
|||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Update="FSharp.Core" Version="6.0.0" />
|
<PackageReference Update="FSharp.Core" Version="4.3.4" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
</Project>
|
</Project>
|
||||||
|
@@ -18,8 +18,8 @@
|
|||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "FSharp.Core";
|
pname = "FSharp.Core";
|
||||||
version = "6.0.0";
|
version = "4.3.4";
|
||||||
sha256 = "1hjhvr39c1vpgrdmf8xln5q86424fqkvy9nirkr29vl2461d2039";
|
sha256 = "1sg6i4q5nwyzh769g76f6c16876nvdpn83adqjr2y9x6xsiv5p5j";
|
||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "FSharp.Core";
|
pname = "FSharp.Core";
|
||||||
|
Reference in New Issue
Block a user