aboutsummaryrefslogtreecommitdiff
path: root/Sil/Parse.icl
diff options
context:
space:
mode:
Diffstat (limited to 'Sil/Parse.icl')
-rw-r--r--Sil/Parse.icl105
1 files changed, 54 insertions, 51 deletions
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)
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-12 19:56:41 +0000