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.
216 lines
8.7 KiB
216 lines
8.7 KiB
// (c) Microsoft Corporation 2005-2009.
|
|
|
|
#light
|
|
|
|
open Fslexast
|
|
open Fslexpars
|
|
open Microsoft.FSharp.Text.Printf
|
|
open Internal.Utilities
|
|
open Internal.Utilities.Text.Lexing
|
|
open System
|
|
open System.Collections.Generic
|
|
open System.IO
|
|
|
|
//------------------------------------------------------------------
|
|
// 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.FromFunction(reader.Read)
|
|
lexbuf.EndPos <- Position.FirstLine(filename);
|
|
stream, reader, lexbuf
|
|
|
|
//------------------------------------------------------------------
|
|
// This is the program proper
|
|
|
|
let input = ref None
|
|
let out = ref None
|
|
let inputCodePage = ref None
|
|
let light = ref None
|
|
|
|
let mutable lexlib = "Microsoft.FSharp.Text.Lexing"
|
|
|
|
let usage =
|
|
[ "-o", Arg.String (fun s -> out := Some s), "Name the output file.";
|
|
"--codepage", Arg.Int (fun i -> inputCodePage := Some i), "Assume input lexer specification file is encoded with the given codepage.";
|
|
"--light", Arg.Unit (fun () -> light := Some true), "Add #light to the top of the generated file (the default for .fs output files)";
|
|
"--light-off", Arg.Unit (fun () -> light := Some false), "Add #light \"off\" to the top of the generated file";
|
|
"--lexlib", Arg.String (fun s -> lexlib <- s), "Specify the namespace for the implementation of the lexer table interperter (default Microsoft.FSharp.Text.Lexing)";
|
|
"--unicode", Arg.Set unicode, "Produce a lexer for use with 16-bit unicode characters.";
|
|
]
|
|
|
|
let _ = Arg.parse usage (fun x -> match !input with Some _ -> failwith "more than one input given" | None -> input := Some x) "fslex <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 sentinel = 255 * 256 + 255
|
|
|
|
let lineCount = ref 0
|
|
let cfprintfn (os: #TextWriter) fmt = Printf.ktwprintf (fun () -> incr lineCount; os.WriteLine()) os fmt
|
|
|
|
let main() =
|
|
try
|
|
let filename = (match !input with Some x -> x | None -> failwith "no input given")
|
|
let domain = if !unicode then "Unicode" else "Ascii"
|
|
let spec =
|
|
let stream,reader,lexbuf = UnicodeFileAsLexbuf(filename, !inputCodePage)
|
|
use stream = stream
|
|
use reader = reader
|
|
try
|
|
Fslexpars.spec Fslexlex.token lexbuf
|
|
with e ->
|
|
printf "%s(%d,%d): error: %s" filename lexbuf.StartPos.Line lexbuf.StartPos.Column
|
|
(match e with
|
|
| Failure s -> s
|
|
| _ -> e.Message);
|
|
exit 1
|
|
printfn "compiling to dfas (can take a while...)";
|
|
let perRuleData, dfaNodes = Fslexast.Compile spec
|
|
let dfaNodes = dfaNodes |> List.sortBy (fun n -> n.Id)
|
|
|
|
printfn "%d states" dfaNodes.Length;
|
|
printfn "writing output";
|
|
|
|
let output =
|
|
match !out with
|
|
| Some x -> x
|
|
| _ ->
|
|
Path.Combine (Path.GetDirectoryName filename,Path.GetFileNameWithoutExtension(filename)) + ".fs"
|
|
use os = System.IO.File.CreateText output
|
|
|
|
if (!light = Some(false)) || (!light = None && (Path.HasExtension(output) && Path.GetExtension(output) = ".ml")) then
|
|
cfprintfn os "#light \"off\"";
|
|
else
|
|
cfprintfn os "#light";
|
|
|
|
let (code,pos) = spec.TopCode
|
|
cfprintfn os "# %d \"%s\"" pos.Line pos.FileName;
|
|
cfprintfn os "%s" code;
|
|
lineCount := !lineCount + code.Replace("\r","").Split([| '\n' |]).Length;
|
|
cfprintfn os "# %d \"%s\"" !lineCount output;
|
|
|
|
cfprintfn os "let trans : uint16[] array = ";
|
|
cfprintfn os " [| ";
|
|
if !unicode then
|
|
let specificUnicodeChars = GetSpecificUnicodeChars()
|
|
// This emits a (numLowUnicodeChars+NumUnicodeCategories+(2*#specificUnicodeChars)+1) * #states array of encoded UInt16 values
|
|
|
|
// Each row for the Unicode table has format
|
|
// 128 entries for ASCII characters
|
|
// A variable number of 2*UInt16 entries for SpecificUnicodeChars
|
|
// 30 entries, one for each UnicodeCategory
|
|
// 1 entry for EOF
|
|
//
|
|
// Each entry is an encoded UInt16 value indicating the next state to transition to for this input.
|
|
//
|
|
// For the SpecificUnicodeChars the entries are char/next-state pairs.
|
|
for state in dfaNodes do
|
|
cfprintfn os " (* State %d *)" state.Id;
|
|
twprintf os " [| ";
|
|
let trans =
|
|
let dict = new Dictionary<_,_>()
|
|
state.Transitions |> List.iter dict.Add
|
|
dict
|
|
let emit n =
|
|
if trans.ContainsKey(n) then
|
|
outputCodedUInt16 os trans.[n].Id
|
|
else
|
|
outputCodedUInt16 os sentinel
|
|
for i = 0 to numLowUnicodeChars-1 do
|
|
let c = char i
|
|
emit (EncodeChar c);
|
|
for c in specificUnicodeChars do
|
|
outputCodedUInt16 os (int c);
|
|
emit (EncodeChar c);
|
|
for i = 0 to NumUnicodeCategories-1 do
|
|
emit (EncodeUnicodeCategoryIndex i);
|
|
emit Eof;
|
|
cfprintfn os "|];"
|
|
done;
|
|
|
|
else
|
|
// Each row for the ASCII table has format
|
|
// 256 entries for ASCII characters
|
|
// 1 entry for EOF
|
|
//
|
|
// Each entry is an encoded UInt16 value indicating the next state to transition to for this input.
|
|
|
|
// This emits a (256+1) * #states array of encoded UInt16 values
|
|
for state in dfaNodes do
|
|
cfprintfn os " (* State %d *)" state.Id;
|
|
twprintf os " [|";
|
|
let trans =
|
|
let dict = new Dictionary<_,_>()
|
|
state.Transitions |> List.iter dict.Add
|
|
dict
|
|
let emit n =
|
|
if trans.ContainsKey(n) then
|
|
outputCodedUInt16 os trans.[n].Id
|
|
else
|
|
outputCodedUInt16 os sentinel
|
|
for i = 0 to 255 do
|
|
let c = char i
|
|
emit (EncodeChar c);
|
|
emit Eof;
|
|
cfprintfn os "|];"
|
|
done;
|
|
|
|
cfprintfn os " |] ";
|
|
|
|
twprintf os "let actions : uint16[] = [|";
|
|
for state in dfaNodes do
|
|
if state.Accepted.Length > 0 then
|
|
outputCodedUInt16 os (snd state.Accepted.Head)
|
|
else
|
|
outputCodedUInt16 os sentinel
|
|
done;
|
|
cfprintfn os "|]";
|
|
cfprintfn os "let _fslex_tables = %s.%sTables.Create(trans,actions)" lexlib domain;
|
|
|
|
cfprintfn os "let rec _fslex_dummy () = _fslex_dummy() ";
|
|
List.zip perRuleData spec.Rules
|
|
|> List.iter (fun ((startNode, actions),(ident,args,_)) ->
|
|
cfprintfn os "(* Rule %s *)" ident;
|
|
cfprintfn os "and %s %s (lexbuf : %s.LexBuffer<_>) = _fslex_%s %s %d lexbuf" ident (String.Join(" ",Array.of_list args)) lexlib ident (String.Join(" ",Array.of_list args)) startNode.Id;
|
|
cfprintfn os "and _fslex_%s %s _fslex_state lexbuf =" ident (String.Join(" ",Array.of_list args));
|
|
cfprintfn os " match _fslex_tables.Interpret(_fslex_state,lexbuf) with" ;
|
|
actions |> Seq.iteri (fun i (code,pos) ->
|
|
cfprintfn os " | %d -> ( " i;
|
|
cfprintfn os "# %d \"%s\"" pos.Line pos.FileName;
|
|
let lines = code.Split([| '\r'; '\n' |], StringSplitOptions.RemoveEmptyEntries)
|
|
for line in lines do
|
|
cfprintfn os " %s" line;
|
|
cfprintfn os "# %d \"%s\"" !lineCount output;
|
|
cfprintfn os " )")
|
|
cfprintfn os " | _ -> failwith \"%s\"" ident)
|
|
|
|
let (code,pos) = spec.BottomCode
|
|
cfprintfn os "";
|
|
cfprintfn os "# %d \"%s\"" pos.Line pos.FileName;
|
|
cfprintfn os "%s" code;
|
|
cfprintfn os "# 3000000 \"%s\"" output;
|
|
|
|
with e ->
|
|
printf "Error: %s" (match e with Failure s -> s | e -> e.ToString());
|
|
exit 1
|
|
|
|
|
|
let _ = main()
|
|
|