Skip to content

Commit 49d7edd

Browse files
Vasily KirichenkoVasily Kirichenko
Vasily Kirichenko
authored and
Vasily Kirichenko
committed
replace some Tuples with PositionTuple and PositionWithColumn structs
make suffixExists and tokenBalancesHeadContext top-level functions to eliminate heap allocations
1 parent 43dc1ef commit 49d7edd

File tree

1 file changed

+73
-62
lines changed

1 file changed

+73
-62
lines changed

‎src/fsharp/LexFilter.fs‎

Lines changed: 73 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -403,13 +403,19 @@ type LexbufState(startPos: Position,
403403
member x.EndPos = endPos
404404
member x.PastEOF = pastEOF
405405

406+
[<Struct>]
407+
type PositionTuple =
408+
val X: Position
409+
val Y: Position
410+
new (x: Position, y: Position) = { X = x; Y = y }
411+
406412
/// Used to save the state related to a token
407413
[<Class>]
408414
type TokenTup =
409415
val Token : token
410416
val LexbufState : LexbufState
411-
val LastTokenPos: Position * Position
412-
new (token,state,lastTokenPos) = { Token=token; LexbufState=state;LastTokenPos=lastTokenPos }
417+
val LastTokenPos: PositionTuple
418+
new (token,state,lastTokenPos) = { Token=token; LexbufState=state; LastTokenPos=lastTokenPos }
413419

414420
/// Returns starting position of the token
415421
member x.StartPos = x.LexbufState.StartPos
@@ -485,6 +491,12 @@ let (|TyparsCloseOp|_|) (txt:string) =
485491
| _ -> None
486492
Some([| for _c in angles do yield GREATER |],afterOp)
487493

494+
[<Struct>]
495+
type PositionWithColumn =
496+
val Position: Position
497+
val Column: int
498+
new (position: Position, column: int) = { Position = position; Column = column }
499+
488500
//----------------------------------------------------------------------------
489501
// build a LexFilter
490502
//--------------------------------------------------------------------------*)
@@ -553,7 +565,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
553565
let tokenLexbufState = getLexbufState()
554566
savedLexbufState <- tokenLexbufState
555567
haveLexbufState <- true
556-
TokenTup(token,tokenLexbufState,(lastTokenStart,lastTokenEnd))
568+
TokenTup(token, tokenLexbufState, PositionTuple(lastTokenStart, lastTokenEnd))
557569

558570
//----------------------------------------------------------------------------
559571
// Fetch a raw token, either from the old lexer or from our delayedStack
@@ -623,7 +635,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
623635
let pushCtxt tokenTup (newCtxt:Context) =
624636
let rec unindentationLimit strict stack =
625637
match newCtxt,stack with
626-
| _, [] -> (newCtxt.StartPos, -1)
638+
| _, [] -> PositionWithColumn (newCtxt.StartPos, -1)
627639

628640
// ignore Vanilla because a SeqBlock is always coming
629641
| _, (CtxtVanilla _ :: rest) -> unindentationLimit strict rest
@@ -635,8 +647,8 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
635647
// '(match' limited by minimum of two
636648
| _,(((CtxtMatch _) as ctxt1) :: CtxtSeqBlock _ :: (CtxtParen ((BEGIN | LPAREN),_) as ctxt2) :: _rest)
637649
-> if ctxt1.StartCol <= ctxt2.StartCol
638-
then (ctxt1.StartPos,ctxt1.StartCol)
639-
else (ctxt2.StartPos,ctxt2.StartCol)
650+
then PositionWithColumn (ctxt1.StartPos,ctxt1.StartCol)
651+
else PositionWithColumn (ctxt2.StartPos,ctxt2.StartCol)
640652

641653
// 'let ... = function' limited by 'let', precisely
642654
// This covers the common form
@@ -645,15 +657,15 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
645657
// | Case1 -> ...
646658
// | Case2 -> ...
647659
| (CtxtMatchClauses _), (CtxtFunction _ :: CtxtSeqBlock _ :: (CtxtLetDecl _ as limitCtxt) :: _rest)
648-
-> (limitCtxt.StartPos,limitCtxt.StartCol)
660+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
649661

650662
// Otherwise 'function ...' places no limit until we hit a CtxtLetDecl etc... (Recursive)
651663
| (CtxtMatchClauses _), (CtxtFunction _ :: rest)
652664
-> unindentationLimit false rest
653665

654666
// 'try ... with' limited by 'try'
655667
| _,(CtxtMatchClauses _ :: (CtxtTry _ as limitCtxt) :: _rest)
656-
-> (limitCtxt.StartPos,limitCtxt.StartCol)
668+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
657669

658670
// 'fun ->' places no limit until we hit a CtxtLetDecl etc... (Recursive)
659671
| _,(CtxtFun _ :: rest)
@@ -672,7 +684,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
672684
// This is a serious thing to allow, but is required since there is no "return" in this language.
673685
// Without it there is no way of escaping special cases in large bits of code without indenting the main case.
674686
| CtxtSeqBlock _, (CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _rest)
675-
-> (limitCtxt.StartPos,limitCtxt.StartCol)
687+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
676688

677689
// Permitted inner-construct precise block alighnment:
678690
// interface ...
@@ -683,7 +695,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
683695
// with ...
684696
// end
685697
| CtxtWithAsAugment _,((CtxtInterfaceHead _ | CtxtMemberHead _ | CtxtException _ | CtxtTypeDefns _) as limitCtxt :: _rest)
686-
-> (limitCtxt.StartPos,limitCtxt.StartCol)
698+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
687699

688700
// Permit unindentation via parentheses (or begin/end) following a 'then', 'else' or 'do':
689701
// if nr > 0 then (
@@ -754,12 +766,12 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
754766
// 'type C = interface ... ' limited by 'type'
755767
// 'type C = struct ... ' limited by 'type'
756768
| _,(CtxtParen ((CLASS | STRUCT | INTERFACE),_) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _)
757-
-> (limitCtxt.StartPos,limitCtxt.StartCol + 1)
769+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol + 1)
758770

