Skip to content

Add ranges to identifiers and code blocks in the ASTs #146

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

Draft
wants to merge 5 commits into
base: master
Choose a base branch
from
Draft

Add ranges to identifiers and code blocks in the ASTs #146

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
910b234
wip: add range to tokens
baronfel Feb 6, 2021
b617c9d
WIP add ranges to fsyaccast
baronfel Feb 7, 2021
cdf9e34
thread through changes for Ranges through all projects
baronfel Feb 7, 2021
d32363d
update xml docs comments and lex driver output to not include ranges …
baronfel Jul 11, 2021
78896bb
update test baselines
baronfel Jul 11, 2021
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
108 changes: 54 additions & 54 deletions src/Common/Arg.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
// (c) Microsoft Corporation 2005-2009.
// (c) Microsoft Corporation 2005-2009.

namespace FSharp.Text

type ArgType =
type ArgType =
| ClearArg of bool ref
| FloatArg of (float -> unit)
| IntArg of (int -> unit)
Expand All @@ -19,22 +19,22 @@ type ArgType =
static member Unit r = UnitArg r


type ArgInfo (name,action,help) =
type ArgInfo (name,action,help) =
member x.Name = name
member x.ArgType = action
member x.HelpText = help

exception Bad of string
exception HelpText of string

