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

Improve grammar, add Parsers for many things

Browse Source
This commit is contained in:
Kirill Andreev 2020-05-06 21:26:00 +04:00
parent 83cc13dd48
commit a8b898d396
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
4 changed files with 341 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
tools/lsp/pascaligo/grammar.js
View File

@ -218,12 +218,12 @@ module.exports = grammar({
_open_data_decl: $ =>
choice(
$.open_const_decl,
$.open_var_decl,
$.const_decl,
$.var_decl,
$.fun_decl,
),
open_const_decl: $ =>
const_decl: $ =>
seq(
'const',
field("name", $.Name),
@ -233,7 +233,7 @@ module.exports = grammar({
field("value", $._expr),
),
open_var_decl: $ =>
var_decl: $ =>
seq(
'var',
field("name", $.Name),
@ -243,11 +243,6 @@ module.exports = grammar({
field("value", $._expr),
),
const_decl: $ =>
seq(
$.open_const_decl,
),
_instruction: $ =>
choice(
$.conditional,
@ -476,14 +471,14 @@ module.exports = grammar({
op_expr: $ =>
choice(
field("the", $._core_expr),
prec.left (0, seq(field("arg1", $.op_expr), 'or', field("arg2", $.op_expr))),
prec.left (1, seq(field("arg1", $.op_expr), 'and', field("arg2", $.op_expr))),
prec.right(2, seq(field("arg1", $._core_expr), 'contains', field("arg2", $.op_expr))),
prec.left (3, seq(field("arg1", $.op_expr), $.comparison, field("arg2", $.op_expr))),
prec.right(4, seq(field("arg1", $.op_expr), '^', field("arg2", $.op_expr))),
prec.right(5, seq(field("arg1", $.op_expr), '#', field("arg2", $.op_expr))),
prec.left (6, seq(field("arg1", $.op_expr), $.adder, field("arg2", $.op_expr))),
prec.left (7, seq(field("arg1", $.op_expr), $.multiplier, field("arg2", $.op_expr))),
prec.left (0, seq(field("arg1", $.op_expr), field("op", 'or'), field("arg2", $.op_expr))),
prec.left (1, seq(field("arg1", $.op_expr), field("op", 'and'), field("arg2", $.op_expr))),
prec.right(2, seq(field("arg1", $._core_expr), field("op", 'contains'), field("arg2", $.op_expr))),
prec.left (3, seq(field("arg1", $.op_expr), field("op", $.comparison), field("arg2", $.op_expr))),
prec.right(4, seq(field("arg1", $.op_expr), field("op", '^'), field("arg2", $.op_expr))),
prec.right(5, seq(field("arg1", $.op_expr), field("op", '#'), field("arg2", $.op_expr))),
prec.left (6, seq(field("arg1", $.op_expr), field("op", $.adder), field("arg2", $.op_expr))),
prec.left (7, seq(field("arg1", $.op_expr), field("op", $.multiplier), field("arg2", $.op_expr))),
prec.right(8, seq(field("negate", $.negate), field("arg", $._core_expr))),
),

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

@ -3,7 +3,7 @@ module AST.Parser (example, contract) where
import Data.Text (Text)
import AST.Types
import AST.Types hiding (tuple)
import Parser
import Range
@ -15,20 +15,58 @@ name = do
(raw, info) <- range (token "Name")
return Name {info, raw}
capitalName :: Parser (Name Range)
capitalName = do
(raw, info) <- range (token "Name_Capital")
return Name {info, raw}
contract :: Parser (Contract Range)
contract = subtree "contract" do
(decls, info) <- range do
gets (length . pfGrove) >>= traceShowM
many "declaration" declaration <* (gets (length . pfGrove) >>= traceShowM)
many "declaration" do
inside "declaration:" do
declaration
return (Contract info decls)
declaration :: Parser (Declaration Range)
declaration =
stubbed "declaration" do
field "declaration" do
(b, info) <- range binding
return (ValueDecl info b)
declaration = do
(b, info) <- range binding
return (ValueDecl info b)
<|> do
(b, info) <- range vardecl
return (ValueDecl info b)
<|> do
(b, info) <- range constdecl
return (ValueDecl info b)
<|>
typedecl
typedecl :: Parser (Declaration Range)
typedecl = do
subtree "type_decl" do
r <- getRange
n <- inside "typeName:" name
t <- inside "typeValue:" newtype_
return $ TypeDecl r n t
vardecl :: Parser (Binding Range)
vardecl = do
subtree "var_decl" do
r <- getRange
n <- inside "name:" name
ty <- inside "type:" type_
b <- inside "value:" expr
return (Var r n ty b)
constdecl :: Parser (Binding Range)
constdecl = do
subtree "const_decl" do
r <- getRange
n <- inside "name" name
ty <- inside "type" type_
b <- inside "value" expr
return (Const r n ty b)
par x = do
consume "("
@ -39,89 +77,191 @@ par x = do
binding :: Parser (Binding Range)
binding = do
info <- getRange
"fun_decl" `subtree` do
recur <- optional do
field "recursive" do
token "recursive"
consume "function"
name <- stubbed "name" do
field "name" do
name
inside ":fun_decl" do
recur <- optional $ inside "recursive" $ token "recursive"
name <- inside "name:" name
params <-
field "parameters" do
subtree "parameters" do
par do
many "param" do
notFollowedBy do
consumeOrDie ")"
inside "parameters:parameters" do
many "param" do
notFollowedBy do
consumeOrDie ")"
stubbed "parameters" do
paramDecl
consume ":"
ty <-
stubbed "type" do
field "type" type_
consume "is"
exp <- stubbed "body" do
field "body" letExpr
stubbed "parameters" paramDecl
ty <- inside "type:" type_
exp <- inside "body:" letExpr
return (Function info (recur == Just "recursive") name params ty exp)
expr :: Parser (Expr Range)
expr = select
[ Ident <$> getRange <*> name
-- , ident
-- , constant
]
expr = stubbed "expr" do
select
[ Ident <$> getRange <*> do
r <- getRange
n <- name
return $ QualifiedName r n []
, opCall
, fun_call
, record_expr
, int_literal
, par_call
, method_call
-- , if_expr
-- , constant
]
where
-- $.case_expr,
-- $.cond_expr,
-- $.disj_expr,
-- $.fun_expr,
method_call :: Parser (Expr Range)
method_call = do
subtree "projection_call" do
r <- getRange
(f, r') <- field "f" $ range projection
xs <- inside "arguments" arguments
return $ Apply r (Ident r' f) xs
projection :: Parser (QualifiedName Range)
projection = do
subtree "data_projection" do
r <- getRange
s <- inside "struct" name
is <- many "selection" selection
return $ QualifiedName r s is
selection :: Parser (Path Range)
selection = do
inside "index:selection" $ do
r <- getRange
n <- name
return $ At r n
<|> do
r <- getRange
n <- token "Int"
return $ Ix r n
par_call :: Parser (Expr Range)
par_call = do
subtree "par_call" do
r <- getRange
f <- inside "f" expr
az <- inside "arguments" arguments
return $ Apply r f az
int_literal :: Parser (Expr Range)
int_literal = do
r <- getRange
i <- token "Int"
return $ Constant r (Int r i)
record_expr :: Parser (Expr Range)
record_expr = do
subtree "record_expr" do
r <- getRange
az <- many "assignment" do
inside "assignment:field_assignment" do
r <- getRange
n <- inside "name" name
e <- inside "_rhs" expr
return $ Assignment r n e
return $ Record r az
fun_call :: Parser (Expr Range)
fun_call = do
subtree "fun_call" do
r <- getRange
(f, r') <- range $ inside "f" function_id
xs <- inside "arguments" do
arguments
return $ Apply r (Ident r' f) xs
arguments =
subtree "arguments" do
many "argument" do
inside "argument" expr
function_id :: Parser (QualifiedName Range)
function_id = select
[ do
r <- getRange
n <- name
return $ QualifiedName r n []
, do
subtree "module_field" do
r <- getRange
whole <- inside "module" capitalName
path <- inside "method" name
return $ QualifiedName r whole [At r path]
]
opCall :: Parser (Expr Range)
opCall = do
subtree "op_expr" $ do
inside "the" do
expr
<|> do
i <- getRange
l <- inside "arg1" expr
o <- inside "op" anything
r <- inside "arg2" expr
return $ BinOp i l o r
letExpr = do
subtree "let_expr" do
r <- getRange
decls <- optional do
field "locals" do
subtree "block" do
many "decl" do
field "statement" do
declaration
body <- field "body" do
-- gets pfGrove >>= traceShowM
stubbed "expr" do
expr
inside "locals:block" do
many "decl" do
inside "statement" do
declaration <|> statement
body <- inside "body"expr
return case decls of
Just them -> Let r them body
Nothing -> body
statement :: Parser (Declaration Range)
statement = do
r <- getRange
e <- expr
return $ Action r e
paramDecl :: Parser (VarDecl Range)
paramDecl = do
info <- getRange
"parameter" `field` do
subtree "param_decl" do
info' <- getRange
mutable <- do
traceM "paramDecl"
stubbed "access" do
"access" `subtree` do
traceM "paramDecl"
select
[ consume "var" >> return (Mutable info')
, consume "const" >> return (Immutable info')
]
name <-
stubbed "name" do
field "name" name
consume ":"
ty <-
stubbed "type" do
field "type" type_
return (Decl info mutable name ty)
inside "parameter:param_decl" do
info' <- getRange
mutable <- do
inside ":access" do
select
[ consume "var" >> return (Mutable info')
, consume "const" >> return (Immutable info')
]
name <- inside "name" name
ty <- inside "type" type_
return (Decl info mutable name ty)
newtype_ = do
type_
newtype_ = select
[ record_type
, type_
-- , sum_type
]
record_type = do
subtree "record_type" do
r <- getRange
fs <- many "field" do
inside "field" do
field_decl
traceShowM fs
return $ TRecord r fs
field_decl = do
subtree "field_decl" do
r <- getRange
n <- inside "fieldName" name
t <- inside "fieldType" type_
return $ TField r n t
type_ :: Parser (Type Range)
type_ =
@ -129,35 +269,51 @@ type_ =
where
fun_type :: Parser (Type Range)
fun_type = do
stubbed "type" do
subtree "fun_type" do
info <- getRange
domain <- stubbed "domain" do
field "domain" cartesian
codomain <- optional do
consume "->"
fun_type
return case codomain of
Just co -> TArrow info domain co
Nothing -> domain
inside ":fun_type" do
info <- getRange
domain <- inside "domain" cartesian
codomain <- optional do
consume "->"
fun_type
return case codomain of
Just co -> TArrow info domain co
Nothing -> domain
cartesian = do
stubbed "cartesian" do
subtree "cartesian" do
info <- getRange
Product info <$> some "corety" do
field "element" do
core_type
inside ":cartesian" do
info <- getRange
TProduct info <$> some "corety" do
inside "element" do
core_type
core_type = do
info <- getRange
select
[ TVar info <$> typename
, subtree "invokeBinary" do
r <- getRange
f <- inside "typeConstr" name
xs <- inside "arguments" typeTuple
return $ TApply r f xs
]
typename = name
typeTuple :: Parser [Type Range]
typeTuple = do
subtree "type_tuple" do
many "type tuple element" do
inside "element" type_
tuple :: Text -> Parser a -> Parser [a]
tuple msg = par . some msg
example = "../../../src/test/contracts/address.ligo"
-- example = "../../../src/test/contracts/application.ligo"
-- example = "../../../src/test/contracts/address.ligo"
example = "../../../src/test/contracts/amount.ligo"
-- example = "../../../src/test/contracts/application.ligo"
-- example = "../../../src/test/contracts/application.ligo"
-- example = "../../../src/test/contracts/application.ligo"
-- example = "../../../src/test/contracts/application.ligo"
-- example = "../../../src/test/contracts/application.ligo"

71
tools/lsp/squirrel/src/AST/Types.hs
View File

@ -26,6 +26,8 @@ instance Stubbed (Contract info) where stub = WrongContract
data Declaration info
= ValueDecl info (Binding info)
| TypeDecl info (Name info) (Type info)
| Action info (Expr info)
| WrongDecl Error
deriving (Show) via PP (Declaration info)
@ -59,30 +61,46 @@ instance Stubbed (Mutable info) where stub = WrongMutable
data Type info
= TArrow info (Type info) (Type info)
| Record info [(Name info, Type info)]
| TRecord info [TField info]
| TVar info (Name info)
| Sum info [(Name info, [Type info])]
| Product info [Type info]
| TSum info [(Name info, [Type info])]
| TProduct info [Type info]
| TApply info (Name info) [Type info]
| WrongType Error
deriving (Show) via PP (Type info)
instance Stubbed (Type info) where stub = WrongType
data TField info
= TField info (Name info) (Type info)
| WrongTField Error
deriving (Show) via PP (TField info)
instance Stubbed (TField info) where stub = WrongTField
data Expr info
= Let info [Declaration info] (Expr info)
| Apply info (Expr info) [Expr info]
| Constant info (Constant info)
| Ident info (Name info)
| Ident info (QualifiedName info)
| BinOp info (Expr info) Text (Expr info)
| Record info [Assignment info]
| WrongExpr Error
deriving (Show) via PP (Expr info)
instance Stubbed (Expr info) where stub = WrongExpr
data Assignment info
= Assignment info (Name info) (Expr info)
| WrongAssignment Error
deriving (Show) via PP (Assignment info)
instance Stubbed (Assignment info) where stub = WrongAssignment
data Constant info
= Int info Int
= Int info Text
| String info Text
| Float info Double
| Float info Text
| Bytes info Text
| WrongConstant Error
deriving (Show) via PP (Constant info)
@ -102,13 +120,21 @@ data QualifiedName info
= QualifiedName
{ qnInfo :: info
, qnSource :: Name info
, qnPath :: [Name info]
, qnPath :: [Path info]
}
| WrongQualifiedName Error
deriving (Show) via PP (QualifiedName info)
instance Stubbed (QualifiedName info) where stub = WrongQualifiedName
data Path info
= At info (Name info)
| Ix info Text
| WrongPath Error
deriving (Show) via PP (Path info)
instance Stubbed (Path info) where stub = WrongPath
data Name info = Name
{ info :: info
, raw :: Text
@ -134,6 +160,8 @@ instance Pretty (Contract i) where
instance Pretty (Declaration i) where
pp = \case
ValueDecl _ binding -> pp binding
TypeDecl _ n ty -> hang ("type" <+> pp n <+> "=") 2 (pp ty)
Action _ e -> pp e
WrongDecl err -> pp err
instance Pretty (Binding i) where
@ -160,7 +188,7 @@ instance Pretty (Binding i) where
(pp value)
Const _ name ty body ->
hang
("var" <+> pp name <+> ":" <+> pp ty <+> "=")
("const" <+> pp name <+> ":" <+> pp ty <+> "=")
2
(pp body)
WrongBinding err ->
@ -186,10 +214,10 @@ instance Pretty (Mutable i) where
instance Pretty (Type i) where
pp = \case
TArrow _ dom codom -> parens (pp dom <+> "->" <+> pp codom)
Record _ fields -> wrap ["record [", "]"] $ vcat $ map ppField fields
TRecord _ fields -> "record [" <> (vcat $ map pp fields) <> "]"
TVar _ name -> pp name
Sum _ variants -> vcat $ map ppCtor variants
Product _ elements -> fsep $ punctuate " *" $ map pp elements
TSum _ variants -> vcat $ map ppCtor variants
TProduct _ elements -> fsep $ punctuate " *" $ map pp elements
TApply _ f xs -> pp f <> parens (fsep $ punctuate "," $ map pp xs)
WrongType err -> pp err
where
@ -204,14 +232,20 @@ instance Pretty (Expr i) where
Apply _ f xs -> pp f <> tuple xs
Constant _ constant -> pp constant
Ident _ qname -> pp qname
BinOp _ l o r -> parens (pp l <+> pp o <+> pp r)
Record _ az -> "record [" <> (fsep $ punctuate ";" $ map pp az) <> "]"
WrongExpr err -> pp err
instance Pretty (Assignment i) where
pp = \case
Assignment _ n e -> pp n <+> "=" <+> pp e
WrongAssignment err -> pp err
instance Pretty (Constant i) where
pp = \case
Int _ c -> int c
Int _ c -> pp c
String _ c -> doubleQuotes (pp c)
Float _ c -> double c
Float _ c -> pp c
Bytes _ c -> pp c
WrongConstant err -> pp err
@ -233,5 +267,16 @@ instance Pretty (Name i) where
Name _ raw -> pp raw
WrongName err -> pp err
instance Pretty (Path i) where
pp = \case
At _ n -> pp n
Ix _ i -> pp i
WrongPath err -> pp err
instance Pretty (TField i) where
pp = \case
TField _ n t -> hang (pp n <> ":") 2 (pp t)
WrongTField err -> pp err
tuple :: Pretty p => [p] -> Doc
tuple xs = parens (fsep $ punctuate "," $ map pp xs)

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

@ -10,6 +10,7 @@ import Control.Monad.Identity
import Data.Foldable
import Data.Text.Encoding
import Data.Text (Text, pack, unpack)
import qualified Data.Text as Text
import qualified Data.ByteString as ByteString
import Data.ByteString (ByteString)
@ -266,7 +267,7 @@ delete _ [] = []
delete k ((k', v) : rest) =
if k == k'
then rest
else (k', v) : delete k rest
else delete k rest
notFollowedBy :: Parser a -> Parser ()
notFollowedBy parser = do
@ -283,4 +284,31 @@ class Stubbed a where
stub :: Error -> a
instance Stubbed Text where
stub = pack . show
stub = pack . show
instance Stubbed [a] where
stub _ = []
inside :: Stubbed a => Text -> Parser a -> Parser a
inside sig parser = do
let (f, st') = Text.breakOn ":" sig
let st = Text.drop 1 st'
if Text.null f
then do
traceShowM ("subtree", st)
subtree st do
traceShowM ("stubbed", st)
stubbed f do
parser
else do
traceShowM ("field", f)
field f do
traceShowM ("stubbed", f)
stubbed f do
if Text.null st
then do
parser
else do
traceShowM ("subtree", st)
subtree st do
parser