csharpfftfsharpintegrationinterpolationlinear-algebramathdifferentiationmatrixnumericsrandomregressionstatisticsmathnet
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
525 lines
23 KiB
525 lines
23 KiB
(* (c) Microsoft Corporation 2005-2008. *)
|
|
#light
|
|
|
|
open System.IO
|
|
open System.Collections.Generic
|
|
open Microsoft.FSharp.Text.Printf
|
|
open Internal.Utilities
|
|
open Internal.Utilities.Text.Lexing
|
|
|
|
open Fsyaccast
|
|
|
|
//------------------------------------------------------------------
|
|
// This code is duplicated from Microsoft.FSharp.Compiler.UnicodeLexing
|
|
|
|
type Lexbuf = LexBuffer<char>
|
|
|
|
/// Standard utility to create a Unicode LexBuffer
|
|
///
|
|
/// One small annoyance is that LexBuffers and not IDisposable. This means
|
|
/// we can't just return the LexBuffer object, since the file it wraps wouldn't
|
|
/// get closed when we're finished with the LexBuffer. Hence we return the stream,
|
|
/// the reader and the LexBuffer. The caller should dispose the first two when done.
|
|
let UnicodeFileAsLexbuf (filename,codePage : int option) : FileStream * StreamReader * Lexbuf =
|
|
// Use the .NET functionality to auto-detect the unicode encoding
|
|
// It also uses Lexing.from_text_reader to present the bytes read to the lexer in UTF8 decoded form
|
|
let stream = new FileStream(filename,FileMode.Open,FileAccess.Read,FileShare.Read)
|
|
let reader =
|
|
match codePage with
|
|
| None -> new StreamReader(stream,true)
|
|
| Some n -> new StreamReader(stream,System.Text.Encoding.GetEncoding(n))
|
|
let lexbuf = LexBuffer<char>.FromFunction(reader.Read)
|
|
lexbuf.EndPos <- Position.FirstLine(filename);
|
|
stream, reader, lexbuf
|
|
|
|
//------------------------------------------------------------------
|
|
// This is the program proper
|
|
|
|
let input = ref None
|
|
let modname= ref None
|
|
let opens= ref []
|
|
let out = ref None
|
|
let tokenize = ref false
|
|
let compat = ref false
|
|
let log = ref false
|
|
let light = ref None
|
|
let inputCodePage = ref None
|
|
let mutable lexlib = "Microsoft.FSharp.Text.Lexing"
|
|
let mutable parslib = "Microsoft.FSharp.Text.Parsing"
|
|
|
|
let usage =
|
|
[ "-o", Arg.String (fun s -> out := Some s), "Name the output file.";
|
|
"-v", Arg.Unit (fun () -> log := true), "Produce a listing file.";
|
|
"--module", Arg.String (fun s -> modname := Some s), "Define the F# module name to host the generated parser.";
|
|
"--open", Arg.String (fun s -> opens := !opens @ [s]), "Add the given module to the list of those to open in both the generated signature and implementation.";
|
|
"--light", Arg.Unit (fun () -> light := Some true), "Add #light to the top of the generated file (the default for .fs and .fsi output files)";
|
|
"--light-off", Arg.Unit (fun () -> light := Some false), "Add #light \"off\" to the top of the generated file";
|
|
"--ml-compatibility", Arg.Set compat, "Support the use of the global state from the 'Parsing' module in MLLib.";
|
|
"--tokens", Arg.Set tokenize, "Simply tokenize the specification file itself.";
|
|
"--lexlib", Arg.String (fun s -> lexlib <- s), "Specify the namespace for the implementation of the parser table interperter (default Microsoft.FSharp.Text.Parsing)";
|
|
"--parslib", Arg.String (fun s -> parslib <- s), "Specify the namespace for the implementation of the parser table interperter (default Microsoft.FSharp.Text.Parsing)";
|
|
"--codepage", Arg.Int (fun i -> inputCodePage := Some i), "Assume input lexer specification file is encoded with the given codepage."; ]
|
|
|
|
let _ = Arg.parse usage (fun x -> match !input with Some _ -> failwith "more than one input given" | None -> input := Some x) "fsyacc <filename>"
|
|
|
|
let output_int (os: #TextWriter) (n:int) = os.Write(string n)
|
|
|
|
let outputCodedUInt16 (os: #TextWriter) (n:int) =
|
|
os.Write n;
|
|
os.Write "us; ";
|
|
|
|
let shiftFlag = 0x0000
|
|
let reduceFlag = 0x4000
|
|
let errorFlag = 0x8000
|
|
let acceptFlag = 0xc000
|
|
let actionMask = 0xc000
|
|
|
|
let anyMarker = 0xffff
|
|
|
|
let actionCoding action =
|
|
match action with
|
|
| Accept -> acceptFlag
|
|
| Shift n -> shiftFlag ||| n
|
|
| Reduce n -> reduceFlag ||| n
|
|
| Error -> errorFlag
|
|
|
|
let main() =
|
|
let filename = (match !input with Some x -> x | None -> failwith "no input given") in
|
|
let spec =
|
|
let stream,reader,lexbuf = UnicodeFileAsLexbuf(filename, !inputCodePage)
|
|
use stream = stream
|
|
use reader = reader
|
|
|
|
try
|
|
if !tokenize then begin
|
|
while true do
|
|
printf "tokenize - getting one token";
|
|
let t = Fsyacclex.token lexbuf in
|
|
(*F# printf "tokenize - got %s" (Fsyaccpars.token_to_string t); F#*)
|
|
if t = Fsyaccpars.EOF then exit 0;
|
|
done;
|
|
end;
|
|
|
|
Fsyaccpars.spec Fsyacclex.token lexbuf
|
|
with e ->
|
|
printf "%s(%d,%d): error: %s" filename lexbuf.StartPos.Line lexbuf.StartPos.Column e.Message;
|
|
exit 1 in
|
|
|
|
let has_extension (s:string) =
|
|
(s.Length >= 1 && s.[s.Length - 1] = '.')
|
|
|| Path.HasExtension(s)
|
|
|
|
let chop_extension (s:string) =
|
|
if not (has_extension s) then invalidArg "s" "the file name does not have an extension"
|
|
Path.Combine (Path.GetDirectoryName s,Path.GetFileNameWithoutExtension(s))
|
|
|
|
let checkSuffix (x:string) (y:string) = x.EndsWith(y)
|
|
|
|
let output = match !out with Some x -> x | _ -> chop_extension filename ^ (if checkSuffix filename ".mly" then ".ml" else ".fs") in
|
|
let outputi = match !out with Some x -> chop_extension x ^ (if checkSuffix x ".ml" then ".mli" else ".fsi") | _ -> chop_extension filename ^ (if checkSuffix filename ".mly" then ".mli" else ".fsi") in
|
|
let outputo =
|
|
if !log then Some (match !out with Some x -> chop_extension x ^ ".fsyacc.output" | _ -> chop_extension filename ^ ".fsyacc.output")
|
|
else None
|
|
|
|
use os = (File.CreateText output :> TextWriter)
|
|
use osi = (File.CreateText outputi :> TextWriter)
|
|
|
|
let lineCountOutput = ref 0
|
|
let lineCountSignature = ref 0
|
|
let cos = (os,lineCountOutput)
|
|
let cosi = (osi,lineCountSignature)
|
|
let cprintf (os:TextWriter,lineCount) fmt = Printf.twprintf os fmt
|
|
let cprintfn (os:TextWriter,lineCount) fmt = Printf.ktwprintf (fun () -> incr lineCount; os.WriteLine()) os fmt
|
|
|
|
let logf =
|
|
match outputo with
|
|
| None -> (fun f -> ())
|
|
| Some filename ->
|
|
let oso = (File.CreateText filename :> TextWriter)
|
|
(fun f -> f oso)
|
|
|
|
logf (fun oso -> fprintfn oso "Output file describing compiled parser placed in %s and %s" output outputi);
|
|
|
|
printfn "building tables";
|
|
let spec1 = ProcessParserSpecAst spec
|
|
let (prods,states, startStates,actionTable,immediateActionTable,gotoTable,endOfInputTerminalIdx,errorTerminalIdx,nonTerminals) =
|
|
CompilerLalrParserSpec logf spec1
|
|
|
|
let (code,pos) = spec.Header
|
|
printfn "%d states" states.Length;
|
|
printfn "%d nonterminals" gotoTable.[0].Length;
|
|
printfn "%d terminals" actionTable.[0].Length;
|
|
printfn "%d productions" prods.Length;
|
|
printfn "#rows in action table: %d" actionTable.Length;
|
|
(*
|
|
printfn "#unique rows in action table: %d" (List.length (Array.fold_right (fun row acc -> insert (Array.to_list row) acc) actionTable []));
|
|
printfn "maximum #different actions per state: %d" (Array.fold_right (fun row acc ->max (List.length (List.fold_right insert (Array.to_list row) [])) acc) actionTable 0);
|
|
printfn "average #different actions per state: %d" ((Array.fold_right (fun row acc -> (List.length (List.fold_right insert (Array.to_list row) [])) + acc) actionTable 0) / (Array.length states));
|
|
*)
|
|
|
|
cprintfn cos "// Implementation file for parser generated by fsyacc";
|
|
cprintfn cosi "// Signature file for parser generated by fsyacc";
|
|
|
|
if (!light = Some(false)) || (!light = None && checkSuffix output ".ml") then
|
|
cprintfn cos "#light \"off\"";
|
|
cprintfn cosi "#light \"off\"";
|
|
else
|
|
cprintfn cos "#light";
|
|
cprintfn cosi "#light";
|
|
|
|
match !modname with
|
|
| None -> ()
|
|
| Some s ->
|
|
cprintfn cos "module %s" s;
|
|
cprintfn cosi "module %s" s;
|
|
|
|
cprintfn cos "#nowarn \"64\";; // turn off warnings that type variables used in production annotations are instantiated to concrete type";
|
|
|
|
for s in !opens do
|
|
cprintfn cos "open %s" s;
|
|
cprintfn cosi "open %s" s;
|
|
|
|
cprintfn cos "open %s" lexlib;
|
|
cprintfn cos "open %s.ParseHelpers" parslib;
|
|
if !compat then
|
|
cprintfn cos "open Microsoft.FSharp.Compatibility.OCaml.Parsing";
|
|
|
|
cprintfn cos "# %d \"%s\"" pos.pos_lnum pos.pos_fname;
|
|
cprintfn cos "%s" code;
|
|
lineCountOutput := !lineCountOutput + code.Replace("\r","").Split([| '\n' |]).Length;
|
|
|
|
cprintfn cos "# %d \"%s\"" !lineCountOutput output;
|
|
// Print the datatype for the tokens
|
|
cprintfn cos "// This type is the type of tokens accepted by the parser";
|
|
for out in [cos;cosi] do
|
|
cprintfn out "type token = ";
|
|
for id,typ in spec.Tokens do
|
|
match typ with
|
|
| None -> cprintfn out " | %s" id
|
|
| Some ty -> cprintfn out " | %s of (%s)" id ty;
|
|
|
|
// Print the datatype for the token names
|
|
cprintfn cos "// This type is used to give symbolic names to token indexes, useful for error messages";
|
|
for out in [cos;cosi] do
|
|
cprintfn out "type tokenId = ";
|
|
for id,typ in spec.Tokens do
|
|
cprintfn out " | TOKEN_%s" id;
|
|
cprintfn out " | TOKEN_end_of_input";
|
|
cprintfn out " | TOKEN_error";
|
|
|
|
cprintfn cos "// This type is used to give symbolic names to token indexes, useful for error messages";
|
|
for out in [cos;cosi] do
|
|
cprintfn out "type nonTerminalId = ";
|
|
for nt in nonTerminals do
|
|
cprintfn out " | NONTERM_%s" nt;
|
|
|
|
cprintfn cos "";
|
|
cprintfn cos "// This function maps tokens to integers indexes";
|
|
cprintfn cos "let tagOfToken (t:token) = ";
|
|
cprintfn cos " match t with";
|
|
spec.Tokens |> List.iteri (fun i (id,typ) ->
|
|
cprintfn cos " | %s %s -> %d " id (match typ with Some _ -> "_" | None -> "") i);
|
|
cprintfn cosi "/// This function maps integers indexes to symbolic token ids";
|
|
cprintfn cosi "val tagOfToken: token -> int";
|
|
|
|
cprintfn cos "";
|
|
cprintfn cos "// This function maps integers indexes to symbolic token ids";
|
|
cprintfn cos "let tokenTagToTokenId (tokenIdx:int) = ";
|
|
cprintfn cos " match tokenIdx with";
|
|
spec.Tokens |> List.iteri (fun i (id,typ) ->
|
|
cprintfn cos " | %d -> TOKEN_%s " i id)
|
|
cprintfn cos " | %d -> TOKEN_end_of_input" endOfInputTerminalIdx;
|
|
cprintfn cos " | %d -> TOKEN_error" errorTerminalIdx;
|
|
cprintfn cos " | _ -> failwith \"tokenTagToTokenId: bad token\""
|
|
|
|
cprintfn cosi "";
|
|
cprintfn cosi "/// This function maps integers indexes to symbolic token ids";
|
|
cprintfn cosi "val tokenTagToTokenId: int -> tokenId";
|
|
|
|
cprintfn cos "";
|
|
cprintfn cos "/// This function maps production indexes returned in syntax errors to strings representing the non terminal that would be produced by that production";
|
|
cprintfn cos "let prodIdxToNonTerminal (prodIdx:int) = ";
|
|
cprintfn cos " match prodIdx with";
|
|
prods |> Array.iteri (fun i (nt,ntIdx,syms,code) ->
|
|
cprintfn cos " | %d -> NONTERM_%s " i nt);
|
|
cprintfn cos " | _ -> failwith \"prodIdxToNonTerminal: bad production index\""
|
|
|
|
cprintfn cosi "";
|
|
cprintfn cosi "/// This function maps production indexes returned in syntax errors to strings representing the non terminal that would be produced by that production";
|
|
cprintfn cosi "val prodIdxToNonTerminal: int -> nonTerminalId";
|
|
|
|
cprintfn cos "";
|
|
cprintfn cos "let _fsyacc_endOfInputTag = %d " endOfInputTerminalIdx;
|
|
cprintfn cos "let _fsyacc_tagOfErrorTerminal = %d" errorTerminalIdx;
|
|
cprintfn cos "";
|
|
cprintfn cos "// This function gets the name of a token as a string";
|
|
cprintfn cos "let token_to_string (t:token) = ";
|
|
cprintfn cos " match t with ";
|
|
spec.Tokens |> List.iteri (fun i (id,typ) ->
|
|
cprintfn cos " | %s %s -> \"%s\" " id (match typ with Some _ -> "_" | None -> "") id);
|
|
|
|
cprintfn cosi "";
|
|
cprintfn cosi "/// This function gets the name of a token as a string";
|
|
cprintfn cosi "val token_to_string: token -> string";
|
|
|
|
cprintfn cos "";
|
|
cprintfn cos "// This function gets the data carried by a token as an object";
|
|
cprintfn cos "let _fsyacc_dataOfToken (t:token) = ";
|
|
cprintfn cos " match t with ";
|
|
|
|
for (id,typ) in spec.Tokens do
|
|
cprintfn cos " | %s %s -> %s "
|
|
id
|
|
(match typ with Some _ -> "_fsyacc_x" | None -> "")
|
|
(match typ with Some _ -> "Microsoft.FSharp.Core.Operators.box _fsyacc_x" | None -> "(null : System.Object)")
|
|
|
|
let tychar = "'cty"
|
|
|
|
for (key,_) in spec.Types |> Seq.countBy fst |> Seq.filter (fun (_,n) -> n > 1) do
|
|
failwithf "%s is given multiple %%type declarations" key;
|
|
|
|
for (key,_) in spec.Tokens |> Seq.countBy fst |> Seq.filter (fun (_,n) -> n > 1) do
|
|
failwithf "%s is given %%token declarations" key
|
|
|
|
let types = Map.of_list spec.Types
|
|
let tokens = Map.of_list spec.Tokens
|
|
|
|
let nStates = states.Length
|
|
begin
|
|
cprintf cos "let _fsyacc_gotos = [| " ;
|
|
let numGotoNonTerminals = gotoTable.[0].Length
|
|
let gotoIndexes = Array.create numGotoNonTerminals 0
|
|
let gotoTableCurrIndex = ref 0 in
|
|
for j = 0 to numGotoNonTerminals-1 do
|
|
gotoIndexes.[j] <- !gotoTableCurrIndex;
|
|
|
|
(* Count the number of entries in the association table. *)
|
|
let count = ref 0 in
|
|
for i = 0 to nStates - 1 do
|
|
let goto = gotoTable.[i].[j]
|
|
match goto with
|
|
| None -> ()
|
|
| Some _ -> incr count
|
|
|
|
(* Write the head of the table (i.e. the number of entries and the default value) *)
|
|
gotoTableCurrIndex := !gotoTableCurrIndex + 1;
|
|
outputCodedUInt16 os !count;
|
|
outputCodedUInt16 os anyMarker;
|
|
|
|
(* Write the pairs of entries in incremental order by key *)
|
|
(* This lets us implement the lookup by a binary chop. *)
|
|
for i = 0 to nStates - 1 do
|
|
let goto = gotoTable.[i].[j]
|
|
match goto with
|
|
| None -> ()
|
|
| Some n ->
|
|
gotoTableCurrIndex := !gotoTableCurrIndex + 1;
|
|
outputCodedUInt16 os i;
|
|
outputCodedUInt16 os n;
|
|
cprintfn cos "|]" ;
|
|
(* Output offsets into gotos table where the gotos for a particular nonterminal begin *)
|
|
cprintf cos "let _fsyacc_sparseGotoTableRowOffsets = [|" ;
|
|
for j = 0 to numGotoNonTerminals-1 do
|
|
outputCodedUInt16 os gotoIndexes.[j];
|
|
cprintfn cos "|]" ;
|
|
end;
|
|
|
|
begin
|
|
cprintf cos "let _fsyacc_stateToProdIdxsTableElements = [| " ;
|
|
let indexes = Array.create states.Length 0
|
|
let currIndex = ref 0
|
|
for j = 0 to states.Length - 1 do
|
|
let state = states.[j]
|
|
indexes.[j] <- !currIndex;
|
|
|
|
(* Write the head of the table (i.e. the number of entries) *)
|
|
outputCodedUInt16 os state.Length;
|
|
currIndex := !currIndex + state.Length + 1;
|
|
|
|
(* Write the pairs of entries in incremental order by key *)
|
|
(* This lets us implement the lookup by a binary chop. *)
|
|
for prodIdx in state do
|
|
outputCodedUInt16 os prodIdx;
|
|
cprintfn cos "|]" ;
|
|
(* Output offsets into gotos table where the gotos for a particular nonterminal begin *)
|
|
cprintf cos "let _fsyacc_stateToProdIdxsTableRowOffsets = [|" ;
|
|
for idx in indexes do
|
|
outputCodedUInt16 os idx;
|
|
cprintfn cos "|]" ;
|
|
end;
|
|
|
|
begin
|
|
let numActionRows = (Array.length actionTable)
|
|
let maxActionColumns = Array.length actionTable.[0]
|
|
cprintfn cos "let _fsyacc_action_rows = %d" numActionRows;
|
|
cprintf cos "let _fsyacc_actionTableElements = [|" ;
|
|
let actionIndexes = Array.create numActionRows 0
|
|
|
|
let actionTableCurrIndex = ref 0
|
|
for i = 0 to nStates-1 do
|
|
actionIndexes.[i] <- !actionTableCurrIndex;
|
|
let actions = actionTable.[i]
|
|
let terminalsByAction = new Dictionary<_,int list>(10)
|
|
let countPerAction = new Dictionary<_,_>(10)
|
|
for terminal = 0 to actions.Length - 1 do
|
|
let action = snd actions.[terminal]
|
|
if terminalsByAction.ContainsKey action then
|
|
terminalsByAction.[action] <- terminal :: terminalsByAction.[action] ;
|
|
else
|
|
terminalsByAction.[action] <- [terminal];
|
|
if countPerAction.ContainsKey action then
|
|
countPerAction.[action] <- countPerAction.[action]+1
|
|
else
|
|
countPerAction.[action] <- 1
|
|
|
|
let mostCommonAction =
|
|
let mostCommon = ref Error
|
|
let max = ref 0
|
|
for (KeyValue(x,y)) in countPerAction do
|
|
if y > !max then (mostCommon := x; max := y)
|
|
!mostCommon
|
|
|
|
(* Count the number of entries in the association table. *)
|
|
let count = ref 0
|
|
for (KeyValue(action,terminals)) in terminalsByAction do
|
|
for terminals in terminals do
|
|
if action <> mostCommonAction then
|
|
incr count;
|
|
|
|
(* Write the head of the table (i.e. the number of entries and the default value) *)
|
|
actionTableCurrIndex := !actionTableCurrIndex + 1;
|
|
outputCodedUInt16 os !count;
|
|
outputCodedUInt16 os (actionCoding mostCommonAction);
|
|
|
|
(* Write the pairs of entries in incremental order by key *)
|
|
(* This lets us implement the lookup by a binary chop. *)
|
|
for terminal = 0 to Array.length actions-1 do
|
|
let action = snd actions.[terminal] in
|
|
if action <> mostCommonAction then (
|
|
actionTableCurrIndex := !actionTableCurrIndex + 1;
|
|
outputCodedUInt16 os terminal;
|
|
outputCodedUInt16 os (actionCoding action);
|
|
);
|
|
cprintfn cos "|]" ;
|
|
(* Output offsets into actions table where the actions for a particular nonterminal begin *)
|
|
cprintf cos "let _fsyacc_actionTableRowOffsets = [|" ;
|
|
for j = 0 to numActionRows-1 do
|
|
cprintf cos "%a" outputCodedUInt16 actionIndexes.[j];
|
|
cprintfn cos "|]" ;
|
|
|
|
end;
|
|
begin
|
|
cprintf cos "let _fsyacc_reductionSymbolCounts = [|" ;
|
|
for nt,ntIdx,syms,code in prods do
|
|
cprintf cos "%a" outputCodedUInt16 (List.length syms);
|
|
cprintfn cos "|]" ;
|
|
end;
|
|
begin
|
|
cprintf cos "let _fsyacc_productionToNonTerminalTable = [|" ;
|
|
for nt,ntIdx,syms,code in prods do
|
|
cprintf cos "%a" outputCodedUInt16 ntIdx;
|
|
cprintfn cos "|]" ;
|
|
end;
|
|
begin
|
|
cprintf cos "let _fsyacc_immediateActions = [|" ;
|
|
for prodIdx in immediateActionTable do
|
|
match prodIdx with
|
|
| None -> cprintf cos "%a" outputCodedUInt16 anyMarker (* NONE REP *)
|
|
| Some act -> cprintf cos "%a" outputCodedUInt16 (actionCoding act)
|
|
cprintfn cos "|]" ;
|
|
end;
|
|
|
|
let getType nt = if types.ContainsKey nt then types.[nt] else "'"^nt
|
|
begin
|
|
cprintf cos "let _fsyacc_reductions () =" ;
|
|
cprintfn cos " [| " ;
|
|
for nt,ntIdx,syms,code in prods do
|
|
cprintfn cos "# %d \"%s\"" !lineCountOutput output;
|
|
cprintfn cos " (fun (parseState : %s.IParseState) ->" parslib
|
|
if !compat then
|
|
cprintfn cos " Parsing.set_parse_state parseState;"
|
|
syms |> List.iteri (fun i sym ->
|
|
let tyopt =
|
|
match sym with
|
|
| Terminal t ->
|
|
if tokens.ContainsKey t then
|
|
tokens.[t]
|
|
else None
|
|
| NonTerminal nt -> Some (getType nt)
|
|
match tyopt with
|
|
| Some ty -> cprintfn cos " let _%d = (let data = parseState.GetInput(%d) in (Microsoft.FSharp.Core.Operators.unbox data : %s)) in" (i+1) (i+1) ty
|
|
| None -> ())
|
|
cprintfn cos " Microsoft.FSharp.Core.Operators.box"
|
|
cprintfn cos " (";
|
|
cprintfn cos " (";
|
|
match code with
|
|
| Some (_,pos) -> cprintfn cos "# %d \"%s\"" pos.pos_lnum pos.pos_fname
|
|
| None -> ()
|
|
match code with
|
|
| Some (code,_) ->
|
|
let dollar = ref false in
|
|
let c = code |> String.collect (fun c ->
|
|
if not !dollar && c = '$' then (dollar := true; "")
|
|
elif !dollar && c >= '0' && c <= '9' then (dollar := false; "_"^new System.String(c,1))
|
|
elif !dollar then (dollar := false; "$"^new System.String(c,1))
|
|
else new System.String(c,1))
|
|
let lines = c.Split([| '\r'; '\n' |], System.StringSplitOptions.RemoveEmptyEntries);
|
|
for line in lines do
|
|
cprintfn cos " %s" line;
|
|
if !dollar then os.Write '$'
|
|
| None ->
|
|
cprintfn cos " raise (%s.Accept(Microsoft.FSharp.Core.Operators.box _1))" parslib
|
|
cprintfn cos " )";
|
|
// Place the line count back for the type constraint
|
|
match code with
|
|
| Some (_,pos) -> cprintfn cos "# %d \"%s\"" pos.pos_lnum pos.pos_fname
|
|
| None -> ()
|
|
cprintfn cos " : %s));" (if types.ContainsKey nt then types.[nt] else "'"^nt);
|
|
done;
|
|
cprintfn cos "|]" ;
|
|
end;
|
|
cprintfn cos "# %d \"%s\"" !lineCountOutput output;
|
|
cprintfn cos "let tables () : %s.Tables<_> = " parslib
|
|
cprintfn cos " { reductions= _fsyacc_reductions ();"
|
|
cprintfn cos " endOfInputTag = _fsyacc_endOfInputTag;"
|
|
cprintfn cos " tagOfToken = tagOfToken;"
|
|
cprintfn cos " dataOfToken = _fsyacc_dataOfToken; "
|
|
cprintfn cos " actionTableElements = _fsyacc_actionTableElements;"
|
|
cprintfn cos " actionTableRowOffsets = _fsyacc_actionTableRowOffsets;"
|
|
cprintfn cos " stateToProdIdxsTableElements = _fsyacc_stateToProdIdxsTableElements;"
|
|
cprintfn cos " stateToProdIdxsTableRowOffsets = _fsyacc_stateToProdIdxsTableRowOffsets;"
|
|
cprintfn cos " reductionSymbolCounts = _fsyacc_reductionSymbolCounts;"
|
|
cprintfn cos " immediateActions = _fsyacc_immediateActions;"
|
|
cprintfn cos " gotos = _fsyacc_gotos;"
|
|
cprintfn cos " sparseGotoTableRowOffsets = _fsyacc_sparseGotoTableRowOffsets;"
|
|
cprintfn cos " tagOfErrorTerminal = _fsyacc_tagOfErrorTerminal;"
|
|
cprintfn cos " parseError = (fun (ctxt:%s.ParseErrorContext<_>) -> " parslib
|
|
cprintfn cos " match parse_error_rich with "
|
|
cprintfn cos " | Some f -> f ctxt"
|
|
cprintfn cos " | None -> parse_error ctxt.Message);"
|
|
|
|
cprintfn cos " numTerminals = %d;" (Array.length actionTable.[0]);
|
|
cprintfn cos " productionToNonTerminalTable = _fsyacc_productionToNonTerminalTable }"
|
|
cprintfn cos "let engine lexer lexbuf startState = (tables ()).Interpret(lexer, lexbuf, startState)"
|
|
|
|
for (id,startState) in List.zip spec.StartSymbols startStates do
|
|
if not (types.ContainsKey id) then
|
|
failwith ("a %type declaration is required for for start token "^id);
|
|
let ty = types.[id] in
|
|
cprintfn cos "let %s lexer lexbuf : %s =" id ty;
|
|
cprintfn cos " Microsoft.FSharp.Core.Operators.unbox ((tables ()).Interpret(lexer, lexbuf, %d))" startState
|
|
|
|
for id in spec.StartSymbols do
|
|
if not (types.ContainsKey id) then
|
|
failwith ("a %type declaration is required for start token "^id);
|
|
let ty = types.[id] in
|
|
cprintfn cosi "val %s : (%s.LexBuffer<%s> -> token) -> %s.LexBuffer<%s> -> (%s) " id lexlib tychar lexlib tychar ty;
|
|
|
|
logf (fun oso -> oso.Close())
|
|
|
|
let _ =
|
|
try main()
|
|
with e ->
|
|
printf "Error: %s" (match e with Failure s -> s | e -> e.Message);
|
|
exit 1
|
|
|
|
|