759771
// REVIEW: document these
760772
| _,(CtxtSeqBlock _ :: CtxtParen((BEGIN | LPAREN | LBRACK | LBRACK_BAR),_) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _)
761773
| (CtxtSeqBlock _),(CtxtParen ((BEGIN | LPAREN | LBRACE | LBRACK | LBRACK_BAR) ,_) :: CtxtSeqBlock _ :: ((CtxtTypeDefns _ | CtxtLetDecl _ | CtxtMemberBody _ | CtxtWithAsLet _) as limitCtxt) :: _)
762-
-> (limitCtxt.StartPos,limitCtxt.StartCol + 1)
774+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol + 1)
763775

764776
// Permitted inner-construct (e.g. "then" block and "else" block in overall
765777
// "if-then-else" block ) block alighnment:
@@ -768,34 +780,34 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
768780
// elif expr
769781
// else expr
770782
| (CtxtIf _ | CtxtElse _ | CtxtThen _), (CtxtIf _ as limitCtxt) :: _rest
771-
-> (limitCtxt.StartPos,limitCtxt.StartCol)
783+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
772784
// Permitted inner-construct precise block alighnment:
773785
// while ...
774786
// do expr
775787
// done
776788
| (CtxtDo _), ((CtxtFor _ | CtxtWhile _) as limitCtxt) :: _rest
777-
-> (limitCtxt.StartPos,limitCtxt.StartCol)
789+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
778790

779791

