balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove excess params of Parser.{many,some}

Browse Source
This commit is contained in:
Kirill Andreev 2020-05-08 20:11:12 +04:00
parent b62cd58add
commit 6dc1eb23cd
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
2 changed files with 66 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
tools/lsp/squirrel/src/AST/Parser.hs
View File

@ -22,7 +22,7 @@ contract :: Parser (Contract ASTInfo)
contract =
ctor Contract
<*> subtree "contract" do
many "declaration" do
many do
inside "declaration:" do
declaration
@ -76,7 +76,7 @@ binding = do
<*> recursive
<*> inside "name:" name
<*> inside "parameters:parameters" do
many "param" do
many do
inside "parameter" paramDecl
<*> inside "type:" type_
<*> inside "body:" letExpr
@ -146,15 +146,13 @@ set_patch = do
subtree "set_patch" do
ctor SetPatch
<*> inside "container:path" (qname <|> projection)
<*> many "key" do
inside "key" expr
<*> many do inside "key" expr
record_update = do
subtree "update_record" do
ctor RecordUpd
<*> inside "record:path" do qname <|> projection
<*> many "field" do
inside "assignment" field_path_assignment
<*> many do inside "assignment" field_path_assignment
field_path_assignment = do
subtree "field_path_assignment" do
@ -166,29 +164,25 @@ map_patch = do
subtree "map_patch" do
ctor MapPatch
<*> inside "container:path" (qname <|> projection)
<*> many "binding" do
inside "binding" map_binding
<*> many do inside "binding" map_binding
set_expr :: Parser (Expr ASTInfo)
set_expr = do
subtree "set_expr" do
ctor List <*> do
many "list elem" do
ctor List <*> many do
inside "element" expr
lambda_expr = do
subtree "fun_expr" do
ctor Lambda
<*> inside "parameters:parameters" do
many "param" do
inside "parameter" paramDecl
many do inside "parameter" paramDecl
<*> inside "type" newtype_
<*> inside "body" expr
seq_expr = do
subtree "block" do
ctor Seq <*> do
many "statement" do
ctor Seq <*> many do
inside "statement" do
declaration <|> statement
@ -222,11 +216,11 @@ for_loop = do
clause_block = do
subtree "clause_block" do
inside "block:block" do
ctor Seq <*> many "statement" do
ctor Seq <*> many do
inside "statement" (declaration <|> statement)
<|> do
subtree "clause_block" do
ctor Seq <*> many "statement" do
ctor Seq <*> many do
inside "statement" (declaration <|> statement)
skip :: Parser (Expr ASTInfo)
@ -238,7 +232,7 @@ case_action = do
subtree "case_instr" do
ctor Case
<*> inside "subject" expr
<*> many "case" do
<*> many do
inside "case" alt_action
alt_action :: Parser (Alt ASTInfo)
@ -253,7 +247,7 @@ case_expr = do
subtree "case_expr" do
ctor Case
<*> inside "subject" expr
<*> many "case" do
<*> many do
inside "case" alt
alt :: Parser (Alt ASTInfo)
@ -320,35 +314,32 @@ constr_pattern =
<|>
do
ctor IsConstr
<*> do ctor Name <*> do token "True" <|> token "False" <|> token "None" <|> token "Unit"
<*> do ctor Name <*> do true <|> false <|> none <|> unit
<*> pure Nothing
tuple_pattern :: Parser (Pattern ASTInfo)
tuple_pattern = do
subtree "tuple_pattern" do
ctor IsTuple <*> do
many "element" do
ctor IsTuple <*> many do
inside "element" pattern
list_pattern :: Parser (Pattern ASTInfo)
list_pattern = do
subtree "list_pattern" do
ctor IsList <*> do
many "element" do
ctor IsList <*> many do
inside "element" pattern
nullary_ctor :: Parser (Expr ASTInfo)
nullary_ctor = do
ctor Ident <*> do
ctor QualifiedName
<*> do ctor Name <*> do
true <|> false <|> none <|> unit
<*> do ctor Name <*> do true <|> false <|> none <|> unit
<*> pure []
where
true = token "True"
false = token "False"
none = token "None"
unit = token "Unit"
true = token "True"
false = token "False"
none = token "None"
unit = token "Unit"
nat_literal :: Parser (Expr ASTInfo)
nat_literal = do
@ -369,8 +360,7 @@ constr_call = do
ctor Apply
<*> do ctor Ident <*> inside "constr" qname'
<*> inside "arguments:arguments" do
many "argument" do
inside "argument" expr
many do inside "argument" expr
user_constr_call = do
subtree "constr_call" do
@ -381,8 +371,7 @@ constr_call = do
<*> capitalName
<*> pure []
<*> inside "arguments:arguments" do
many "argument" do
inside "argument" expr
many do inside "argument" expr
indexing :: Parser (Expr ASTInfo)
indexing = do
@ -404,16 +393,14 @@ map_remove = do
big_map_expr :: Parser (Expr ASTInfo)
big_map_expr = do
subtree "big_map_injection" do
ctor BigMap <*> do
many "binding" do
ctor BigMap <*> many do
inside "binding" do
map_binding
map_expr :: Parser (Expr ASTInfo)
map_expr = do
subtree "map_injection" do
ctor Map <*> do
many "binding" do
ctor Map <*> many do
inside "binding" do
map_binding
@ -435,15 +422,13 @@ moduleQualified = do
tuple_expr :: Parser (Expr ASTInfo)
tuple_expr = do
subtree "tuple_expr" do
ctor Tuple <*> do
many "tuple element" do
ctor Tuple <*> many do
inside "element" expr
attributes :: Parser (Expr ASTInfo)
attributes = do
subtree "attr_decl" do
ctor Attrs <*> do
many "attribute" do
ctor Attrs <*> many do
inside "attribute" do
token "String"
@ -463,8 +448,7 @@ has_type = do
list_expr :: Parser (Expr ASTInfo)
list_expr = do
subtree "list_expr" do
ctor List <*> do
many "list elem" do
ctor List <*> many do
inside "element" expr
qname :: Parser (QualifiedName ASTInfo)
@ -540,7 +524,7 @@ projection = do
subtree "data_projection" do
ctor QualifiedName
<*> inside "struct" name
<*> many "selection" selection
<*> many selection
selection :: Parser (Path ASTInfo)
selection = do
@ -549,7 +533,7 @@ selection = do
<|> do ctor Ix <*> token "Int"
<|>
inside "index" do
do ctor Ix <*> token "Int"
ctor Ix <*> token "Int"
par_call :: Parser (Expr ASTInfo)
par_call = do
@ -569,8 +553,7 @@ int_literal = do
record_expr :: Parser (Expr ASTInfo)
record_expr = do
subtree "record_expr" do
ctor Record <*> do
many "assignment" do
ctor Record <*> many do
inside "assignment:field_assignment" do
ctor Assignment
<*> inside "name" name
@ -585,8 +568,7 @@ fun_call = do
arguments =
subtree "arguments" do
many "argument" do
inside "argument" expr
many do inside "argument" expr
function_id :: Parser (QualifiedName ASTInfo)
function_id = select
@ -615,7 +597,7 @@ letExpr = do
ctor let'
<*> optional do
inside "locals:block" do
many "decl" do
many do
inside "statement" do
declaration <|> statement
<*> inside "body"expr
@ -648,8 +630,7 @@ newtype_ = select
sum_type = do
subtree "sum_type" do
ctor TSum <*> do
many "variant" do
ctor TSum <*> many do
inside "variant" variant
variant = do
@ -660,8 +641,7 @@ variant = do
record_type = do
subtree "record_type" do
ctor TRecord
<*> many "field" do
ctor TRecord <*> many do
inside "field" do
field_decl
@ -690,7 +670,7 @@ type_ =
cartesian = do
inside ":cartesian" do
ctor TProduct <*> some "corety" do
ctor TProduct <*> some do
inside "element" do
core_type
@ -716,8 +696,7 @@ name' = do
typeTuple :: Parser [Type ASTInfo]
typeTuple = do
subtree "type_tuple" do
many "type tuple element" do
inside "element" type_
many do inside "element" type_
-- example = "../../../src/test/contracts/application.ligo"
-- example = "../../../src/test/contracts/address.ligo"

