Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

reduce/resuce precedence #51

Closed
wants to merge 2 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 9 additions & 2 deletions src/FsYacc/fsyacc.fs
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,8 @@ let out = ref None
let tokenize = ref false
let compat = ref false
let log = ref false
let newprec = ref false
let norec = ref false
let light = ref None
let inputCodePage = ref None
let mutable lexlib = "Microsoft.FSharp.Text.Lexing"
Expand All @@ -62,7 +64,9 @@ let usage =
ArgInfo("--tokens", ArgType.Set tokenize, "Simply tokenize the specification file itself.");
ArgInfo("--lexlib", ArgType.String (fun s -> lexlib <- s), "Specify the namespace for the implementation of the lexer (default: Microsoft.FSharp.Text.Lexing)");
ArgInfo("--parslib", ArgType.String (fun s -> parslib <- s), "Specify the namespace for the implementation of the parser table interpreter (default: Microsoft.FSharp.Text.Parsing)");
ArgInfo("--codepage", ArgType.Int (fun i -> inputCodePage := Some i), "Assume input lexer specification file is encoded with the given codepage."); ]
ArgInfo("--codepage", ArgType.Int (fun i -> inputCodePage := Some i), "Assume input lexer specification file is encoded with the given codepage.");
ArgInfo("--newprec", ArgType.Unit (fun () -> newprec := true), "Use the new precedence resolving behaviour. See: https://github.com/fsprojects/FsLexYacc/pull/51");
ArgInfo("--no-recovery", ArgType.Unit (fun () -> norec := true), "Don't try recovering from invalid input") ]

let _ = ArgParser.Parse(usage,(fun x -> match !input with Some _ -> failwith "more than one input given" | None -> input := Some x),"fsyacc <filename>")

Expand All @@ -89,6 +93,9 @@ let actionCoding action =

let main() =
let filename = (match !input with Some x -> x | None -> failwith "no input given") in
if not <| !newprec then
printfn "FSYACC is running in a compatibility mode - consider adding then --newprec argument"

let spec =
let stream,reader,lexbuf = UnicodeFileAsLexbuf(filename, !inputCodePage)
use stream = stream
Expand Down Expand Up @@ -147,7 +154,7 @@ let main() =
printfn "building tables";
let spec1 = ProcessParserSpecAst spec
let (prods,states, startStates,actionTable,immediateActionTable,gotoTable,endOfInputTerminalIdx,errorTerminalIdx,nonTerminals) =
CompilerLalrParserSpec logf spec1
CompilerLalrParserSpec logf !newprec !norec spec1

let (code,pos) = spec.Header
printfn "%d states" states.Length;
Expand Down
65 changes: 39 additions & 26 deletions src/FsYacc/fsyaccast.fs
Original file line number Diff line number Diff line change
Expand Up @@ -347,7 +347,7 @@ type PropagateTable() =


