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.

Sign up for GitHub

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

Added --quiet option to FsLex and FsYacc. #199

Closed
wants to merge 1 commit into from
Closed

Added --quiet option to FsLex and FsYacc. #199

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
17 changes: 13 additions & 4 deletions src/FsLex/fslex.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ let mutable opens = []
let mutable lexlib = "FSharp.Text.Lexing"
let mutable unicode = false
let mutable caseInsensitive = false
let mutable quiet = false

let usage =
[
Expand All @@ -46,6 +47,7 @@ let usage =
)
ArgInfo("--unicode", ArgType.Unit(fun () -> unicode <- true), "Produce a lexer for use with 16-bit unicode characters.")
ArgInfo("-i", ArgType.Unit(fun () -> caseInsensitive <- true), "Produce a case-insensitive lexer.")
ArgInfo("--quiet", ArgType.Unit(fun () -> quiet <- true), "Suppress all output except errors.")
]

let _ =
Expand All @@ -63,6 +65,14 @@ let compileSpec (spec: Spec) (ctx: ParseContext) =
let dfaNodes = dfaNodes |> List.sortBy (fun n -> n.Id)
perRuleData, dfaNodes

let inline qprintf fmt =
fprintf
(if quiet then
System.IO.TextWriter.Null
else
System.Console.Out)
fmt

let main () =
try
let filename =
Expand Down Expand Up @@ -91,11 +101,10 @@ let main () =

exit 1

printfn "compiling to dfas (can take a while...)"
qprintf "compiling to dfas (can take a while...)"
let perRuleData, dfaNodes = compileSpec spec parseContext
printfn "%d states" dfaNodes.Length

printfn "writing output"
qprintf "%d states" dfaNodes.Length
qprintf "writing output"

let output =
match out with
Expand Down
73 changes: 41 additions & 32 deletions src/FsYacc.Core/fsyaccast.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -252,7 +252,7 @@ let ProcessWorkList start f =
let queueWork = (fun x -> work := x :: !work)

let rec loop () =
match !work with
match work.Value with
| [] -> ()
| x :: t ->
work := t
Expand Down Expand Up @@ -450,11 +450,20 @@ type CompiledSpec =
}

/// Compile a pre-processed LALR parser spec to tables following the Dragon book algorithm
let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =
let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) quiet : CompiledSpec =

let qprintf fmt =
fprintf
(if quiet then
System.IO.TextWriter.Null
else
System.Console.Out)
fmt

let stopWatch = System.Diagnostics.Stopwatch()

let reportTime () =
printfn " time: %A" stopWatch.Elapsed
qprintf " time: %A" stopWatch.Elapsed
stopWatch.Reset()
stopWatch.Start()

Expand Down Expand Up @@ -487,7 +496,7 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =
let errorTerminalIdx = termTab.ToIndex "error"

// Compute the FIRST function
printf "computing first function..."
qprintf "computing first function..."
stdout.Flush()

let computedFirstTable =
Expand Down Expand Up @@ -879,13 +888,13 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =
for kernelIdx in kernelTab.Indexes do
printf "."
stdout.Flush()
//printf "kernelIdx = %d\n" kernelIdx; stdout.Flush();
//qprintf "kernelIdx = %d\n" kernelIdx; stdout.Flush();
let kernel = kernelTab.Kernel(kernelIdx)

for item0 in kernel do
let item0Idx = KernelItemIdx(kernelIdx, item0)
let jset = closure1OfItem0WithDummy item0
//printf "#jset = %d\n" jset.Count; stdout.Flush();
//qprintf "#jset = %d\n" jset.Count; stdout.Flush();
for KeyValue(closureItem0, lookaheadTokens) in jset.IEnumerable do
incr count

Expand All @@ -904,16 +913,16 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =
else
spontaneous.Add(gotoItemIdx, lookaheadToken) |> ignore

//printfn "#kernelIdxs = %d, count = %d" kernelTab.Indexes.Length !count
//qprintf "#kernelIdxs = %d, count = %d" kernelTab.Indexes.Length !count
spontaneous, propagate

//printfn "#spontaneous = %d, #propagate = %d" spontaneous.Count propagate.Count; stdout.Flush();
//qprintf "#spontaneous = %d, #propagate = %d" spontaneous.Count propagate.Count; stdout.Flush();

//exit 0;
// Repeatedly use the "spontaneous" and "propagate" maps to build the full set
// of lookaheads for each LR(0) kernelItem.
reportTime ()
printf "building lookahead table..."
qprintf "building lookahead table..."
stdout.Flush()

let lookaheadTable =
Expand All @@ -939,10 +948,10 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =

acc

//printf "built lookahead table, #lookaheads = %d\n" lookaheadTable.Count; stdout.Flush();
//qprintf "built lookahead table, #lookaheads = %d\n" lookaheadTable.Count; stdout.Flush();

