Math.NET Numerics
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.
 
 
 

382 lines
19 KiB

// (c) Microsoft Corporation 2005-2009.
#nowarn "47" // recursive initialization of LexBuffer
#if INTERNALIZED_POWER_PACK
namespace Internal.Utilities.Text.Lexing
#else
namespace Microsoft.FSharp.Text.Lexing
#endif
open Microsoft.FSharp.Core
open Microsoft.FSharp.Collections
open System.Collections.Generic
type Position =
{ pos_fname : string;
pos_lnum : int;
pos_bol : int;
pos_cnum : int; }
member x.FileName = x.pos_fname
member x.Line = x.pos_lnum
member x.Char = x.pos_cnum
member x.AbsoluteOffset = x.pos_cnum
member x.StartOfLine = x.pos_bol
member x.StartOfLineAbsoluteOffset = x.pos_bol
member x.Column = x.pos_cnum - x.pos_bol
member pos.NextLine = {pos with pos_lnum = pos.Line+1; pos_bol = pos.AbsoluteOffset }
member pos.EndOfToken(n) = {pos with pos_cnum=pos.pos_cnum + n }
member pos.AsNewLinePos() = pos.NextLine
member pos.ShiftColumnBy(by) = {pos with pos_cnum = pos.pos_cnum + by}
static member Empty = {pos_fname=""; pos_lnum= 0; pos_bol= 0; pos_cnum=0 }
static member FirstLine(filename) = {pos_fname=filename; pos_lnum= 1; pos_bol= 0; pos_cnum=0 }
type LexBufferFiller<'char> =
{ fillSync : (LexBuffer<'char> -> unit) option
fillAsync : (LexBuffer<'char> -> Async<unit>) option }
and [<Sealed>]
LexBuffer<'char>(filler: LexBufferFiller<'char>) as this =
let context = new Dictionary<string,obj>(1) in
let extendBufferSync = (fun () -> match filler.fillSync with Some refill -> refill this | None -> invalidOp "attempt to read synchronously from an asynchronous lex buffer")
let extendBufferAsync = (fun () -> match filler.fillAsync with Some refill -> refill this | None -> invalidOp "attempt to read asynchronously from a synchronous lex buffer")
let mutable buffer=[||];
/// number of valid charactes beyond bufferScanStart
let mutable bufferMaxScanLength=0;
/// count into the buffer when scanning
let mutable bufferScanStart=0;
/// number of characters scanned so far
let mutable bufferScanLength=0;
/// length of the scan at the last accepting state
let mutable lexemeLength=0;
/// action related to the last accepting state
let mutable bufferAcceptAction=0;
let mutable eof = false;
let mutable startPos = Position.Empty ;
let mutable endPos = Position.Empty
let getLexemeChar () n = buffer.[n+bufferScanStart]
let getLexeme () = buffer.[bufferScanStart..bufferScanStart+lexemeLength-1]
let getLexemeLength () = lexemeLength
// Throw away all the input besides the lexeme
let discardInput () =
let keep = Array.sub buffer bufferScanStart bufferScanLength
let nkeep = keep.Length
Array.blit keep 0 buffer 0 nkeep;
bufferScanStart <- 0;
bufferMaxScanLength <- nkeep
member lexbuf.EndOfScan () : int =
// Printf.eprintf "endOfScan, lexBuffer.lexemeLength = %d\n" lexBuffer.lexemeLength;
if bufferAcceptAction < 0 then
failwith "unrecognized input"
// Printf.printf "endOfScan %d state %d on unconsumed input '%c' (%d)\n" a s (Char.chr inp) inp;
// Printf.eprintf "accept, lexeme = %s\n" (lexeme lexBuffer);
lexbuf.StartPos <- endPos;
lexbuf.EndPos <- endPos.EndOfToken(lexbuf.LexemeLength);
bufferAcceptAction
member lexbuf.StartPos
with get() = startPos
and set(b) = startPos <- b
member lexbuf.EndPos
with get() = endPos
and set(b) = endPos <- b
member lexbuf.Lexeme = Array.sub buffer bufferScanStart lexemeLength
member lexbuf.LexemeChar(n) = buffer.[n+bufferScanStart]
member lexbuf.BufferLocalStore = (context :> IDictionary<_,_>)
member lexbuf.LexemeLength with get() : int = lexemeLength and set v = lexemeLength <- v
member internal lexbuf.Buffer with get() : 'char[] = buffer and set v = buffer <- v
member internal lexbuf.BufferMaxScanLength with get() = bufferMaxScanLength and set v = bufferMaxScanLength <- v
member internal lexbuf.BufferScanLength with get() = bufferScanLength and set v = bufferScanLength <- v
member internal lexbuf.BufferScanStart with get() : int = bufferScanStart and set v = bufferScanStart <- v
member internal lexbuf.BufferAcceptAction with get() = bufferAcceptAction and set v = bufferAcceptAction <- v
member internal lexbuf.RefillBuffer = extendBufferSync
member internal lexbuf.AsyncRefillBuffer = extendBufferAsync
static member LexemeString(lexbuf:LexBuffer<char>) =
new System.String(lexbuf.Buffer,lexbuf.BufferScanStart,lexbuf.LexemeLength)
member lexbuf.IsPastEndOfStream
with get() = eof
and set(b) = eof <- b
member lexbuf.DiscardInput() = discardInput ()
member x.BufferScanPos = bufferScanStart + bufferScanLength
member lexbuf.EnsureBufferSize n =
if lexbuf.BufferScanPos + n >= buffer.Length then
let repl = Array.zeroCreate (lexbuf.BufferScanPos + n)
Array.blit buffer bufferScanStart repl bufferScanStart bufferScanLength;
buffer <- repl
static member FromReadFunctions (syncRead : ('char[] * int * int -> int) option, asyncRead : ('char[] * int * int -> Async<int>) option) : LexBuffer<'char> =
let extension= Array.zeroCreate 4096
let fillers =
{ fillSync =
match syncRead with
| None -> None
| Some read ->
Some (fun lexBuffer ->
let n = read(extension,0,extension.Length)
lexBuffer.EnsureBufferSize n;
Array.blit extension 0 lexBuffer.Buffer lexBuffer.BufferScanPos n;
lexBuffer.BufferMaxScanLength <- lexBuffer.BufferScanLength + n);
fillAsync =
match asyncRead with
| None -> None
| Some read ->
Some (fun lexBuffer ->
async {
let! n = read(extension,0,extension.Length)
lexBuffer.EnsureBufferSize n;
Array.blit extension 0 lexBuffer.Buffer lexBuffer.BufferScanPos n;
lexBuffer.BufferMaxScanLength <- lexBuffer.BufferScanLength + n }) }
new LexBuffer<_>(fillers)
// A full type signature is required on this method because it is used at more specific types within its own scope
static member FromFunction (f : 'char[] * int * int -> int) : LexBuffer<'char> = LexBuffer<_>.FromReadFunctions(Some(f),None)
static member FromAsyncFunction (f : 'char[] * int * int -> Async<int>) : LexBuffer<'char> = LexBuffer<_>.FromReadFunctions(None,Some(f))
static member FromCharFunction f : LexBuffer<char> =
LexBuffer<char>.FromFunction(fun (buff,start,len) ->
let buff2 = Array.zeroCreate len
let n = f buff2 len
Array.blit buff2 0 buff start len
n)
static member FromByteFunction f : LexBuffer<byte> =
LexBuffer<byte>.FromFunction(fun (buff,start,len) ->
let buff2 = Array.zeroCreate len
let n = f buff2 len
Array.blit buff2 0 buff start len
n)
// A full type signature is required on this method because it is used at more specific types within its own scope
static member FromArray (s: 'char[]) : LexBuffer<'char> =
let lexBuffer =
new LexBuffer<_>
{ fillSync = Some (fun _ -> ());
fillAsync = Some (fun _ -> async { return () }) }
let buffer = Array.copy s
lexBuffer.Buffer <- buffer;
lexBuffer.BufferMaxScanLength <- buffer.Length;
lexBuffer
static member FromBytes (arr) = LexBuffer<byte>.FromArray(arr)
static member FromChars (arr) = LexBuffer<char>.FromArray(arr)
static member FromTextReader (tr:System.IO.TextReader) : LexBuffer<char> =
LexBuffer<char>.FromFunction(tr.Read)
static member FromBinaryReader (br:System.IO.BinaryReader) : LexBuffer<byte> =
LexBuffer<byte>.FromFunction(br.Read)
static member FromStream (stream:System.IO.Stream) : LexBuffer<byte> =
LexBuffer<byte>.FromReadFunctions(Some(stream.Read),Some(fun (buf,offset,len) -> stream.AsyncRead(buf,offset=offset,count=len)))
module GenericImplFragments =
let startInterpret(lexBuffer:LexBuffer<_>)=
lexBuffer.BufferScanStart <- lexBuffer.BufferScanStart + lexBuffer.LexemeLength;
lexBuffer.BufferMaxScanLength <- lexBuffer.BufferMaxScanLength - lexBuffer.LexemeLength;
lexBuffer.BufferScanLength <- 0;
lexBuffer.LexemeLength <- 0;
lexBuffer.BufferAcceptAction <- -1;
let afterRefill (trans: uint16[] array,sentinel,lexBuffer:LexBuffer<_>,scanUntilSentinel,endOfScan,state,eofPos) =
// end of file occurs if we couldn't extend the buffer
if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then
let snew = int trans.[state].[eofPos] // == EOF
if snew = sentinel then
endOfScan()
else
if lexBuffer.IsPastEndOfStream then failwith "End of file on lexing stream";
lexBuffer.IsPastEndOfStream <- true;
// Printf.printf "state %d --> %d on eof\n" state snew;
scanUntilSentinel snew
else
scanUntilSentinel state
let onAccept (lexBuffer:LexBuffer<_>,a) =
lexBuffer.LexemeLength <- lexBuffer.BufferScanLength;
lexBuffer.BufferAcceptAction <- a;
open GenericImplFragments
[<Sealed>]
type AsciiTables(trans: uint16[] array, accept: uint16[]) =
/// Interpret tables for an ascii lexer generated by fslex.
member tables.Interpret(initialState,lexBuffer : LexBuffer<byte>) =
let rec scanUntilSentinel state =
let sentinel = 255 * 256 + 255
// Return an endOfScan after consuming the input
let a = int accept.[state]
if a <> sentinel then
onAccept (lexBuffer,a)
if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then
lexBuffer.DiscardInput();
lexBuffer.RefillBuffer ();
// end of file occurs if we couldn't extend the buffer
afterRefill (trans,sentinel,lexBuffer,scanUntilSentinel,lexBuffer.EndOfScan,state,256 (* == EOF *) )
else
// read a character - end the scan if there are no further transitions
let inp = int(lexBuffer.Buffer.[lexBuffer.BufferScanPos])
let snew = int trans.[state].[inp]
if snew = sentinel then
lexBuffer.EndOfScan()
else
lexBuffer.BufferScanLength <- lexBuffer.BufferScanLength + 1;
// Printf.printf "state %d --> %d on '%c' (%d)\n" state snew (Char.chr inp) inp;
scanUntilSentinel snew
startInterpret(lexBuffer)
scanUntilSentinel initialState
/// Interpret tables for an ascii lexer generated by fslex.
member tables.AsyncInterpret(initialState,lexBuffer : LexBuffer<byte>) =
let rec scanUntilSentinel state : Async<int> =
async {
let sentinel = 255 * 256 + 255
// Return an endOfScan after consuming the input
let a = int accept.[state]
if a <> sentinel then
onAccept (lexBuffer,a)
if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then
lexBuffer.DiscardInput();
do! lexBuffer.AsyncRefillBuffer ();
// end of file occurs if we couldn't extend the buffer
return! afterRefill (trans,sentinel,lexBuffer,scanUntilSentinel,endOfScan,state,256 (* == EOF *) )
else
// read a character - end the scan if there are no further transitions
let inp = int(lexBuffer.Buffer.[lexBuffer.BufferScanPos])
let snew = int trans.[state].[inp]
if snew = sentinel then
return! endOfScan()
else
lexBuffer.BufferScanLength <- lexBuffer.BufferScanLength + 1;
return! scanUntilSentinel snew
}
and endOfScan() =
async { return lexBuffer.EndOfScan() }
startInterpret(lexBuffer)
scanUntilSentinel initialState
static member Create(trans,accept) = new AsciiTables(trans,accept)
[<Sealed>]
type UnicodeTables(trans: uint16[] array, accept: uint16[]) =
let sentinel = 255 * 256 + 255
let numUnicodeCategories = 30
let numLowUnicodeChars = 128
let numSpecificUnicodeChars = (trans.[0].Length - 1 - numLowUnicodeChars - numUnicodeCategories)/2
let lookupUnicodeCharacters (state,inp) =
let inpAsInt = int inp
// Is it a fast ASCII character?
if inpAsInt < numLowUnicodeChars then
int trans.[state].[inpAsInt]
else
// Search for a specific unicode character
let baseForSpecificUnicodeChars = numLowUnicodeChars
let rec loop i =
if i >= numSpecificUnicodeChars then
// OK, if we failed then read the 'others' entry in the alphabet,
// which covers all Unicode characters not covered in other
// ways
let baseForUnicodeCategories = numLowUnicodeChars+numSpecificUnicodeChars*2
let unicodeCategory = System.Char.GetUnicodeCategory(inp)
//System.Console.WriteLine("inp = {0}, unicodeCategory = {1}", [| box inp; box unicodeCategory |]);
int trans.[state].[baseForUnicodeCategories + int32 unicodeCategory]
else
// This is the specific unicode character
let c = char (int trans.[state].[baseForSpecificUnicodeChars+i*2])
//System.Console.WriteLine("c = {0}, inp = {1}, i = {2}", [| box c; box inp; box i |]);
// OK, have we found the entry for a specific unicode character?
if c = inp
then int trans.[state].[baseForSpecificUnicodeChars+i*2+1]
else loop(i+1)
loop 0
let eofPos = numLowUnicodeChars + 2*numSpecificUnicodeChars + numUnicodeCategories
// 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
member tables.Interpret(initialState,lexBuffer : LexBuffer<char>) =
let rec scanUntilSentinel state =
// Return an endOfScan after consuming the input
let a = int accept.[state]
if a <> sentinel then
onAccept(lexBuffer,a)
if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then
lexBuffer.DiscardInput();
lexBuffer.RefillBuffer ();
// end of file occurs if we couldn't extend the buffer
afterRefill (trans,sentinel,lexBuffer,scanUntilSentinel,lexBuffer.EndOfScan,state,eofPos)
else
// read a character - end the scan if there are no further transitions
let inp = lexBuffer.Buffer.[lexBuffer.BufferScanPos]
// Find the new state
let snew = lookupUnicodeCharacters (state,inp)
if snew = sentinel then
lexBuffer.EndOfScan()
else
lexBuffer.BufferScanLength <- lexBuffer.BufferScanLength + 1;
// Printf.printf "state %d --> %d on '%c' (%d)\n" s snew (char inp) inp;
scanUntilSentinel snew
startInterpret(lexBuffer)
scanUntilSentinel initialState
member tables.AsyncInterpret(initialState,lexBuffer : LexBuffer<char>) =
let rec scanUntilSentinel state =
async {
// Return an endOfScan after consuming the input
let a = int accept.[state]
if a <> sentinel then
onAccept(lexBuffer,a)
if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then
lexBuffer.DiscardInput();
lexBuffer.RefillBuffer ();
// end of file occurs if we couldn't extend the buffer
return! afterRefill (trans,sentinel,lexBuffer,scanUntilSentinel,endOfScan,state,eofPos)
else
// read a character - end the scan if there are no further transitions
let inp = lexBuffer.Buffer.[lexBuffer.BufferScanPos]
// Find the new state
let snew = lookupUnicodeCharacters (state,inp)
if snew = sentinel then
return! endOfScan()
else
lexBuffer.BufferScanLength <- lexBuffer.BufferScanLength + 1;
return! scanUntilSentinel snew
}
and endOfScan() =
async { return lexBuffer.EndOfScan() }
startInterpret(lexBuffer)
scanUntilSentinel initialState
static member Create(trans,accept) = new UnicodeTables(trans,accept)