/// Compile a pre-processed LALR parser spec to tables following the Dragon book algorithm
let CompilerLalrParserSpec logf (spec : ProcessedParserSpec) =
let CompilerLalrParserSpec logf (newprec:bool) (norec:bool) (spec : ProcessedParserSpec) =
let stopWatch = new System.Diagnostics.Stopwatch()
let reportTime() = printfn "time: %A" stopWatch.Elapsed; stopWatch.Reset(); stopWatch.Start()
stopWatch.Start()
Expand Down Expand Up @@ -768,26 +768,39 @@ let CompilerLalrParserSpec logf (spec : ProcessedParserSpec) =
| (((precReduce,Reduce prodIdx) as reduceItem),
((precShift,Shift sIdx) as shiftItem)) ->
match precReduce, precShift with
| (ExplicitPrec (_,p1), ExplicitPrec(assocNew,p2)) ->
| (ExplicitPrec (_,p1) as pp, ExplicitPrec(assocNew,p2)) ->
if p1 < p2 then shiftItem
elif p1 > p2 then reduceItem
else
match assocNew with
| LeftAssoc -> reduceItem
| RightAssoc -> shiftItem
| NonAssoc ->
reportConflict shiftItem reduceItem "we preffer shift on equal precedences"
incr shiftReduceConflicts;
shiftItem
| NonAssoc ->
if newprec then
pp, Error
else
reportConflict shiftItem reduceItem "we preffer shift on equal precedences"
incr shiftReduceConflicts;
shiftItem
| _ ->
reportConflict shiftItem reduceItem "we preffer shift when unable to compare precedences"
incr shiftReduceConflicts;
shiftItem
| ((_,Reduce prodIdx1),(_, Reduce prodIdx2)) ->
"we prefer the rule earlier in the file"
|> if prodIdx1 < prodIdx2 then reportConflict itemSoFar itemNew else reportConflict itemNew itemSoFar
incr reduceReduceConflicts;
if prodIdx1 < prodIdx2 then itemSoFar else itemNew
| ((prec1,Reduce prodIdx1),(prec2, Reduce prodIdx2)) ->
match prec1, prec2 with
| (ExplicitPrec (_,p1), ExplicitPrec(assocNew,p2)) when newprec ->
if p1 < p2 then itemNew
elif p1 > p2 then itemSoFar
else
"we prefer the rule earlier in the file on equal precedences"
|> if prodIdx1 < prodIdx2 then reportConflict itemSoFar itemNew else reportConflict itemNew itemSoFar
incr reduceReduceConflicts;
if prodIdx1 < prodIdx2 then itemSoFar else itemNew
| _ ->
"we prefer the rule earlier in the file when unable to compare precedences"
|> if prodIdx1 < prodIdx2 then reportConflict itemSoFar itemNew else reportConflict itemNew itemSoFar
incr reduceReduceConflicts;
if prodIdx1 < prodIdx2 then itemSoFar else itemNew
| _ -> itemNew
arr.[termIdx] <- winner

Expand Down Expand Up @@ -840,29 +853,29 @@ let CompilerLalrParserSpec logf (spec : ProcessedParserSpec) =
let immediateAction =
match Set.toList closure with
| [item0] ->
let pItem0 = prodIdx_of_item0 item0
match (rsym_of_item0 item0) with
| None when (let reduceOrErrorAction = function Error | Reduce _ -> true | Shift _ | Accept -> false
termTab.Indexes |> List.forall(fun terminalIdx -> reduceOrErrorAction (snd(arr.[terminalIdx]))))
-> Some (Reduce (prodIdx_of_item0 item0))
| None when (termTab.Indexes |> List.forall(fun terminalIdx -> arr.[terminalIdx] |> function (_, Reduce pItem0) -> true | (_, Error) when not <| norec -> true | _ -> false))
-> Some (Reduce pItem0)

| None when (let acceptOrErrorAction = function Error | Accept -> true | Shift _ | Reduce _ -> false
List.forall (fun terminalIdx -> acceptOrErrorAction (snd(arr.[terminalIdx]))) termTab.Indexes)
| None when (termTab.Indexes |> List.forall(fun terminalIdx -> arr.[terminalIdx] |> function (_, Accept) -> true | (_, Error) when not <| norec -> true | _ -> false))
-> Some Accept

| _ -> None
| _ -> None

// A -> B C . rules give rise to reductions in favour of errors
for item0 in ComputeClosure0 kernel do
let prec = prec_of_item0 item0
match rsym_of_item0 item0 with
| None ->
for terminalIdx in termTab.Indexes do
if snd(arr.[terminalIdx]) = Error then
let prodIdx = prodIdx_of_item0 item0
let action = (prec, (if IsStartItem(item0) then Accept else Reduce prodIdx))
addResolvingPrecedence arr kernelIdx terminalIdx action
| _ -> ()
if not <| norec then
for item0 in ComputeClosure0 kernel do
let prec = prec_of_item0 item0
match rsym_of_item0 item0 with
| None ->
for terminalIdx in termTab.Indexes do
if snd(arr.[terminalIdx]) = Error then
let prodIdx = prodIdx_of_item0 item0
let action = (prec, (if IsStartItem(item0) then Accept else Reduce prodIdx))
addResolvingPrecedence arr kernelIdx terminalIdx action
| _ -> ()

arr,immediateAction

Expand Down