780792
// These contexts all require indentation by at least one space
781793
| _,((CtxtInterfaceHead _ | CtxtNamespaceHead _ | CtxtModuleHead _ | CtxtException _ | CtxtModuleBody (_,false) | CtxtIf _ | CtxtWithAsLet _ | CtxtLetDecl _ | CtxtMemberHead _ | CtxtMemberBody _) as limitCtxt :: _)
782-
-> (limitCtxt.StartPos,limitCtxt.StartCol + 1)
794+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol + 1)
783795

784796
// These contexts can have their contents exactly aligning
785797
| _,((CtxtParen _ | CtxtFor _ | CtxtWhen _ | CtxtWhile _ | CtxtTypeDefns _ | CtxtMatch _ | CtxtModuleBody (_,true) | CtxtNamespaceBody _ | CtxtTry _ | CtxtMatchClauses _ | CtxtSeqBlock _) as limitCtxt :: _)
786-
-> (limitCtxt.StartPos,limitCtxt.StartCol)
798+
-> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
787799

788800
match newCtxt with
789801
// Don't bother to check pushes of Vanilla blocks since we've
790802
// always already pushed a SeqBlock at this position.
791803
| CtxtVanilla _ -> ()
792804
| _ ->
793-
let p1,c1 = unindentationLimit true offsideStack
805+
let p1 = unindentationLimit true offsideStack
794806
let c2 = newCtxt.StartCol
795-
if c2 < c1 then
807+
if c2 < p1.Column then
796808
warn tokenTup
797-
(if debug then (sprintf "possible incorrect indentation: this token is offside of context at position %s, newCtxt = %A, stack = %A, newCtxtPos = %s, c1 = %d, c2 = %d" (warningStringOfPos p1) newCtxt offsideStack (stringOfPos (newCtxt.StartPos)) c1 c2)
798-
else (FSComp.SR.lexfltTokenIsOffsideOfContextStartedEarlier(warningStringOfPos p1)) )
809+
(if debug then (sprintf "possible incorrect indentation: this token is offside of context at position %s, newCtxt = %A, stack = %A, newCtxtPos = %s, c1 = %d, c2 = %d" (warningStringOfPos p1.Position) newCtxt offsideStack (stringOfPos (newCtxt.StartPos)) p1.Column c2)
810+
else (FSComp.SR.lexfltTokenIsOffsideOfContextStartedEarlier(warningStringOfPos p1.Position)) )
799811
let newOffsideStack = newCtxt :: offsideStack
800812
if debug then dprintf "--> pushing, stack = %A\n" newOffsideStack
801813
offsideStack <- newOffsideStack
@@ -971,6 +983,45 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
971983
setLexbufState(tokenLexbufState)
972984
prevWasAtomicEnd <- isAtomicExprEndToken(tok)
973985
tok
986+
987+
let rec suffixExists p l = match l with [] -> false | _::t -> p t || suffixExists p t
988+
989+
let tokenBalancesHeadContext token stack =
990+
match token,stack with
991+
| END, (CtxtWithAsAugment(_) :: _)
992+
| (ELSE | ELIF), (CtxtIf _ :: _)
993+
| DONE , (CtxtDo _ :: _)
994+
// WITH balances except in the following contexts.... Phew - an overused keyword!
995+
| WITH , ( ((CtxtMatch _ | CtxtException _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtTry _ | CtxtTypeDefns _ | CtxtMemberBody _) :: _)
996+
// This is the nasty record/object-expression case
997+
| (CtxtSeqBlock _ :: CtxtParen(LBRACE,_) :: _) )
998+
| FINALLY , (CtxtTry _ :: _) ->
999+
true
1000+
1001+
// for x in ienum ...
1002+
// let x = ... in
1003+
| IN , ((CtxtFor _ | CtxtLetDecl _) :: _) ->
1004+
true
1005+
// 'query { join x in ys ... }'
1006+
// 'query { ...
1007+
// join x in ys ... }'
1008+
// 'query { for ... do
1009+
// join x in ys ... }'
1010+
| IN , stack when detectJoinInCtxt stack ->
1011+
true
1012+
1013+
// NOTE: ;; does not terminate a 'namespace' body.
1014+
| SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtNamespaceBody _ :: _) ->
1015+
true
1016+
1017+
| SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtModuleBody (_,true) :: _) ->
1018+
true
1019+
1020+
| t2 , (CtxtParen(t1,_) :: _) ->
1021+
parenTokensBalance t1 t2
1022+
1023+
| _ ->
1024+
false
9741025

