diff options
Diffstat (limited to 'Sil/Parse.icl')
| -rw-r--r-- | Sil/Parse.icl | 47 |
1 files changed, 22 insertions, 25 deletions
diff --git a/Sil/Parse.icl b/Sil/Parse.icl index 6a3999d..2c8272d 100644 --- a/Sil/Parse.icl +++ b/Sil/Parse.icl @@ -141,17 +141,17 @@ parse = fst o runParser program o makeParseState program :: Parser Token Program program = many initialisation >>= \globss -> - some function >>= \fs -> - eof $> - {p_globals=flatten globss, p_funs=fs} + function until eof >>= \fs -> + pure {p_globals=flatten globss, p_funs=reverse fs} function :: Parser Token Function function = type >>= \t -> getPosition >>= \pos -> name >>= \n -> - parenthised (seplist TComma arg) >>= \args -> - braced codeblock >>= \cb -> pure + item TParenOpen *> + seplistUntil TParenClose TComma arg >>= \args -> + codeblock >>= \cb -> pure { f_type = t , f_name = n , f_args = args @@ -160,8 +160,10 @@ function = } codeblock :: Parser Token CodeBlock -codeblock = many initialisation >>= \is -> - many statement >>= \s -> +codeblock = + item TBraceOpen *> + many initialisation >>= \is -> + statement until (item TBraceClose) >>= \s -> pure {cb_init=flatten is, cb_content=s} initialisation :: Parser Token [Initialisation] @@ -182,7 +184,7 @@ statement = <|> if` pos <|> while pos <|> machinecode pos - ) + ) <#> "statement" where declaration :: ParsePosition -> Parser Token Statement declaration p = liftM2 (Declaration p) name (item TAssign *> expression <* item TSemicolon) @@ -197,20 +199,20 @@ where if` :: ParsePosition -> Parser Token Statement if` p = item TIf *> parenthised expression >>= \cond -> - braced codeblock >>= \iftrue -> + codeblock >>= \iftrue -> many elseif >>= \elseifs -> - optional (item TElse *> braced codeblock) >>= \iffalse -> + optional (item TElse *> codeblock) >>= \iffalse -> pure $ If p [(cond,iftrue):elseifs] iffalse where elseif = list [TElse, TIf] *> parenthised expression >>= \cond -> - braced codeblock >>= \block -> + codeblock >>= \block -> pure (cond, block) while :: ParsePosition -> Parser Token Statement while p = item TWhile *> parenthised expression >>= \cond -> - braced codeblock >>= \do -> + codeblock >>= \do -> pure $ While p cond do expression :: Parser Token Expression @@ -244,7 +246,7 @@ where noInfix :: Parser Token Expression noInfix - = liftM2 App name (item TParenOpen *> seplist TComma expression <* item TParenClose) + = liftM2 App name (item TParenOpen *> seplistUntil TParenClose TComma expression) <|> op TTilde Neg <|> op TExclamation Not <|> (simpleExpr >>= \e -> foldl (flip Field) e <$> many field) @@ -258,29 +260,27 @@ where simpleExpr :: Parser Token Expression simpleExpr = liftM Literal literal <|> liftM Name name - <|> (parenthised (min2seplist TComma expression) >>= \es -> pure $ Tuple (length es) es) <|> flip List [] o pure <$> bracked type <|> List Nothing <$> bracked (seplist TComma expression) - <|> parenthised expression + <|> (item TParenOpen *> seplistUntil TParenClose TComma expression >>= \es -> pure $ case es of [x] -> x; _ -> Tuple (length es) es) name :: Parser Token Name -name = liftM (\(TName s) -> s) $ satisfy isName <?> P_Expected "name" +name = (\(TName n) -> n) <$> satisfy isName <#> "name" where isName (TName _) = True isName _ = False arg :: Parser Token Arg -arg = (type >>= \type -> name >>= \name -> pure {arg_type=type, arg_name=name}) - <?> P_Expected "argument" +arg = (type >>= \type -> name >>= \name -> pure {arg_type=type, arg_name=name}) <#> "argument" type :: Parser Token Type type = simpletype "Bool" TBool <|> simpletype "Int" TInt <|> simpletype "Void" TVoid - <|> (parenthised (min2seplist TComma type) >>= \ts -> pure $ TTuple (length ts) ts) + <|> (parenthised (min1seplist TComma type) >>= \ts -> pure $ TTuple (length ts) ts) <|> TList <$> bracked type - <?> P_Expected "type" + <#> "type" where simpletype s t = item (TName s) $> t @@ -297,11 +297,8 @@ parenthised p = item TParenOpen *> p <* item TParenClose bracked :: (Parser Token a) -> Parser Token a bracked p = item TBrackOpen *> p <* item TBrackClose -braced :: (Parser Token a) -> Parser Token a -braced p = item TBraceOpen *> p <* item TBraceClose - -min2seplist :: a (Parser a b) -> Parser a [b] | ==, name a -min2seplist sep val = +min1seplist :: a (Parser a b) -> Parser a [b] | ==, name, toString a +min1seplist sep val = val >>= \v1 -> item sep *> seplist sep val >>= \vs -> |