[<Sealed>]
type ArgParser() =
static let getUsage specs u =
let sbuf = new System.Text.StringBuilder 100
let pstring (s:string) = sbuf.Append s |> ignore
let pendline s = pstring s; pstring "\n"
type ArgParser() =
static let getUsage specs u =
let sbuf = new System.Text.StringBuilder 100
let pstring (s:string) = sbuf.Append s |> ignore
let pendline s = pstring s; pstring "\n"
pendline u;
List.iter (fun (arg:ArgInfo) ->
List.iter (fun (arg:ArgInfo) ->
match arg.Name, arg.ArgType, arg.HelpText with
| (s, (UnitArg _ | SetArg _ | ClearArg _), helpText) -> pstring "\t"; pstring s; pstring ": "; pendline helpText
| (s, StringArg _, helpText) -> pstring "\t"; pstring s; pstring " <string>: "; pendline helpText
Expand All @@ -47,82 +47,82 @@ type ArgParser() =
sbuf.ToString()


static member ParsePartial(cursor,argv,argSpecs:seq<ArgInfo>,?other,?usageText) =
Copy link
Collaborator Author

Choose a reason for hiding this comment

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

These changes were all to address some signature file/implementation argument name mismatch warnings.

let other = defaultArg other (fun _ -> ())
static member ParsePartial(cursor,argv,arguments:seq<ArgInfo>,?otherArgs,?usageText) =
let other = defaultArg otherArgs (fun _ -> ())
let usageText = defaultArg usageText ""
let nargs = Array.length argv
let nargs = Array.length argv
incr cursor;
let argSpecs = argSpecs |> Seq.toList
let argSpecs = arguments |> Seq.toList
let specs = argSpecs |> List.map (fun (arg:ArgInfo) -> arg.Name, arg.ArgType)
while !cursor < nargs do
let arg = argv.[!cursor]
let rec findMatchingArg args =
let arg = argv.[!cursor]
let rec findMatchingArg args =
match args with
| ((s, action) :: _) when s = arg ->
let getSecondArg () =
if !cursor + 1 >= nargs then
| ((s, action) :: _) when s = arg ->
let getSecondArg () =
if !cursor + 1 >= nargs then
raise(Bad("option "+s+" needs an argument.\n"+getUsage argSpecs usageText));
argv.[!cursor+1]
match action with
| UnitArg f ->
f ();
argv.[!cursor+1]

match action with
| UnitArg f ->
f ();
incr cursor
| SetArg f ->
f := true;
f := true;
incr cursor
| ClearArg f ->
f := false;
| ClearArg f ->
f := false;
incr cursor
| StringArg f->
let arg2 = getSecondArg()
f arg2;
| StringArg f->
let arg2 = getSecondArg()
f arg2;
cursor := !cursor + 2
| IntArg f ->
let arg2 = getSecondArg ()
let arg2 = try int32 arg2 with _ -> raise(Bad(getUsage argSpecs usageText)) in
| IntArg f ->
let arg2 = getSecondArg ()
let arg2 = try int32 arg2 with _ -> raise(Bad(getUsage argSpecs usageText)) in
f arg2;
cursor := !cursor + 2;
| FloatArg f ->
let arg2 = getSecondArg()
let arg2 = try float arg2 with _ -> raise(Bad(getUsage argSpecs usageText)) in
f arg2;
| FloatArg f ->
let arg2 = getSecondArg()
let arg2 = try float arg2 with _ -> raise(Bad(getUsage argSpecs usageText)) in
f arg2;
cursor := !cursor + 2;
| RestArg f ->
| RestArg f ->
incr cursor;
while !cursor < nargs do
f (argv.[!cursor]);
incr cursor;

| (_ :: more) -> findMatchingArg more
| [] ->
| (_ :: more) -> findMatchingArg more
| [] ->
if arg = "-help" || arg = "--help" || arg = "/help" || arg = "/help" || arg = "/?" then
raise (HelpText (getUsage argSpecs usageText))
// Note: for '/abc/def' does not count as an argument
// Note: '/abc' does
elif arg.Length>0 && (arg.[0] = '-' || (arg.[0] = '/' && not (arg.Length > 1 && arg.[1..].Contains ("/")))) then
raise (Bad ("unrecognized argument: "+ arg + "\n" + getUsage argSpecs usageText))
else
else
other arg;
incr cursor
findMatchingArg specs
findMatchingArg specs

static member Usage (specs,?usage) =
static member Usage (arguments,?usage) =
let usage = defaultArg usage ""
System.Console.Error.WriteLine (getUsage (Seq.toList specs) usage)
System.Console.Error.WriteLine (getUsage (Seq.toList arguments) usage)

#if FX_NO_COMMAND_LINE_ARGS
#else
static member Parse (specs,?other,?usageText) =
static member Parse (arguments,?otherArgs,?usageText) =
let current = ref 0
let argv = System.Environment.GetCommandLineArgs()
try ArgParser.ParsePartial (current, argv, specs, ?other=other, ?usageText=usageText)
with
| Bad h
| HelpText h ->
System.Console.Error.WriteLine h;
System.Console.Error.Flush();
System.Environment.Exit(1);
| e ->
let argv = System.Environment.GetCommandLineArgs()
try ArgParser.ParsePartial (current, argv, arguments, ?otherArgs=otherArgs, ?usageText=usageText)
with
| Bad h
| HelpText h ->
System.Console.Error.WriteLine h;
System.Console.Error.Flush();
System.Environment.Exit(1);
| e ->
reraise()
#endif
33 changes: 17 additions & 16 deletions src/FsLex.Core/fslexast.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Copy link
Collaborator Author

Choose a reason for hiding this comment

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

the primary change is to add a Range to the various identifier/text structures, and from there flow the effects of that change up to things like error reporting.

type Code = string * Range


type ParseContext = {
Expand Down Expand Up @@ -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 }
Copy link
Collaborator Author

Choose a reason for hiding this comment

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

adding types around these structures instead of tuples helps readability


type Rule = { Name: Ident; Arguments: Ident list; Clauses: Clause list }
type Macro = { Name: Ident; Matcher: Regexp }

type Spec =
{ TopCode: Code
Expand Down Expand Up @@ -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()
Expand All @@ -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
Expand All @@ -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.
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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)
Expand Down
11 changes: 6 additions & 5 deletions src/FsLex.Core/fslexdriver.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -175,13 +175,14 @@ 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))
let argumentNames = args |> List.map fst |> Array.ofList
writer.writeLine "and %s %s lexbuf =" ident (String.Join(" ", argumentNames))
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
Expand Down
2 changes: 1 addition & 1 deletion src/FsLex.Core/fslexlex.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -579,7 +579,7 @@ and code p buff lexbuf =
match _fslex_tables.Interpret(28,lexbuf) with
| 0 -> (
# 155 "fslexlex.fsl"
CODE (buff.ToString(), p)
CODE (buff.ToString(), { startPos = p; endPos = lexbuf.EndPos })
# 583 "fslexlex.fs"
)
| 1 -> (
Expand Down
2 changes: 1 addition & 1 deletion src/FsLex.Core/fslexlex.fsl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading