From 05a47988d9466b827f7dbab44bab33a67228efe9 Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Sun, 30 Jul 2017 00:51:48 +0200 Subject: Start with positional errors (see #5) --- Sil/Parse.icl | 105 ++++++++++++++++++++++++++++++---------------------------- 1 file changed, 54 insertions(+), 51 deletions(-) (limited to 'Sil/Parse.icl') diff --git a/Sil/Parse.icl b/Sil/Parse.icl index 16f3fca..be8079e 100644 --- a/Sil/Parse.icl +++ b/Sil/Parse.icl @@ -69,10 +69,10 @@ where name (TMachineCode _) = "machine code" name t = toString t -tokenise :: [Char] -> MaybeError Error [Token] +tokenise :: [Char] -> MaybeError Error [ParseInput Token] tokenise cs = reverse <$> tks cs [] where - tks :: [Char] [Token] -> MaybeError Error [Token] + tks :: [Char] [ParseInput Token] -> MaybeError Error [ParseInput Token] tks [] t = pure t tks ['/':'/':r] t = tks (dropWhile ((<>) '\n') r) t tks ['/':'*':r] t = tks (skipUntilEndOfComment r) t @@ -80,46 +80,47 @@ where skipUntilEndOfComment [] = [] skipUntilEndOfComment ['*':'/':r] = r skipUntilEndOfComment [_:r] = skipUntilEndOfComment r - tks ['.':r=:[c:_]] t | isNameChar c = tks r` [TField $ toString f:t] + tks ['.':r=:[c:_]] t | isNameChar c = tks r` [PI_Token $ TField $ toString f:t] where (f,r`) = span isNameChar r - tks [':':'=':r] t = tks r [TAssign :t] - tks ['=':'=':r] t = tks r [TEquals :t] - tks ['<':'>':r] t = tks r [TUnequals :t] - tks ['<':'=':r] t = tks r [TLe :t] - tks ['>':'=':r] t = tks r [TGe :t] - tks ['<' :r] t = tks r [TLt :t] - tks ['>' :r] t = tks r [TGt :t] - tks ['|':'|':r] t = tks r [TDoubleBar :t] - tks ['&':'&':r] t = tks r [TDoubleAmpersand:t] - tks ['(' :r] t = tks r [TParenOpen :t] - tks [')' :r] t = tks r [TParenClose :t] - tks ['[' :r] t = tks r [TBrackOpen :t] - tks [']' :r] t = tks r [TBrackClose :t] - tks ['{' :r] t = tks r [TBraceOpen :t] - tks ['}' :r] t = tks r [TBraceClose :t] - tks [',' :r] t = tks r [TComma :t] - tks [':' :r] t = tks r [TColon :t] - tks [';' :r] t = tks r [TSemicolon :t] - tks ['!' :r] t = tks r [TExclamation :t] - tks ['~' :r] t = tks r [TTilde :t] - tks ['+' :r] t = tks r [TPlus :t] - tks ['-' :r] t = tks r [TMinus :t] - tks ['*' :r] t = tks r [TStar :t] - tks ['/' :r] t = tks r [TSlash :t] - tks ['%' :r] t = tks r [TPercent :t] - tks ['i':'f' :r=:[n:_]] t | isNotNameChar n = tks r [TIf :t] - tks ['e':'l':'s':'e' :r=:[n:_]] t | isNotNameChar n = tks r [TElse :t] - tks ['w':'h':'i':'l':'e' :r=:[n:_]] t | isNotNameChar n = tks r [TWhile :t] - tks ['r':'e':'t':'u':'r':'n':r=:[n:_]] t | isNotNameChar n = tks r [TReturn:t] - tks ['T':'r':'u':'e' :r=:[n:_]] t | isNotNameChar n = tks r [TLit $ BLit True :t] - tks ['F':'a':'l':'s':'e' :r=:[n:_]] t | isNotNameChar n = tks r [TLit $ BLit False:t] - tks ['|':'~':r] t = tks r` [TMachineCode $ toString c:t] + tks [':':'=':r] t = tks r [PI_Token TAssign :t] + tks ['=':'=':r] t = tks r [PI_Token TEquals :t] + tks ['<':'>':r] t = tks r [PI_Token TUnequals :t] + tks ['<':'=':r] t = tks r [PI_Token TLe :t] + tks ['>':'=':r] t = tks r [PI_Token TGe :t] + tks ['<' :r] t = tks r [PI_Token TLt :t] + tks ['>' :r] t = tks r [PI_Token TGt :t] + tks ['|':'|':r] t = tks r [PI_Token TDoubleBar :t] + tks ['&':'&':r] t = tks r [PI_Token TDoubleAmpersand:t] + tks ['(' :r] t = tks r [PI_Token TParenOpen :t] + tks [')' :r] t = tks r [PI_Token TParenClose :t] + tks ['[' :r] t = tks r [PI_Token TBrackOpen :t] + tks [']' :r] t = tks r [PI_Token TBrackClose :t] + tks ['{' :r] t = tks r [PI_Token TBraceOpen :t] + tks ['}' :r] t = tks r [PI_Token TBraceClose :t] + tks [',' :r] t = tks r [PI_Token TComma :t] + tks [':' :r] t = tks r [PI_Token TColon :t] + tks [';' :r] t = tks r [PI_Token TSemicolon :t] + tks ['!' :r] t = tks r [PI_Token TExclamation :t] + tks ['~' :r] t = tks r [PI_Token TTilde :t] + tks ['+' :r] t = tks r [PI_Token TPlus :t] + tks ['-' :r] t = tks r [PI_Token TMinus :t] + tks ['*' :r] t = tks r [PI_Token TStar :t] + tks ['/' :r] t = tks r [PI_Token TSlash :t] + tks ['%' :r] t = tks r [PI_Token TPercent :t] + tks ['i':'f' :r=:[n:_]] t | isNotNameChar n = tks r [PI_Token TIf :t] + tks ['e':'l':'s':'e' :r=:[n:_]] t | isNotNameChar n = tks r [PI_Token TElse :t] + tks ['w':'h':'i':'l':'e' :r=:[n:_]] t | isNotNameChar n = tks r [PI_Token TWhile :t] + tks ['r':'e':'t':'u':'r':'n':r=:[n:_]] t | isNotNameChar n = tks r [PI_Token TReturn:t] + tks ['T':'r':'u':'e' :r=:[n:_]] t | isNotNameChar n = tks r [PI_Token $ TLit $ BLit True :t] + tks ['F':'a':'l':'s':'e' :r=:[n:_]] t | isNotNameChar n = tks r [PI_Token $ TLit $ BLit False:t] + tks ['|':'~':r] t = tks r` [PI_Token $ TMachineCode $ toString c:t] where (c,r`) = span (not o flip isMember ['\r\n']) r - tks cs=:[h:_] t + tks cs=:[h:r] t + | h == '\n' = tks r [PI_NewLine:t] | isSpace h = tks (dropWhile isSpace cs) t - | isDigit h = tks numrest [TLit $ ILit $ toInt $ toString num:t] + | isDigit h = tks numrest [PI_Token $ TLit $ ILit $ toInt $ toString num:t] | not (isNameChar h) = Error $ P_Invalid "name" h - | otherwise = tks namerest [TName $ toString name:t] + | otherwise = tks namerest [PI_Token $ TName $ toString name:t] where (name,namerest) = span isNameChar cs (num,numrest) = span isDigit cs @@ -129,8 +130,8 @@ where isNotNameChar = not o isNameChar -parse :: ([Token] -> MaybeError Error Program) -parse = fst o runParser program +parse :: ([ParseInput Token] -> MaybeError Error Program) +parse = fst o runParser program o makeParseState program :: Parser Token Program program = @@ -139,16 +140,17 @@ program = eof $> {p_globals=flatten globss, p_funs=fs} -function :: Parser Token Function +function :: Parser Token (Positioned Function) function = type >>= \t -> + getPositioner >>= \pos -> name >>= \n -> item TParenOpen *> seplist TComma arg >>= \args -> item TParenClose *> item TBraceOpen *> codeblock >>= \cb -> - item TBraceClose $> + item TBraceClose $> pos { f_type = t , f_name = n , f_args = args @@ -160,25 +162,26 @@ codeblock = many initialisation >>= \is -> many statement >>= \s -> pure {cb_init=flatten is, cb_content=s} -initialisation :: Parser Token [Initialisation] +initialisation :: Parser Token [Positioned Initialisation] initialisation = - type >>= \t -> - seplist TComma init >>= \nvs -> - item TSemicolon $> - [{init_type=t, init_name=n, init_value=v} \\ (n,v) <- nvs] + type >>= \t -> seplist TComma (init t) <* item TSemicolon where - init = + init t = + getPositioner >>= \pos -> name >>= \n -> optional (item TAssign *> expression) >>= \v -> - pure (n,v) + pure $ pos $ {init_type=t, init_name=n, init_value=v} -statement :: Parser Token Statement -statement = declaration +statement :: Parser Token (Positioned Statement) +statement = + getPositioner >>= \pos -> + ( declaration <|> liftM Application (expression <* item TSemicolon) <|> return <|> if` <|> while <|> machinecode + ) >>= pure o pos where declaration :: Parser Token Statement declaration = liftM2 Declaration name (item TAssign *> expression <* item TSemicolon) -- cgit v1.2.3