reportTime ()
printf "building action table..."
qprintf "building action table..."
stdout.Flush()
let shiftReduceConflicts = ref 0
let reduceReduceConflicts = ref 0
Expand All @@ -952,12 +961,12 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =
// Now build the action tables. First a utility to merge the given action
// into the table, taking into account precedences etc. and reporting errors.
let addResolvingPrecedence (arr: _[]) kernelIdx termIdx (precNew, actionNew) =
// printf "DEBUG: state %d: adding action for %s, precNew = %a, actionNew = %a\n" kernelIdx (termTab.OfIndex termIdx) outputPrec precNew OutputAction actionNew;
// qprintf "DEBUG: state %d: adding action for %s, precNew = %a, actionNew = %a\n" kernelIdx (termTab.OfIndex termIdx) outputPrec precNew OutputAction actionNew;
// We add in order of precedence - however the precedences may be the same, and we give warnings when rpecedence resolution is based on implicit file orderings

let _, actionSoFar as itemSoFar = arr.[termIdx]

// printf "DEBUG: state %d: adding action for %s, precNew = %a, precSoFar = %a, actionSoFar = %a\n" kernelIdx (termTab.OfIndex termIdx) outputPrec precNew outputPrec precSoFar OutputAction actionSoFar;
// qprintf "DEBUG: state %d: adding action for %s, precNew = %a, precSoFar = %a, actionSoFar = %a\n" kernelIdx (termTab.OfIndex termIdx) outputPrec precNew outputPrec precSoFar OutputAction actionSoFar;
// if compare_prec precSoFar precNew = -1 then failwith "addResolvingPrecedence";

let itemNew = (precNew, actionNew)
Expand Down Expand Up @@ -1050,7 +1059,7 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =
let kernel = kernelTab.Kernel kernelIdx
let arr = Array.create terminals.Length (NoPrecedence, Error)

//printf "building lookahead table LR(1) items for kernelIdx %d\n" kernelIdx; stdout.Flush();
//qprintf "building lookahead table LR(1) items for kernelIdx %d\n" kernelIdx; stdout.Flush();

// Compute the LR(1) items based on lookaheads
let items =
Expand Down Expand Up @@ -1148,7 +1157,7 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =
// The goto table is much simpler - it is based on LR(0) kernels alone.

reportTime ()
printf " building goto table..."
qprintf " building goto table..."
stdout.Flush()

let gotoTable =
Expand All @@ -1158,7 +1167,7 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =
Array.ofList (List.map gotos kernelTab.Indexes)

reportTime ()
printfn " returning tables."
qprintf " returning tables."
stdout.Flush()

if !shiftReduceConflicts > 0 then
Expand Down Expand Up @@ -1212,21 +1221,21 @@ let CompilerLalrParserSpec logf (spec: ProcessedParserSpec) : CompiledSpec =

