@@ -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>]
408414type 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