9751026
//----------------------------------------------------------------------------
9761027
// Parse and transform the stream of tokens coming from popNextTokenTup, pushing
@@ -1042,7 +1093,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
10421093
// span of inserted token lasts from the col + 1 of the prev token
10431094
// to the beginning of current token
10441095
let lastTokenPos =
1045-
let pos = snd tokenTup.LastTokenPos
1096+
let pos = tokenTup.LastTokenPos.Y
10461097
pos.ShiftColumnBy 1
10471098
returnToken (lexbufStateForInsertedDummyTokens (lastTokenPos, tokenTup.LexbufState.StartPos)) tok
10481099

@@ -1097,46 +1148,6 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
10971148
| _ ->
10981149
None
10991150

1100-
1101-
let tokenBalancesHeadContext token stack =
1102-
match token,stack with
1103-
| END, (CtxtWithAsAugment(_) :: _)
1104-
| (ELSE | ELIF), (CtxtIf _ :: _)
1105-
| DONE , (CtxtDo _ :: _)
1106-
// WITH balances except in the following contexts.... Phew - an overused keyword!
1107-
| WITH , ( ((CtxtMatch _ | CtxtException _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtTry _ | CtxtTypeDefns _ | CtxtMemberBody _) :: _)
1108-
// This is the nasty record/object-expression case
1109-
| (CtxtSeqBlock _ :: CtxtParen(LBRACE,_) :: _) )
1110-
| FINALLY , (CtxtTry _ :: _) ->
1111-
true
1112-
1113-
// for x in ienum ...
1114-
// let x = ... in
1115-
| IN , ((CtxtFor _ | CtxtLetDecl _) :: _) ->
1116-
true
1117-
// 'query { join x in ys ... }'
1118-
// 'query { ...
1119-
// join x in ys ... }'
1120-
// 'query { for ... do
1121-
// join x in ys ... }'
1122-
| IN , stack when detectJoinInCtxt stack ->
1123-
true
1124-
1125-
// NOTE: ;; does not terminate a 'namespace' body.
1126-
| SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtNamespaceBody _ :: _) ->
1127-
true
1128-
1129-
| SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtModuleBody (_,true) :: _) ->
1130-
true
1131-
1132-
| t2 , (CtxtParen(t1,_) :: _) ->
1133-
parenTokensBalance t1 t2
1134-
1135-
| _ ->
1136-
false
1137-
1138-
let rec suffixExists p l = match l with [] -> false | _::t -> p t || suffixExists p t
1139-
11401151
// Balancing rule. Every 'in' terminates all surrounding blocks up to a CtxtLetDecl, and will be swallowed by
11411152
// terminating the corresponding CtxtLetDecl in the rule below.
11421153
// Balancing rule. Every 'done' terminates all surrounding blocks up to a CtxtDo, and will be swallowed by
@@ -2151,7 +2162,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
21512162
| PERCENT_OP s -> (s = "%") || (s = "%%")
21522163
| _ -> true) &&
21532164
nextTokenIsAdjacent tokenTup &&
2154-
not (prevWasAtomicEnd && (snd(tokenTup.LastTokenPos) = startPosOfTokenTup tokenTup))) ->
2165+
not (prevWasAtomicEnd && (tokenTup.LastTokenPos.Y = startPosOfTokenTup tokenTup))) ->
21552166

21562167
let plus =
21572168
match tokenTup.Token with

0 commit comments

Comments
 (0)