(*

let example1 =
let e = "E"
let example1 =
let e = "E"
let t = "Terminal"
let plus = "+"
let mul = "*"
let f = "F"
let lparen = "("
let rparen = ")"
let id = "id"

let terminals = [plus; mul; lparen; rparen; id]
let nonTerminals = [e; t; f]

let p2 = e, (NonAssoc, ExplicitPrec 1), [NonTerminal e; Terminal plus; NonTerminal t], None
let p3 = e, (NonAssoc, ExplicitPrec 2), [NonTerminal t], None in
let p3 = e, (NonAssoc, ExplicitPrec 2), [NonTerminal t], None in
Comment on lines +1224 to +1238
Copy link
Collaborator Author

@vzarytovskii vzarytovskii Apr 5, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Those are either by fantomas or my editor, I can revert if needed.

Same applies for all whitespace changes in files.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As this is in a code comment, this is your editor's doing.

let p4 = t, (NonAssoc, ExplicitPrec 3), [NonTerminal t; Terminal mul; NonTerminal f], None
let p5 = t, (NonAssoc, ExplicitPrec 4), [NonTerminal f], None
let p6 = f, (NonAssoc, ExplicitPrec 5), [Terminal lparen; NonTerminal e; Terminal rparen], None
Expand All @@ -1235,13 +1244,13 @@ let example1 =
let prods = [p2;p3;p4;p5;p6;p7]
Spec(terminals,nonTerminals,prods, [e])

let example2 =
let prods = [ "S", (NonAssoc, ExplicitPrec 1), [NonTerminal "C";NonTerminal "C"], None;
let example2 =
let prods = [ "S", (NonAssoc, ExplicitPrec 1), [NonTerminal "C";NonTerminal "C"], None;
"C", (NonAssoc, ExplicitPrec 2), [Terminal "c";NonTerminal "C"], None ;
"C", (NonAssoc, ExplicitPrec 3), [Terminal "d"] , None ]in
Spec(["c";"d"],["S";"C"],prods, ["S"])

let example3 =
let example3 =
let terminals = ["+"; "*"; "("; ")"; "id"]
let nonTerminals = ["E"; "Terminal"; "E'"; "F"; "Terminal'"]
let prods = [ "E", (NonAssoc, ExplicitPrec 1), [ NonTerminal "Terminal"; NonTerminal "E'" ], None;
Expand All @@ -1254,7 +1263,7 @@ let example3 =
"F", (NonAssoc, ExplicitPrec 8), [ Terminal "id"], None ]
Spec(terminals,nonTerminals,prods, ["E"])

let example4 =
let example4 =
let terminals = ["+"; "*"; "("; ")"; "id"]
let nonTerminals = ["E"]
let prods = [ "E", (NonAssoc, ExplicitPrec 1), [ NonTerminal "E"; Terminal "+"; NonTerminal "E" ], None;
Expand All @@ -1263,7 +1272,7 @@ let example4 =
"E", (NonAssoc, ExplicitPrec 8), [ Terminal "id"], None ]
Spec(terminals,nonTerminals,prods, ["E"])

let example5 =
let example5 =
let terminals = ["+"; "*"; "("; ")"; "id"]
let nonTerminals = ["E"]
let prods = [ "E", (NonAssoc, ExplicitPrec 1), [ NonTerminal "E"; Terminal "+"; NonTerminal "E" ], None;
Expand All @@ -1272,7 +1281,7 @@ let example5 =
"E", (NonAssoc, ExplicitPrec 8), [ Terminal "id"], None ]
Spec(terminals,nonTerminals,prods, ["E"])

let example6 =
let example6 =
let terminals = ["+"; "*"; "("; ")"; "id"; "-"]
let nonTerminals = ["E"]
let prods = [ "E", (RightAssoc, ExplicitPrec 1), [ NonTerminal "E"; Terminal "-"; NonTerminal "E" ], None;
Expand All @@ -1283,11 +1292,11 @@ let example6 =
Spec(terminals,nonTerminals,prods, ["E"])


let example7 =
let prods = [ "S", (NonAssoc, ExplicitPrec 1), [NonTerminal "L";Terminal "="; NonTerminal "R"], None;
let example7 =
let prods = [ "S", (NonAssoc, ExplicitPrec 1), [NonTerminal "L";Terminal "="; NonTerminal "R"], None;
"S", (NonAssoc, ExplicitPrec 2), [NonTerminal "R"], None ;
"L", (NonAssoc, ExplicitPrec 3), [Terminal "*"; NonTerminal "R"], None;
"L", (NonAssoc, ExplicitPrec 3), [Terminal "id"], None;
"L", (NonAssoc, ExplicitPrec 3), [Terminal "id"], None;
"R", (NonAssoc, ExplicitPrec 3), [NonTerminal "L"], None; ]
Spec(["*";"=";"id"],["S";"L";"R"],prods, ["S"])

Expand All @@ -1297,8 +1306,8 @@ let test ex = CompilerLalrParserSpec stdout ex

(* let _ = test example2*)
(* let _ = exit 1*)
(* let _ = test example3
let _ = test example1
(* let _ = test example3
let _ = test example1
let _ = test example4
let _ = test example5
let _ = test example6 *)
Expand Down
20 changes: 15 additions & 5 deletions src/FsYacc.Core/fsyaccdriver.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,16 +30,24 @@ let readSpecFromFile fileName codePage =
with e ->
(e, lexbuf.StartPos.Line, lexbuf.StartPos.Column) |> Result.Error

let printTokens filename codePage =
let printTokens filename codePage quiet =
let qprintf fmt =
fprintf
(if quiet then
System.IO.TextWriter.Null
else
System.Console.Out)
fmt

let stream, reader, lexbuf = UnicodeFileAsLexbuf(filename, codePage)
use stream = stream
use reader = reader

try
while true do
printf "tokenize - getting one token"
qprintf "tokenize - getting one token"
let t = Lexer.token lexbuf in
printf "tokenize - got %s" (Parser.token_to_string t)
qprintf "tokenize - got %s" (Parser.token_to_string t)

if t = Parser.EOF then
exit 0
Expand Down Expand Up @@ -177,6 +185,7 @@ type GeneratorState =
map_action_to_int: Action -> int
anyMarker: int
bufferTypeArgument: string
quiet: bool
}

static member Default =
Expand All @@ -195,6 +204,7 @@ type GeneratorState =
map_action_to_int = actionCoding
anyMarker = anyMarker
bufferTypeArgument = "'cty"
quiet = false
}

let writeSpecToFile (generatorState: GeneratorState) (spec: ParserSpec) (compiledSpec: CompiledSpec) =
Expand Down Expand Up @@ -668,6 +678,6 @@ let writeSpecToFile (generatorState: GeneratorState) (spec: ParserSpec) (compile
generatorState.bufferTypeArgument
ty

let compileSpec (spec: ParserSpec) (logger: Logger) =
let compileSpec (spec: ParserSpec) (logger: Logger) quiet =
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hmm, I would prefer to see logger changed to Microsoft.Extensions.Logging.Logger.
The quiet flag very much feels like a quick win that someone else will need to clean up in the future.

let spec1 = ProcessParserSpecAst spec
CompilerLalrParserSpec logger.LogStream spec1
CompilerLalrParserSpec logger.LogStream spec1 quiet
Loading
Loading