wip: add range to tokens

Author: baronfel

src/FsLex.Core/fslexast.fs

@@ -6,8 +6,8 @@ open System.Collections.Generic
 open System.Globalization
 open FSharp.Text.Lexing
 
-type Ident = string
-type Code = string * Position
+type Ident = string * Range
+type Code = string * Range
 
 
 type ParseContext = {
@@ -144,10 +144,11 @@ type Regexp =
   | Inp of Input
   | Star of Regexp
   | Macro of Ident
-type Clause = Regexp * Code
 
-type Rule = (Ident * Ident list * Clause list)
-type Macro = Ident * Regexp
+type Clause = { Matcher: Regexp; Code: Code }
+
+type Rule = { Name: Ident; Arguments: Ident list; Clauses: Clause list }
+type Macro = { Name: Ident; Matcher: Regexp }
 
 type Spec =
     { TopCode: Code
@@ -192,7 +193,7 @@ type NfaNodeMap() =
         map.[nodeId] <-node
         node
 
-let LexerStateToNfa ctx (macros: Map<string,_>) (clauses: Clause list) =
+let LexerStateToNfa ctx (macros: Map<string,Macro>) (clauses: Clause list) =
 
     /// Table allocating node ids
     let nfaNodeMap = new NfaNodeMap()
@@ -201,7 +202,7 @@ let LexerStateToNfa ctx (macros: Map<string,_>) (clauses: Clause list) =
     let rec CompileRegexp re dest =
         match re with
         | Alt res ->
-            let trs = res ctx |> List.map (fun re -> (Epsilon,CompileRegexp re dest))
+            let trs = res ctx |> List.map (fun re -> (Epsilon, CompileRegexp re dest))
             nfaNodeMap.NewNfaNode(trs,[])
         | Seq res ->
             List.foldBack (CompileRegexp) res dest
@@ -224,9 +225,9 @@ let LexerStateToNfa ctx (macros: Map<string,_>) (clauses: Clause list) =
             let sre = CompileRegexp re nfaNode
             AddToMultiMap nfaNode.Transitions Epsilon sre
             nfaNodeMap.NewNfaNode([(Epsilon,sre); (Epsilon,dest)],[])
-        | Macro m ->
-            if not <| macros.ContainsKey(m) then failwithf "The macro %s is not defined" m
-            CompileRegexp macros.[m] dest
+        | Macro (name, _) as m ->
+            if not <| macros.ContainsKey(name) then failwithf "The macro %s is not defined" name
+            CompileRegexp macros.[name].Matcher dest
 
         // These cases unwind the difficult cases in the syntax that rely on knowing the
         // entire alphabet.
@@ -274,13 +275,13 @@ let LexerStateToNfa ctx (macros: Map<string,_>) (clauses: Clause list) =
     let actions = new System.Collections.Generic.List<_>()
 
     /// Compile an acceptance of a regular expression into the NFA
-    let sTrans macros nodeId (regexp,code) =
+    let sTrans macros nodeId { Matcher = regexp; Code = code } =
         let actionId = actions.Count
         actions.Add(code)
-        let sAccept = nfaNodeMap.NewNfaNode([],[(nodeId,actionId)])
+        let sAccept = nfaNodeMap.NewNfaNode([], [(nodeId, actionId)])
         CompileRegexp regexp sAccept
 
-    let trs = clauses |> List.mapi (fun n x -> (Epsilon,sTrans macros n x))
+    let trs = clauses |> List.mapi (fun n x -> (Epsilon, sTrans macros n x))
     let nfaStartNode = nfaNodeMap.NewNfaNode(trs,[])
     nfaStartNode,(actions |> Seq.readonly), nfaNodeMap
 
@@ -407,10 +408,10 @@ let NfaToDfa (nfaNodeMap:NfaNodeMap) nfaStartNode =
     ruleStartNode,ruleNodes
 
 let Compile ctx spec =
-    let macros = Map.ofList spec.Macros
+    let macros = Map.ofList (spec.Macros |> List.map (fun m -> fst m.Name, m))
     List.foldBack
-        (fun (name,args,clauses) (perRuleData,dfaNodes) ->
-            let nfa, actions, nfaNodeMap = LexerStateToNfa ctx macros clauses
+        (fun rule (perRuleData,dfaNodes) ->
+            let nfa, actions, nfaNodeMap = LexerStateToNfa ctx macros rule.Clauses
             let ruleStartNode, ruleNodes = NfaToDfa nfaNodeMap nfa
             //printfn "name = %s, ruleStartNode = %O" name ruleStartNode.Id
             (ruleStartNode,actions) :: perRuleData, ruleNodes @ dfaNodes)

src/FsLex.Core/fslexdriver.fs

@@ -36,7 +36,7 @@ type Writer(fileName) =
     member x.write fmt =
         Printf.fprintf os fmt
 
-    member x.writeCode (code, pos: Position) =
+    member x.writeCode (code, { startPos = pos }) =
         if pos <> Position.Empty  // If bottom code is unspecified, then position is empty.
         then
             x.writeLine "# %d \"%s\"" pos.Line pos.FileName
@@ -175,13 +175,13 @@ let writeRules (rules: Rule list) (perRuleData: PerRuleData) outputFileName (wri
     // These actions push the additional start state and come first, because they are then typically inlined into later
     // rules. This means more tailcalls are taken as direct branches, increasing efficiency and
     // improving stack usage on platforms that do not take tailcalls.
-    for ((startNode, actions),(ident,args,_)) in List.zip perRuleData rules do
+    for ((startNode, actions),{ Name = (ident, _); Arguments = args } ) in List.zip perRuleData rules do
         writer.writeLine "// Rule %s" ident
         writer.writeLine "and %s %s lexbuf =" ident (String.Join(" ", Array.ofList args))
         writer.writeLine "  match _fslex_tables.Interpret(%d,lexbuf) with" startNode.Id
-        actions |> Seq.iteri (fun i (code:string, pos) ->
+        actions |> Seq.iteri (fun i (code:string, range) ->
             writer.writeLine "  | %d -> ( " i
-            writer.writeLine "# %d \"%s\"" pos.Line pos.FileName
+            writer.writeLine "# %d \"%s\"" range.startPos.Line range.startPos.FileName
             let lines = code.Split([| '\r'; '\n' |], StringSplitOptions.RemoveEmptyEntries)
             for line in lines do
                 writer.writeLine "               %s" line

src/FsLex.Core/fslexlex.fsl

@@ -152,7 +152,7 @@ and string p buff = parse
  | _ { let _ = buff.Append (lexeme lexbuf).[0] in
        string p buff lexbuf }
 and code p buff = parse
- | "}" { CODE (buff.ToString(), p) }
+ | "}" { CODE (buff.ToString(), { startPos = p; endPos = lexbuf.EndPos }) }
  | "{" { let _ = buff.Append (lexeme lexbuf) in 
          ignore(code p buff lexbuf); 
          let _ = buff.Append "}" in

src/FsLex.Core/fslexpars.fsy

@@ -26,9 +26,12 @@ spec:
     { TopCode=$1;Macros=$2;Rules=$4;BottomCode=$5 }
 }
 
+ident:
+| IDENT { $1, parseState.InputRange 1 }
+
 codeopt:
 | CODE { $1 }
-| { "", (parseState.ResultRange |> fst) }
+| { "", parseState.ResultRange }
 
 Macros:
 | { [] }
@@ -37,8 +40,8 @@ Macros:
 }
 
 macro:
-| LET IDENT EQUALS regexp {
-    ($2, $4)
+| LET ident EQUALS regexp {
+    { Name = $2; Matcher = $4 }
 }
 
 Rules:
@@ -48,13 +51,13 @@ Rules:
 | rule { [$1] }
 
 rule:
-| IDENT args EQUALS PARSE optbar clauses {
-    ($1,$2,$6)
+| ident args EQUALS PARSE optbar clauses {
+    { Name = $1; Arguments = $2; Clauses = $6 }
 }
 
 args:
 |  { [] }
-| IDENT args { $1 :: $2 }
+| ident args { $1 :: $2 }
 
 optbar:
 | { }
@@ -65,15 +68,15 @@ clauses:
 | clause { [$1] }
 
 clause:
-| regexp CODE { $1, $2 }
+| regexp CODE { { Matcher = $1; Code = $2 } }
 
 regexp:
 | CHAR { Inp(Alphabet(EncodeChar $1))}
 | UNICODE_CATEGORY { Inp(UnicodeCategory $1)}
 | EOF { Inp(Alphabet(fun ctx -> Eof))}
 | UNDERSCORE { Inp Any }
 | STRING { Seq([ for n in 0 .. $1.Length - 1 -> Inp(Alphabet(EncodeChar $1.[n]))])}
-| IDENT { Macro($1) }
+| ident { Macro($1) }
 | regexp regexp %prec regexp_seq  { Seq[$1;$2] }
 | regexp PLUS %prec regexp_plus  { Seq[$1;Star $1] }
 | regexp STAR %prec regexp_star  { Star $1 }

src/FsLexYacc.Runtime/Lexing.fs

@@ -6,6 +6,7 @@ module FSharp.Text.Lexing
 open System.Collections.Generic
 
 // REVIEW: This type showed up on a parsing-intensive performance measurement. Consider whether it can be a struct-record later when we have this feature. -jomo
+
 [<Struct>]
 type Position = 
     { pos_fname : string
@@ -61,6 +62,7 @@ type Position =
           pos_bol= 0 
           pos_cnum=0 }
 
+type [<Struct>] Range = { startPos: Position; endPos: Position }
 type LexBufferFiller<'char> = 
     { fillSync : (LexBuffer<'char> -> unit) option
       fillAsync : (LexBuffer<'char> -> Async<unit>) option } 

src/FsLexYacc.Runtime/Lexing.fsi

@@ -70,6 +70,8 @@ type Position =
      /// Get a position corresponding to the first line (line number 1) in a given file
      static member FirstLine : filename:string -> Position
 
+type [<Struct>] Range = { startPos: Position; endPos: Position }
+
 [<Sealed>]
 /// Input buffers consumed by lexers generated by <c>fslex.exe </c>
 type LexBuffer<'char> =

src/FsLexYacc.Runtime/Parsing.fs

@@ -7,13 +7,13 @@ open System
 open System.Collections.Generic
 
 type IParseState = 
-    abstract InputRange: int -> Position * Position
+    abstract InputRange: int -> Range
 
     abstract InputEndPosition: int -> Position 
 
     abstract InputStartPosition: int -> Position 
 
-    abstract ResultRange: Position * Position
+    abstract ResultRange: Range
 
     abstract GetInput: int -> obj 
 
@@ -254,11 +254,11 @@ module Implementation =
 
         let parseState =                                                                                            
             { new IParseState with 
-                member __.InputRange(n) = ruleStartPoss.[n-1], ruleEndPoss.[n-1] 
+                member __.InputRange(n) = { startPos = ruleStartPoss.[n-1]; endPos = ruleEndPoss.[n-1] }
                 member __.InputStartPosition(n) = ruleStartPoss.[n-1]
                 member __.InputEndPosition(n) = ruleEndPoss.[n-1] 
                 member __.GetInput(n)    = ruleValues.[n-1]        
-                member __.ResultRange    = (lhsPos.[0], lhsPos.[1])  
+                member __.ResultRange    = { startPos = lhsPos.[0]; endPos = lhsPos.[1] }
                 member __.ParserLocalStore = (localStore :> IDictionary<_,_>) 
                 member __.RaiseError()  = raise RecoverableParseError  (* NOTE: this binding tests the fairly complex logic associated with an object expression implementing a generic abstract method *)
             }       

src/FsLexYacc.Runtime/Parsing.fsi

@@ -10,7 +10,7 @@ open System.Collections.Generic
 /// The information accessible via the <c>parseState</c> value within parser actions.
 type IParseState = 
     /// Get the start and end position for the terminal or non-terminal at a given index matched by the production
-    abstract InputRange: index:int -> Position * Position
+    abstract InputRange: index:int -> Range
 
     /// Get the end position for the terminal or non-terminal at a given index matched by the production
     abstract InputEndPosition: int -> Position 
@@ -19,7 +19,7 @@ type IParseState =
     abstract InputStartPosition: int -> Position 
 
     /// Get the full range of positions matched by the production
-    abstract ResultRange: Position * Position
+    abstract ResultRange: Range
 
     /// Get the value produced by the terminal or non-terminal at the given position
     abstract GetInput   : int -> obj