From 2af6ef1c1bc0a5ed88ba4e0b6c359096db988f47 Mon Sep 17 00:00:00 2001 From: Steve Dunham Date: Fri, 10 Oct 2025 16:26:03 -0700 Subject: [PATCH] File locations are now ranges. --- newt-vscode/src/extension.ts | 26 +++--- playground/src/main.ts | 22 ++--- scripts/test | 4 +- src/Lib/Common.newt | 42 +++++++-- src/Lib/Parser.newt | 4 +- src/Lib/Parser/Impl.newt | 161 ++++++++++++++++++----------------- src/Lib/Syntax.newt | 2 - src/Lib/Token.newt | 26 +----- src/Lib/Tokenizer.newt | 18 ++-- src/Lib/Util.newt | 8 +- src/Main.newt | 4 +- 11 files changed, 167 insertions(+), 150 deletions(-) diff --git a/newt-vscode/src/extension.ts b/newt-vscode/src/extension.ts index 74de8a0..355f604 100644 --- a/newt-vscode/src/extension.ts +++ b/newt-vscode/src/extension.ts @@ -109,21 +109,21 @@ export function activate(context: vscode.ExtensionContext) { } console.log("top data", topData); } - const match = line.match( - /(INFO|WARN|ERROR) at (.*):\((\d+), (\d+)\):\s*(.*)/ - ); + const match = line.match( + /(INFO|WARN|ERROR) at (.*):\((\d+):(\d+)-(\d+):(\d+)\):\s*(.*)/ + ); if (match) { - let [_full, kind, file, line, column, message] = match; - let lnum = Number(line) - 1; - let cnum = Number(column) - 1; - if (file !== fileName) lnum = cnum = 0; - + let [_full, kind, file, line, column, eline, ecol, message] = match; + let lnum = +line - 1; + let cnum = +column - 1; + let elnum = +eline - 1; + let ecnum = +ecol - 1; let start = new vscode.Position(lnum, cnum); - // we don't have the full range, so grab the surrounding word - let end = new vscode.Position(lnum, cnum + 1); - let range = - document.getWordRangeAtPosition(start) ?? - new vscode.Range(start, end); + let end = new vscode.Position(elnum, ecnum); + let range = new vscode.Range(start, end); + if (file !== fileName) { + range = new vscode.Range(new vscode.Position(0,0), new vscode.Position(0,0)); + } // anything indented after the ERROR/INFO line are part of // the message while (lines[i + 1]?.match(/^( )/)) message += "\n" + lines[++i]; diff --git a/playground/src/main.ts b/playground/src/main.ts index d8f1009..2252228 100644 --- a/playground/src/main.ts +++ b/playground/src/main.ts @@ -440,18 +440,20 @@ const processOutput = ( for (let i = 0; i < lines.length; i++) { const line = lines[i]; const match = line.match( - /(INFO|ERROR) at ([^:]+):\((\d+), (\d+)\):\s*(.*)/ + /(INFO|ERROR) at ([^:]+):\((\d+):(\d+)-(\d+):(\d+)\):\s*(.*)/ ); if (match) { - let [_full, kind, file, line, col, message] = match; - let lineNumber = +line; - let column = +col; + let [_full, kind, file, line, col, eline, ecol, message] = match; + let startLineNumber = +line; + let startColumn = +col; + let endLineNumber = +eline; + let endColumn = +ecol // FIXME - pass the real path in if (fn && fn !== file) { - lineNumber = column = 0; + startLineNumber = startColumn = 0; } // we don't have the full range, so grab the surrounding word - let endColumn = column + 1; + // let endColumn = startColumn + 1; // heuristics to grab the entire message: // anything indented @@ -460,13 +462,13 @@ const processOutput = ( while (lines[i + 1]?.match(/^( )/)) { message += "\n" + lines[++i]; } - if (kind === "ERROR" || lineNumber) + if (kind === "ERROR" || startLineNumber) markers.push({ severity: kind === "ERROR" ? "error" : "info", message, - startLineNumber: lineNumber, - endLineNumber: lineNumber, - startColumn: column, + startLineNumber, + endLineNumber, + startColumn, endColumn, }); } diff --git a/scripts/test b/scripts/test index b6e1475..ae44abf 100755 --- a/scripts/test +++ b/scripts/test @@ -18,7 +18,7 @@ for fn in tests/*.newt ; do if [ -f ${fn}.fail ]; then if ! diff -q tmp/${bn}.compile ${fn}.fail; then echo "Compile failure mismatch for $fn" - diff tmp/${bn}.comp ${fn}.fail + diff ${fn}.fail tmp/${bn}.compile failed=$((failed + 1)) continue fi @@ -38,7 +38,7 @@ for fn in tests/*.newt ; do fi if ! diff -q tmp/${bn}.out ${fn}.golden; then echo "Output mismatch for $fn" - diff -q tmp/${bn}.out ${fn}.golden + diff ${fn}.golden tmp/${bn}.out failed=$((failed + 1)) fi fi diff --git a/src/Lib/Common.newt b/src/Lib/Common.newt index df2de90..bd1be71 100644 --- a/src/Lib/Common.newt +++ b/src/Lib/Common.newt @@ -5,6 +5,32 @@ import Data.String import Data.Int import Data.SortedMap +record Bounds where + constructor MkBounds + startLine : Int + startCol : Int + endLine : Int + endCol : Int + +-- FIXME we should handle overlap and out of order.. +instance Add Bounds where + a + b = MkBounds a.startLine a.startCol b.endLine b.endCol + +instance Eq Bounds where + (MkBounds sl sc el ec) == (MkBounds sl' sc' el' ec') = + sl == sl' + && sc == sc' + && el == el' + && ec == ec' + +record WithBounds ty where + constructor MkBounded + val : ty + bounds : Bounds + +emptyBounds : Bounds +emptyBounds = MkBounds 0 0 0 0 + -- l is environment size, this works for both lvl2ix and ix2lvl range : Int → Int → List Int @@ -74,19 +100,19 @@ instance ToJSON Int where record FC where constructor MkFC file : String - start : (Int × Int) + bnds : Bounds instance ToJSON FC where - toJson (MkFC file (line,col)) = JsonObj (("file", toJson file) :: ("line", toJson line) :: ("col", toJson col) :: Nil) + toJson (MkFC file (MkBounds line col endline endcol)) = JsonObj (("file", toJson file) :: ("line", toJson line) :: ("col", toJson col) :: ("endline", toJson endline) :: ("endcol", toJson endcol):: Nil) fcLine : FC -> Int -fcLine (MkFC file (l, c)) = l +fcLine fc = fc.bnds.startLine fcCol : FC -> Int -fcCol (MkFC file (l, c)) = c +fcCol fc = fc.bnds.startCol class HasFC a where @@ -96,7 +122,10 @@ primNS : List String primNS = ("Prim" :: Nil) emptyFC : FC -emptyFC = MkFC "" (0,0) +emptyFC = MkFC "" (MkBounds 0 0 0 0) + +emptyFC' : String → FC +emptyFC' fn = MkFC fn (MkBounds 0 0 0 0) -- Error of a parse @@ -119,7 +148,8 @@ data Error | Postpone FC QName String instance Show FC where - show (MkFC file (l,c)) = "\{file}:(\{show $ l + 1}, \{show $ c + 1})" + -- We add one to the end column so it points after the end, which seems to be what Idris does + show (MkFC file (MkBounds l c el ec)) = "\{file}:(\{show $ l + 1}:\{show $ c + 1}-\{show $ el + 1}:\{show $ ec + 2})" showError : String -> Error -> String diff --git a/src/Lib/Parser.newt b/src/Lib/Parser.newt index dff3dc3..0085094 100644 --- a/src/Lib/Parser.newt +++ b/src/Lib/Parser.newt @@ -9,6 +9,8 @@ import Lib.Syntax import Lib.Token import Lib.Types +-- TODO - anywhere this says getPos, we probably have to fix bounds? It is token sized though. + lazy : ∀ a. (Unit → Parser a) → Parser a lazy pa = pa MkUnit @@ -61,10 +63,8 @@ interp = do token EndInterp pure tm - interpString : Parser Raw interpString = do - -- fc <- getPos ignore $ token StartQuote part <- term parts <- many (stringLit <|> interp) diff --git a/src/Lib/Parser/Impl.newt b/src/Lib/Parser/Impl.newt index b8ca89c..878a741 100644 --- a/src/Lib/Parser/Impl.newt +++ b/src/Lib/Parser/Impl.newt @@ -15,13 +15,13 @@ TokenList = List BTok -- Result of a parse data Result : U -> U where - OK : ∀ a. a -> (toks : TokenList) -> (com : Bool) -> Operators -> Result a - Fail : ∀ a. Bool -> Error -> (toks : TokenList) -> (com : Bool) -> Operators -> Result a + OK : ∀ a. a -> Bounds -> (toks : TokenList) -> (com : Bool) -> Operators -> Result a + Fail : ∀ a. Bool -> Error -> Bounds -> (toks : TokenList) -> (com : Bool) -> Operators -> Result a instance Functor Result where - map f (OK a toks com ops) = OK (f a) toks com ops - map _ (Fail fatal err toks com ops) = Fail fatal err toks com ops + map f (OK a last toks com ops) = OK (f a) last toks com ops + map _ (Fail fatal err last toks com ops) = Fail fatal err last toks com ops -- So sixty just has a newtype function here now (probably for perf). -- A record might be more ergonomic, but would require a record impl before @@ -34,108 +34,97 @@ instance Functor Result where -- Since I've already built out the pratt stuff, I guess I'll -- leave it in the parser for now --- This is a Reader in FC, a State in Operators, Commit flag, TokenList +-- This is a Reader in FC (indent), a State in Operators, Commit flag, TokenList +-- Using FC to pass around the fileName, but the indent only uses line and column +data Parser a = P (Bounds -> TokenList -> Bool -> Operators -> (lc : FC) -> Result a) -data Parser a = P (TokenList -> Bool -> Operators -> (lc : FC) -> Result a) - - -runP : ∀ a. Parser a -> TokenList -> Bool -> Operators -> FC -> Result a +runP : ∀ a. Parser a -> Bounds -> TokenList -> Bool -> Operators -> FC -> Result a runP (P f) = f --- FIXME no filename, also half the time it is pointing at the token after the error +-- FIXME half the time it is pointing at the token after the error perror : String -> TokenList -> String -> Error -perror fn Nil msg = E (MkFC fn (0,0)) msg -perror fn ((MkBounded val (MkBounds line col _ _)) :: _) msg = E (MkFC fn (line,col)) msg +perror fn Nil msg = E (emptyFC' fn) msg +perror fn ((MkBounded val bnds) :: _) msg = E (MkFC fn bnds) msg parse : ∀ a. String -> Parser a -> TokenList -> Either Error a -parse fn pa toks = case runP pa toks False emptyMap (MkFC fn (-1,-1)) of - Fail fatal err toks com ops => Left err - OK a Nil _ _ => Right a - OK a ts _ _ => Left (perror fn ts "Extra toks") +parse fn pa toks = case runP pa emptyBounds toks False emptyMap (MkFC fn (MkBounds -1 -1 -1 -1)) of + Fail fatal err last toks com ops => Left err + OK a _ Nil _ _ => Right a + OK a _ ts _ _ => Left (perror fn ts "Extra toks") -- Intended for parsing a top level declaration partialParse : ∀ a. String -> Parser a -> Operators -> TokenList -> Either (Error × TokenList) (a × Operators × TokenList) -partialParse fn pa ops toks = case runP pa toks False ops (MkFC fn (0,0)) of - Fail fatal err toks com ops => Left (err, toks) - OK a ts _ ops => Right (a,ops,ts) - --- I think I want to drop the typeclasses for v1 - +partialParse fn pa ops toks = case runP pa emptyBounds toks False ops (emptyFC' fn) of + Fail fatal err last toks com ops => Left (err, toks) + OK a last toks _ ops => Right (a,ops,toks) try : ∀ a. Parser a -> Parser a -try (P pa) = P $ \toks com ops col => case pa toks com ops col of - (Fail x err toks com ops) => Fail x err toks False ops +try (P pa) = P $ \last toks com ops col => case pa last toks com ops col of + (Fail x err last toks com ops) => Fail x err last toks False ops res => res fail : ∀ a. String -> Parser a -fail msg = P $ \toks com ops col => Fail False (perror col.file toks msg) toks com ops +fail msg = P $ \last toks com ops col => Fail False (perror col.file toks msg) last toks com ops fatal : ∀ a. String -> Parser a -fatal msg = P $ \toks com ops col => Fail True (perror col.file toks msg) toks com ops +fatal msg = P $ \last toks com ops col => Fail True (perror col.file toks msg) last toks com ops getOps : Parser (Operators) -getOps = P $ \ toks com ops col => OK ops toks com ops +getOps = P $ \last toks com ops col => OK ops last toks com ops addOp : String -> Int -> Fixity -> Parser Unit -addOp nm prec fix = P $ \ toks com ops col => +addOp nm prec fix = P $ \ last toks com ops col => let parts = split nm "_" in case parts of - "" :: key :: rule => OK MkUnit toks com (updateMap key (MkOp nm prec fix False rule) ops) - key :: rule => OK MkUnit toks com (updateMap key (MkOp nm prec fix True rule) ops) - Nil => Fail True (perror col.file toks "Internal error parsing mixfix") toks com ops - - - + "" :: key :: rule => OK MkUnit last toks com (updateMap key (MkOp nm prec fix False rule) ops) + key :: rule => OK MkUnit last toks com (updateMap key (MkOp nm prec fix True rule) ops) + Nil => Fail True (perror col.file toks "Internal error parsing mixfix") last toks com ops instance Functor Parser where - map f (P pa) = P $ \ toks com ops col => map f (pa toks com ops col) + map f (P pa) = P $ \ last toks com ops col => map f (pa last toks com ops col) instance Applicative Parser where - return pa = P (\ toks com ops col => OK pa toks com ops) - P pab <*> P pa = P $ \toks com ops col => - case pab toks com ops col of - Fail fatal err toks com ops => Fail fatal err toks com ops - OK f toks com ops => - case pa toks com ops col of - (OK x toks com ops) => OK (f x) toks com ops - (Fail fatal err toks com ops) => Fail fatal err toks com ops + return pa = P (\ last toks com ops col => OK pa last toks com ops) + P pab <*> P pa = P $ \last toks com ops col => + case pab last toks com ops col of + Fail fatal err last toks com ops => Fail fatal err last toks com ops + OK f last toks com ops => + case pa last toks com ops col of + (OK x last toks com ops) => OK (f x) last toks com ops + (Fail fatal err last toks com ops) => Fail fatal err last toks com ops -- Second argument lazy so we don't have circular refs when defining parsers. instance Alternative Parser where - (P pa) <|> (P pb) = P $ \toks com ops col => - case pa toks False ops col of - OK a toks' _ ops => OK a toks' com ops - Fail True err toks' com ops => Fail True err toks' com ops - Fail fatal err toks' True ops => Fail fatal err toks' True ops - Fail fatal err toks' False ops => pb toks com ops col + (P pa) <|> (P pb) = P $ \last toks com ops col => + case pa last toks False ops col of + OK a last' toks' _ ops => OK a last' toks' com ops + Fail True err last' toks' com ops => Fail True err last' toks' com ops + Fail fatal err last' toks' True ops => Fail fatal err last' toks' True ops + Fail fatal err last' toks' False ops => pb last toks com ops col instance Monad Parser where pure = return - bind (P pa) pab = P $ \toks com ops col => - case pa toks com ops col of - (OK a toks com ops) => runP (pab a) toks com ops col - (Fail fatal err xs x ops) => Fail fatal err xs x ops + bind (P pa) pab = P $ \last toks com ops col => + case pa last toks com ops col of + (OK a last toks com ops) => runP (pab a) last toks com ops col + (Fail fatal err last toks x ops) => Fail fatal err last toks x ops satisfy : (BTok -> Bool) -> String -> Parser String -satisfy f msg = P $ \toks com ops col => +satisfy f msg = P $ \last toks com ops col => case toks of - (t :: ts) => if f t then OK (value t) ts True ops else Fail False (perror col.file toks "\{msg} at \{show t.val.kind}:\{value t}") toks com ops - Nil => Fail False (perror col.file toks "\{msg} at EOF") toks com ops - - -commit : Parser Unit -commit = P $ \toks com ops col => OK MkUnit toks True ops + (t :: ts) => if f t then OK (value t) t.bounds ts True ops else Fail False (perror col.file toks "\{msg} at \{show t.val.kind}:\{value t}") last toks com ops + Nil => Fail False (perror col.file toks "\{msg} at EOF") last toks com ops some : ∀ a. Parser a -> Parser (List a) @@ -154,34 +143,50 @@ sepBy s a = _::_ <$> a <*> many (s *> a) getPos : Parser FC -getPos = P $ \toks com ops indent => case toks of - Nil => OK emptyFC toks com ops - (t :: ts) => OK (MkFC indent.file (getStart t)) toks com ops +getPos = P $ \last toks com ops indent => case toks of + Nil => OK (MkFC indent.file last) last toks com ops + (t :: ts) => OK (MkFC indent.file t.bounds) last toks com ops + +tokStart : TokenList → Bounds +tokStart Nil = emptyBounds +tokStart (t :: ts) = t.bounds + +bounded : ∀ a. Parser a → Parser (WithBounds a) +bounded pa = P $ \last toks com ops indent => + case runP pa last toks com ops indent of + (OK a last toks' com ops) => (OK (MkBounded a (tokStart toks + last)) last toks' com ops) + (Fail fatal err last toks x ops) => Fail fatal err last toks x ops + +withFC : ∀ a. Parser a → Parser (FC × a) +withFC pa = P $ \last toks com ops indent => + case runP pa last toks com ops indent of + (OK a last toks' com ops) => OK ((MkFC indent.file $ tokStart toks + last), a) last toks' com ops + (Fail fatal err last toks x ops) => Fail fatal err last toks x ops + -- Start an indented block and run parser in it startBlock : ∀ a. Parser a -> Parser a -startBlock (P p) = P $ \toks com ops indent => case toks of - Nil => p toks com ops indent +startBlock (P p) = P $ \last toks com ops indent => case toks of + Nil => p last toks com ops indent (t :: _) => -- If next token is at or before the current level, we've got an empty block let (tl,tc) = getStart t in - let (MkFC file (line,col)) = indent in - p toks com ops (MkFC file (tl, ite (tc <= col) (col + 1) tc)) + let (MkFC file (MkBounds line col _ _)) = indent in + p last toks com ops (MkFC file ((ite (tc <= col) (MkBounds tl (col + 1) 0 0) t.bounds))) -- Assert that parser starts at our current column by -- checking column and then updating line to match the current sameLevel : ∀ a. Parser a -> Parser a -sameLevel (P p) = P $ \toks com ops indent => case toks of - Nil => p toks com ops indent +sameLevel (P p) = P $ \last toks com ops indent => case toks of + Nil => p last toks com ops indent (t :: _) => let (tl,tc) = getStart t in - let (MkFC file (line,col)) = indent in - if tc == col then p toks com ops (MkFC file (tl, col)) - else if col < tc then Fail False (perror file toks "unexpected indent") toks com ops - else Fail False (perror file toks "unexpected indent") toks com ops - + let (MkFC file (MkBounds line col _ _)) = indent in + if tc == col then p last toks com ops (MkFC file t.bounds) + else if col < tc then Fail False (perror file toks "unexpected indent") last toks com ops + else Fail False (perror file toks "unexpected indent") last toks com ops someSame : ∀ a. Parser a -> Parser (List a) someSame pa = some $ sameLevel pa @@ -193,12 +198,12 @@ manySame pa = many $ sameLevel pa -- check indent on next token and run parser indented : ∀ a. Parser a -> Parser a -indented (P p) = P $ \toks com ops indent => case toks of - Nil => p toks com ops indent +indented (P p) = P $ \last toks com ops indent => case toks of + Nil => p last toks com ops indent (t :: _) => let (tl,tc) = getStart t - in if tc > fcCol indent || tl == fcLine indent then p toks com ops indent - else Fail False (perror indent.file toks "unexpected outdent") toks com ops + in if tc > fcCol indent || tl == fcLine indent then p last toks com ops indent + else Fail False (perror indent.file toks "unexpected outdent") last toks com ops -- expect token of given kind diff --git a/src/Lib/Syntax.newt b/src/Lib/Syntax.newt index bc0a916..b33b41f 100644 --- a/src/Lib/Syntax.newt +++ b/src/Lib/Syntax.newt @@ -31,8 +31,6 @@ instance HasFC Pattern where getFC (PatWild fc _) = fc getFC (PatLit fc lit) = fc --- %runElab deriveShow `{Pattern} - Constraint : U Constraint = (String × Pattern) diff --git a/src/Lib/Token.newt b/src/Lib/Token.newt index 8cf6cde..5d7aa0a 100644 --- a/src/Lib/Token.newt +++ b/src/Lib/Token.newt @@ -1,28 +1,7 @@ module Lib.Token import Prelude - -record Bounds where - constructor MkBounds - startLine : Int - startCol : Int - endLine : Int - endCol : Int - - -instance Eq Bounds where - (MkBounds sl sc el ec) == (MkBounds sl' sc' el' ec') = - sl == sl' - && sc == sc' - && el == el' - && ec == ec' - - -record WithBounds ty where - constructor MkBounded - val : ty - bounds : Bounds - +import Lib.Common data Kind = Ident @@ -98,3 +77,6 @@ value (MkBounded (Tok _ s) _) = s getStart : BTok -> (Int × Int) getStart (MkBounded _ (MkBounds l c _ _)) = (l,c) + +getEnd : BTok -> (Int × Int) +getEnd (MkBounded _ (MkBounds _ _ el ec)) = (el,ec) diff --git a/src/Lib/Tokenizer.newt b/src/Lib/Tokenizer.newt index 01e5504..6989484 100644 --- a/src/Lib/Tokenizer.newt +++ b/src/Lib/Tokenizer.newt @@ -52,13 +52,13 @@ quoteTokenise ts@(TS el ec toks chars) startl startc acc = case chars of '}' :: cs => let tok = MkBounded (Tok EndInterp "}") (MkBounds el ec el (ec + 1)) in quoteTokenise (TS el (ec + 1) (toks :< tok) cs) el (ec + 1) Lin - cs => Left $ E (MkFC "" (el, ec)) "Expected '{'" + cs => Left $ E (MkFC "" (MkBounds el ec el ec)) "Expected '{'" -- TODO newline in string should be an error - '\n' :: cs => Left $ E (MkFC "" (el, ec)) "Newline in string" + '\n' :: cs => Left $ E (MkFC "" (MkBounds el ec el ec)) "Newline in string" '\\' :: 'n' :: cs => quoteTokenise (TS el (ec + 2) toks cs) startl startc (acc :< '\n') '\\' :: c :: cs => quoteTokenise (TS el (ec + 2) toks cs) startl startc (acc :< c) c :: cs => quoteTokenise (TS el (ec + 1) toks cs) startl startc (acc :< c) - Nil => Left $ E (MkFC "" (el, ec)) "Expected '\"' at EOF" + Nil => Left $ E (MkFC "" (MkBounds el ec el ec)) "Expected '\"' at EOF" where stok : BTok @@ -78,7 +78,7 @@ rawTokenise ts@(TS sl sc toks chars) = case chars of Right (TS sl sc toks chars) => case chars of '"' :: cs => let tok = mktok False sl (sc + 1) EndQuote "\"" in rawTokenise (TS sl (sc + 1) (toks :< tok) cs) - cs => Left $ E (MkFC "" (sl, sc)) "Expected '\"'" + cs => Left $ E (MkFC "" (MkBounds sl sc sl sc)) "Expected '\"'" '{' :: '{' :: cs => let tok = mktok False sl (sc + 2) Keyword "{{" in @@ -87,7 +87,7 @@ rawTokenise ts@(TS sl sc toks chars) = case chars of Right (TS sl sc toks chars) => case chars of '}' :: '}' :: cs => let tok = mktok False sl (sc + 2) Keyword "}}" in rawTokenise (TS sl (sc + 2) (toks :< tok) cs) - cs => Left $ E (MkFC "" (sl, sc)) "Expected '}}'" + cs => Left $ E (MkFC "" (MkBounds sl sc sl sc)) "Expected '}}'" '}' :: cs => Right ts '{' :: cs => @@ -97,7 +97,7 @@ rawTokenise ts@(TS sl sc toks chars) = case chars of Right (TS sl sc toks chars) => case chars of '}' :: cs => let tok = mktok False sl (sc + 1) Symbol "}" in rawTokenise (TS sl (sc + 1) (toks :< tok) cs) - cs => Left $ E (MkFC "" (sl, sc)) "Expected '}'" + cs => Left $ E (MkFC "" (MkBounds sl sc sl sc)) "Expected '}'" ',' :: cs => rawTokenise (TS sl (sc + 1) (toks :< mktok False sl (sc + 1) Ident ",") cs) '_' :: ',' :: '_' :: cs => rawTokenise (TS sl (sc + 3) (toks :< mktok False sl (sc + 3) MixFix "_,_") cs) @@ -125,7 +125,7 @@ rawTokenise ts@(TS sl sc toks chars) = case chars of isUIdent c = isIdent c || c == '.' doBacktick : TState -> SnocList Char -> Either Error TState - doBacktick (TS l c toks Nil) acc = Left $ E (MkFC "" (l,c)) "EOF in backtick string" + doBacktick (TS l c toks Nil) acc = Left $ E (MkFC "" (MkBounds l c l c)) "EOF in backtick string" doBacktick (TS el ec toks ('`' :: cs)) acc = let tok = MkBounded (Tok JSLit (pack $ acc <>> Nil)) (MkBounds sl sc el ec) in rawTokenise (TS el (ec + 1) (toks :< tok) cs) @@ -144,7 +144,7 @@ rawTokenise ts@(TS sl sc toks chars) = case chars of lineComment (TS line col toks (c :: cs)) = lineComment (TS line (col + 1) toks cs) blockComment : TState -> Either Error TState - blockComment (TS line col toks Nil) = Left $ E (MkFC "" (line, col)) "EOF in block comment" + blockComment (TS line col toks Nil) = Left $ E (MkFC "" (MkBounds line col line col)) "EOF in block comment" blockComment (TS line col toks ('-' :: '/' :: cs)) = rawTokenise (TS line (col + 2) toks cs) blockComment (TS line col toks ('\n' :: cs)) = blockComment (TS (line + 1) 0 toks cs) blockComment (TS line col toks (c :: cs)) = blockComment (TS line (col + 1) toks cs) @@ -167,7 +167,7 @@ rawTokenise ts@(TS sl sc toks chars) = case chars of tokenise : String -> String -> Either Error (List BTok) tokenise fn text = case rawTokenise (TS 0 0 Lin (unpack text)) of Right (TS trow tcol acc Nil) => Right $ acc <>> Nil - Right (TS trow tcol acc chars) => Left $ E (MkFC fn (trow, tcol)) "Extra toks" + Right (TS trow tcol acc chars) => Left $ E (MkFC fn (MkBounds trow tcol trow tcol)) "Extra toks" Left (E (MkFC file start) str) => Left $ E (MkFC fn start) str Left err => Left err diff --git a/src/Lib/Util.newt b/src/Lib/Util.newt index 469763b..618c809 100644 --- a/src/Lib/Util.newt +++ b/src/Lib/Util.newt @@ -34,8 +34,8 @@ splitTele = go Nil -getBaseDir : String → String → M (String × QName) -getBaseDir fn modName = do +getBaseDir : String → FC → String → M (String × QName) +getBaseDir fn fc modName = do let (path, modName') = unsnoc $ split1 modName "." let parts = split1 fn "/" let (dirs,file) = unsnoc parts @@ -44,9 +44,9 @@ getBaseDir fn modName = do let parts = split1 fn "/" let (dirs,file) = unsnoc parts let (path, modName') = unsnoc $ split1 modName "." - unless (modName' == name) $ \ _ => error (MkFC fn (0,0)) "module name \{modName'} doesn't match \{name}" + unless (modName' == name) $ \ _ => error fc "module name \{modName'} doesn't match \{name}" let (Right base) = baseDir (Lin <>< dirs) (Lin <>< path) - | Left err => error (MkFC fn (0,0)) err + | Left err => error fc err let base = if base == "" then "." else base pure (base, QN path modName') where diff --git a/src/Main.newt b/src/Main.newt index 83d691d..e54fdc8 100644 --- a/src/Main.newt +++ b/src/Main.newt @@ -217,13 +217,13 @@ processFile fn = do log 1 $ \ _ => "\{show dir} \{show name} \{show ext}" (Right src) <- liftIO {M} $ readFile fn - | Left err => error (MkFC fn (0,0)) "error reading \{fn}: \{show err}" + | Left err => error (emptyFC' fn) "error reading \{fn}: \{show err}" let (Right toks) = tokenise fn src | Left err => throwError err let (Right ((nameFC, modName), _, _)) = partialParse fn parseModHeader emptyMap toks | Left (err,toks) => throwError err - (base,qn) <- getBaseDir fn modName + (base,qn) <- getBaseDir fn nameFC modName -- declare internal primitives