19
tools/lsp/squirrel/src/Parser.hs
View File

@ -74,11 +74,11 @@ instance Pretty Error where
-- | Parser of tree-sitter-made tree.
newtype Parser a = Parser
{ unParser
:: WriterT [Error] -- Early I though to report errors that way. Obs.
:: WriterT [Error] -- Early I though to report errors that way.
( ReaderT ParserEnv -- Range/Something.
( StateT ParseForest -- Current forest to recognise.
( ExceptT Error -- Backtracking. Change `Error` to `()`?
( IO )))) -- I forgot why. `#include`? Debug via `print`?
( Identity )))) -- I forgot why. `#include`? Debug via `print`?
a
}
deriving newtype
@ -89,7 +89,6 @@ newtype Parser a = Parser
, MonadWriter [Error]
, MonadReader ParserEnv
, MonadError Error
, MonadIO
)
-- | Generate error originating at current location.
@ -198,8 +197,8 @@ optional p = fmap Just p <|> return Nothing
--
-- TODO: remove msg.
--
many :: Text -> Parser a -> Parser [a]
many msg p = many'
many :: Parser a -> Parser [a]
many p = many'
where
many' = some' <|> pure []
some' = do
@ -215,8 +214,8 @@ many msg p = many'
--
-- TODO: remove msg.
--
some :: Text -> Parser a -> Parser [a]
some msg p = some'
some :: Parser a -> Parser [a]
some p = some'
where
many' = some' <|> pure []
some' = do
@ -280,8 +279,10 @@ runParser :: Parser a -> FilePath -> IO (a, [Error])
runParser (Parser parser) fin = do
pforest <- toParseTree fin
text <- ByteString.readFile fin
res <-
runExceptT
let
res =
runIdentity
$ runExceptT
$ flip runStateT pforest
$ flip runReaderT (ParserEnv text)
$ runWriterT