diff --git a/src/base/Error.sml b/src/base/Error.sml index 3dc603c..3f9d07c 100644 --- a/src/base/Error.sml +++ b/src/base/Error.sml @@ -88,9 +88,13 @@ struct val {line=lineNum, col=colStart} = Source.absoluteStart pos val {line=lineNum', col=colEnd} = Source.absoluteEnd pos val _ = - if lineNum = lineNum' then () + if lineNum = lineNum' orelse colEnd = 1 then () else raise Fail "ErrorReport.show: end of position past end of line" + val startOffset = Source.absoluteStartOffset pos + val stopOffset = Source.absoluteEndOffset pos + val pointyLen = stopOffset - startOffset + val line = Source.wholeLine pos lineNum val lineNumStr = Int.toString lineNum @@ -99,7 +103,6 @@ struct val leftMargin = lineNumStr ^ " | " val colOffset = colStart-1 - val highlightLen = colEnd - colStart val leftSpaces = spaces (String.size leftMargin + colOffset) @@ -130,7 +133,7 @@ struct [ filestyle ($ (spaces marginSize ^ "| ")) , $ (spaces (colOffset + numTabsBefore)) , TCS.bold (TCS.foreground brightred - ($ (TextFormat.repeatChar highlightLen #"^"))) + ($ (TextFormat.repeatChar pointyLen #"^"))) ] (* , spaces marginSize ^ "|" *) ] diff --git a/src/parse/ParseExpAndDec.sml b/src/parse/ParseExpAndDec.sml index 9e654e7..30f9e3d 100644 --- a/src/parse/ParseExpAndDec.sml +++ b/src/parse/ParseExpAndDec.sml @@ -356,8 +356,8 @@ struct else if isReserved Token.Abstype at i then consume_decAbstype (tok i) (i+1, infdict) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token." , explain = SOME "Expected to see the beginning of a declaration." } @@ -600,8 +600,8 @@ struct val result = if Seq.length elems = 0 then - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token. Missing identifier." , explain = NONE } @@ -639,8 +639,8 @@ struct val result = if Seq.length elems = 0 then - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token. Missing identifier." , explain = NONE } @@ -796,8 +796,8 @@ struct if Restriction.anyOkay restriction then consume_expIfThenElse infdict (tok i) (i+1) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected if-then-else expression." , explain = SOME "Try using parentheses: (if ... then ... else ...)" } @@ -806,8 +806,8 @@ struct if Restriction.anyOkay restriction then consume_expRaise infdict (i+1) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected raise exception." , explain = SOME "Try using parentheses: (raise ...)" } @@ -816,8 +816,8 @@ struct if Restriction.anyOkay restriction then consume_expFn infdict (i+1) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected beginning of anonymous function." , explain = SOME "Try using parentheses: (fn ... => ...)" } @@ -826,8 +826,8 @@ struct if Restriction.anyOkay restriction then consume_expWhile infdict (i+1) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected beginning of while-loop." , explain = SOME "Try using parentheses: (while ... do ...)" } @@ -836,8 +836,8 @@ struct consume_expAfterUnderscore infdict restriction (tok i) (i+1) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token." , explain = SOME "Expected beginning of expression." } @@ -1336,7 +1336,10 @@ struct val lett = tok (i-1) val ((i, infdict), dec) = consume_dec (i, infdict) val (i, inn) = parse_reserved Token.In i - handle Error.Error _ => + handle Error.Error e => + if i >= numToks then + raise Error.Error e + else raise Error.Error { header = "PARSE ERROR" , content = diff --git a/src/parse/ParsePat.sml b/src/parse/ParsePat.sml index 1a5ff94..5f5ed17 100644 --- a/src/parse/ParsePat.sml +++ b/src/parse/ParsePat.sml @@ -106,8 +106,8 @@ struct else if isReserved Token.OpenCurlyBracket i then consume_patRecord infdict (tok i) (i+1) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Parser bug!" , explain = NONE } @@ -211,8 +211,8 @@ struct if isReserved Token.CloseCurlyBracket (i+1) then (i+1, Ast.Pat.DotDotDot (tok i)) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token." , explain = SOME "This can only appear at the end of the record." } @@ -265,8 +265,8 @@ struct ) end else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Invalid token. Expected row of record pattern." , explain = NONE } diff --git a/src/parse/ParseSigExpAndSpec.sml b/src/parse/ParseSigExpAndSpec.sml index 38b04c8..f9a92bb 100644 --- a/src/parse/ParseSigExpAndSpec.sml +++ b/src/parse/ParseSigExpAndSpec.sml @@ -680,8 +680,8 @@ struct else if isReserved Token.Include i then consume_sigSpecInclude (i+1) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token." , explain = SOME "Expected element of signature." } diff --git a/src/parse/ParseSimple.sml b/src/parse/ParseSimple.sml index dc6c5c9..74af0a9 100644 --- a/src/parse/ParseSimple.sml +++ b/src/parse/ParseSimple.sml @@ -50,8 +50,8 @@ struct if isReserved toks rc i then (i+1, Seq.nth toks i) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token. Expected to see " ^ "'" ^ Token.reservedToString rc ^ "'" @@ -70,8 +70,8 @@ struct if check toks Token.isTyVar i then (i+1, Seq.nth toks i) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Expected tyvar." , explain = NONE } @@ -81,8 +81,8 @@ struct if check toks Token.isStrIdentifier i then (i+1, Seq.nth toks i) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Expected structure identifier." , explain = SOME "Must be alphanumeric, and cannot start with a\ \ prime (')" @@ -93,8 +93,8 @@ struct if check toks Token.isStrIdentifier i then (i+1, Seq.nth toks i) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Expected signature identifier." , explain = SOME "Must be alphanumeric, and cannot start with a\ \ prime (')" @@ -105,8 +105,8 @@ struct if check toks Token.isStrIdentifier i then (i+1, Seq.nth toks i) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Expected functor identifier." , explain = SOME "Must be alphanumeric, and cannot start with a\ \ prime (')" @@ -117,8 +117,8 @@ struct if check toks Token.isValueIdentifier i then (i+1, Seq.nth toks i) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token. Expected value identifier." , explain = NONE } @@ -128,8 +128,8 @@ struct if check toks Token.isMaybeLongIdentifier i then (i+1, MaybeLongToken.make (Seq.nth toks i)) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Expected (possibly long) value identifier." , explain = NONE } @@ -138,8 +138,8 @@ struct if check toks Token.isRecordLabel i then (i+1, Seq.nth toks i) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Expected record label." , explain = NONE } @@ -149,8 +149,8 @@ struct if check toks Token.isTyCon i then (i+1, Seq.nth toks i) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token. Invalid type constructor." , explain = NONE } @@ -160,8 +160,8 @@ struct if check toks Token.isMaybeLongTyCon i then (i+1, MaybeLongToken.make (Seq.nth toks i)) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token. Invalid (possibly qualified)\ \ type constructor." , explain = NONE @@ -172,8 +172,8 @@ struct if check toks Token.isMaybeLongStrIdentifier i then (i+1, MaybeLongToken.make (Seq.nth toks i)) else - ParserUtils.error - { pos = Token.getSource (Seq.nth toks i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token. Invalid (possibly qualified)\ \ structure identifier." , explain = NONE diff --git a/src/parse/ParseTy.sml b/src/parse/ParseTy.sml index 16d91e3..67951a8 100644 --- a/src/parse/ParseTy.sml +++ b/src/parse/ParseTy.sml @@ -60,8 +60,8 @@ struct } ) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Parser bug!" , explain = NONE } @@ -201,8 +201,8 @@ struct parse_tyParensOrSequence leftParen (ty :: tys) (comma :: delims) i end else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token." , explain = NONE } @@ -244,8 +244,8 @@ struct } ) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token." , explain = SOME "Expected to see a type constructor." } diff --git a/src/parse/Parser.sml b/src/parse/Parser.sml index d771e5e..fa31800 100644 --- a/src/parse/Parser.sml +++ b/src/parse/Parser.sml @@ -250,8 +250,8 @@ struct consume_strexpLetInEnd infdict (tok i) (i+1) else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token." , explain = SOME "Expected structure expression." } @@ -590,8 +590,8 @@ struct ((i, infdict), Ast.StrDec strdec) end else - ParserUtils.error - { pos = Token.getSource (tok i) + ParserUtils.tokError toks + { pos = i , what = "Unexpected token." , explain = SOME "Invalid start of top-level declaration." } diff --git a/src/parse/ParserUtils.sml b/src/parse/ParserUtils.sml index 78b1329..55136df 100644 --- a/src/parse/ParserUtils.sml +++ b/src/parse/ParserUtils.sml @@ -5,7 +5,9 @@ structure ParserUtils: sig - val error: {what: string, pos: Source.t, explain: string option} -> 'a + val error: {pos: Source.t, what: string, explain: string option} -> 'a + val tokError: + Token.t Seq.t -> {pos: int, what: string, explain: string option} -> 'a val errorIfInfixNotOpped: InfixDict.t -> Token.t option -> Token.t -> unit @@ -21,6 +23,25 @@ struct , explain = explain }) + fun tokError toks {what, pos, explain} = + if pos >= Seq.length toks then + let + val wholeSrc = Source.wholeFile (Token.getSource (Seq.nth toks 0)) + val src = Source.drop wholeSrc (Source.length wholeSrc - 1) + in + error + { pos = src + , what = "Unexpected end of file." + , explain = NONE + } + end + else + error + { pos = Token.getSource (Seq.nth toks pos) + , what = what + , explain = explain + } + fun errorIfInfixNotOpped infdict opp vid = if InfixDict.isInfix infdict vid andalso not (Option.isSome opp) then error diff --git a/test/fail/unexpected-eof-10.sml b/test/fail/unexpected-eof-10.sml new file mode 100644 index 0000000..2cf956a --- /dev/null +++ b/test/fail/unexpected-eof-10.sml @@ -0,0 +1 @@ +structure X: sig end = struct diff --git a/test/fail/unexpected-eof-2.sml b/test/fail/unexpected-eof-2.sml new file mode 100644 index 0000000..b2c0943 --- /dev/null +++ b/test/fail/unexpected-eof-2.sml @@ -0,0 +1 @@ +val _ = let diff --git a/test/fail/unexpected-eof-3.sml b/test/fail/unexpected-eof-3.sml new file mode 100644 index 0000000..30dd602 --- /dev/null +++ b/test/fail/unexpected-eof-3.sml @@ -0,0 +1 @@ +structure diff --git a/test/fail/unexpected-eof-4.sml b/test/fail/unexpected-eof-4.sml new file mode 100644 index 0000000..b661f6f --- /dev/null +++ b/test/fail/unexpected-eof-4.sml @@ -0,0 +1 @@ +functor diff --git a/test/fail/unexpected-eof-5.sml b/test/fail/unexpected-eof-5.sml new file mode 100644 index 0000000..595c7d8 --- /dev/null +++ b/test/fail/unexpected-eof-5.sml @@ -0,0 +1 @@ +functor F diff --git a/test/fail/unexpected-eof-6.sml b/test/fail/unexpected-eof-6.sml new file mode 100644 index 0000000..aa80e64 --- /dev/null +++ b/test/fail/unexpected-eof-6.sml @@ -0,0 +1 @@ +type diff --git a/test/fail/unexpected-eof-7.sml b/test/fail/unexpected-eof-7.sml new file mode 100644 index 0000000..ba34e44 --- /dev/null +++ b/test/fail/unexpected-eof-7.sml @@ -0,0 +1 @@ +fun a b c diff --git a/test/fail/unexpected-eof-8.sml b/test/fail/unexpected-eof-8.sml new file mode 100644 index 0000000..c9281d2 --- /dev/null +++ b/test/fail/unexpected-eof-8.sml @@ -0,0 +1 @@ +infix diff --git a/test/fail/unexpected-eof-9.sml b/test/fail/unexpected-eof-9.sml new file mode 100644 index 0000000..fbc595d --- /dev/null +++ b/test/fail/unexpected-eof-9.sml @@ -0,0 +1 @@ +val x = true andalso