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: $ => _open_data_decl: $ =>
choice( choice(
$.open_const_decl, $.const_decl,
$.open_var_decl, $.var_decl,
$.fun_decl, $.fun_decl,
), ),
open_const_decl: $ => const_decl: $ =>
seq( seq(
'const', 'const',
field("name", $.Name), field("name", $.Name),
@ -233,7 +233,7 @@ module.exports = grammar({
field("value", $._expr), field("value", $._expr),
), ),
open_var_decl: $ => var_decl: $ =>
seq( seq(
'var', 'var',
field("name", $.Name), field("name", $.Name),
@ -243,11 +243,6 @@ module.exports = grammar({
field("value", $._expr), field("value", $._expr),
), ),
const_decl: $ =>
seq(
$.open_const_decl,
),
_instruction: $ => _instruction: $ =>
choice( choice(
$.conditional, $.conditional,
@ -476,14 +471,14 @@ module.exports = grammar({
op_expr: $ => op_expr: $ =>
choice( choice(
field("the", $._core_expr), field("the", $._core_expr),
prec.left (0, seq(field("arg1", $.op_expr), 'or', 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), 'and', 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), 'contains', 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), $.comparison, 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("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("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), $.adder, 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), $.multiplier, 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))), 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 Data.Text (Text)
import AST.Types import AST.Types hiding (tuple)
import Parser import Parser
import Range import Range
@ -15,20 +15,58 @@ name = do
(raw, info) <- range (token "Name") (raw, info) <- range (token "Name")
return Name {info, raw} 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 :: Parser (Contract Range)
contract = subtree "contract" do contract = subtree "contract" do
(decls, info) <- range do (decls, info) <- range do
gets (length . pfGrove) >>= traceShowM many "declaration" do
many "declaration" declaration <* (gets (length . pfGrove) >>= traceShowM) inside "declaration:" do
declaration
return (Contract info decls) return (Contract info decls)
declaration :: Parser (Declaration Range) declaration :: Parser (Declaration Range)
declaration = declaration = do
stubbed "declaration" do (b, info) <- range binding
field "declaration" do return (ValueDecl info b)
(b, info) <- range binding <|> do
return (ValueDecl info b) (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 par x = do
consume "(" consume "("
@ -39,89 +77,191 @@ par x = do
binding :: Parser (Binding Range) binding :: Parser (Binding Range)
binding = do binding = do
info <- getRange info <- getRange
"fun_decl" `subtree` do inside ":fun_decl" do
recur <- optional do recur <- optional $ inside "recursive" $ token "recursive"
field "recursive" do name <- inside "name:" name
token "recursive"
consume "function"
name <- stubbed "name" do
field "name" do
name
params <- params <-
field "parameters" do inside "parameters:parameters" do
subtree "parameters" do many "param" do
par do notFollowedBy do
many "param" do consumeOrDie ")"
notFollowedBy do
consumeOrDie ")"
stubbed "parameters" do stubbed "parameters" paramDecl
paramDecl ty <- inside "type:" type_
consume ":" exp <- inside "body:" letExpr
ty <-
stubbed "type" do
field "type" type_
consume "is"
exp <- stubbed "body" do
field "body" letExpr
return (Function info (recur == Just "recursive") name params ty exp) return (Function info (recur == Just "recursive") name params ty exp)
expr :: Parser (Expr Range) expr :: Parser (Expr Range)
expr = select expr = stubbed "expr" do
[ Ident <$> getRange <*> name select
-- , ident [ Ident <$> getRange <*> do
-- , constant r <- getRange
] n <- name
return $ QualifiedName r n []
, opCall
, fun_call
, record_expr
, int_literal
, par_call
, method_call
-- , if_expr
-- , constant
]
where where
-- $.case_expr, -- $.case_expr,
-- $.cond_expr, -- $.cond_expr,
-- $.disj_expr, -- $.disj_expr,
-- $.fun_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 letExpr = do
subtree "let_expr" do subtree "let_expr" do
r <- getRange r <- getRange
decls <- optional do decls <- optional do
field "locals" do inside "locals:block" do
subtree "block" do many "decl" do
many "decl" do inside "statement" do
field "statement" do declaration <|> statement
declaration body <- inside "body"expr
body <- field "body" do
-- gets pfGrove >>= traceShowM
stubbed "expr" do
expr
return case decls of return case decls of
Just them -> Let r them body Just them -> Let r them body
Nothing -> body Nothing -> body
statement :: Parser (Declaration Range)
statement = do
r <- getRange
e <- expr
return $ Action r e
paramDecl :: Parser (VarDecl Range) paramDecl :: Parser (VarDecl Range)
paramDecl = do paramDecl = do
info <- getRange info <- getRange
"parameter" `field` do inside "parameter:param_decl" do
subtree "param_decl" do info' <- getRange
info' <- getRange mutable <- do
mutable <- do inside ":access" do
traceM "paramDecl" select
stubbed "access" do [ consume "var" >> return (Mutable info')
"access" `subtree` do , consume "const" >> return (Immutable info')
traceM "paramDecl" ]
select name <- inside "name" name
[ consume "var" >> return (Mutable info') ty <- inside "type" type_
, consume "const" >> return (Immutable info') return (Decl info mutable name ty)
]
name <-
stubbed "name" do
field "name" name
consume ":"
ty <-
stubbed "type" do
field "type" type_
return (Decl info mutable name ty)
newtype_ = do newtype_ = select
type_ [ 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_ :: Parser (Type Range)
type_ = type_ =
@ -129,35 +269,51 @@ type_ =
where where
fun_type :: Parser (Type Range) fun_type :: Parser (Type Range)
fun_type = do fun_type = do
stubbed "type" do inside ":fun_type" do
subtree "fun_type" do info <- getRange
info <- getRange domain <- inside "domain" cartesian
domain <- stubbed "domain" do codomain <- optional do
field "domain" cartesian consume "->"
codomain <- optional do fun_type
consume "->"
fun_type return case codomain of
return case codomain of Just co -> TArrow info domain co
Just co -> TArrow info domain co Nothing -> domain
Nothing -> domain
cartesian = do cartesian = do
stubbed "cartesian" do inside ":cartesian" do
subtree "cartesian" do info <- getRange
info <- getRange TProduct info <$> some "corety" do
Product info <$> some "corety" do inside "element" do
field "element" do core_type
core_type
core_type = do core_type = do
info <- getRange info <- getRange
select select
[ TVar info <$> typename [ TVar info <$> typename
, subtree "invokeBinary" do
r <- getRange
f <- inside "typeConstr" name
xs <- inside "arguments" typeTuple
return $ TApply r f xs
] ]
typename = name 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 :: Text -> Parser a -> Parser [a]
tuple msg = par . some msg 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 data Declaration info
= ValueDecl info (Binding info) = ValueDecl info (Binding info)
| TypeDecl info (Name info) (Type info)
| Action info (Expr info)
| WrongDecl Error | WrongDecl Error
deriving (Show) via PP (Declaration info) deriving (Show) via PP (Declaration info)
@ -59,30 +61,46 @@ instance Stubbed (Mutable info) where stub = WrongMutable
data Type info data Type info
= TArrow info (Type info) (Type info) = TArrow info (Type info) (Type info)
| Record info [(Name info, Type info)] | TRecord info [TField info]
| TVar info (Name info) | TVar info (Name info)
| Sum info [(Name info, [Type info])] | TSum info [(Name info, [Type info])]
| Product info [Type info] | TProduct info [Type info]
| TApply info (Name info) [Type info] | TApply info (Name info) [Type info]
| WrongType Error | WrongType Error
deriving (Show) via PP (Type info) deriving (Show) via PP (Type info)
instance Stubbed (Type info) where stub = WrongType 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 data Expr info
= Let info [Declaration info] (Expr info) = Let info [Declaration info] (Expr info)
| Apply info (Expr info) [Expr info] | Apply info (Expr info) [Expr info]
| Constant info (Constant 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 | WrongExpr Error
deriving (Show) via PP (Expr info) deriving (Show) via PP (Expr info)
instance Stubbed (Expr info) where stub = WrongExpr 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 data Constant info
= Int info Int = Int info Text
| String info Text | String info Text
| Float info Double | Float info Text
| Bytes info Text | Bytes info Text
| WrongConstant Error | WrongConstant Error
deriving (Show) via PP (Constant info) deriving (Show) via PP (Constant info)
@ -102,13 +120,21 @@ data QualifiedName info
= QualifiedName = QualifiedName
{ qnInfo :: info { qnInfo :: info
, qnSource :: Name info , qnSource :: Name info
, qnPath :: [Name info] , qnPath :: [Path info]
} }
| WrongQualifiedName Error | WrongQualifiedName Error
deriving (Show) via PP (QualifiedName info) deriving (Show) via PP (QualifiedName info)
instance Stubbed (QualifiedName info) where stub = WrongQualifiedName 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 data Name info = Name
{ info :: info { info :: info
, raw :: Text , raw :: Text
@ -134,6 +160,8 @@ instance Pretty (Contract i) where
instance Pretty (Declaration i) where instance Pretty (Declaration i) where
pp = \case pp = \case
ValueDecl _ binding -> pp binding ValueDecl _ binding -> pp binding
TypeDecl _ n ty -> hang ("type" <+> pp n <+> "=") 2 (pp ty)
Action _ e -> pp e
WrongDecl err -> pp err WrongDecl err -> pp err
instance Pretty (Binding i) where instance Pretty (Binding i) where
@ -160,7 +188,7 @@ instance Pretty (Binding i) where
(pp value) (pp value)
Const _ name ty body -> Const _ name ty body ->
hang hang
("var" <+> pp name <+> ":" <+> pp ty <+> "=") ("const" <+> pp name <+> ":" <+> pp ty <+> "=")
2 2
(pp body) (pp body)
WrongBinding err -> WrongBinding err ->
@ -186,10 +214,10 @@ instance Pretty (Mutable i) where
instance Pretty (Type i) where instance Pretty (Type i) where
pp = \case pp = \case
TArrow _ dom codom -> parens (pp dom <+> "->" <+> pp codom) 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 TVar _ name -> pp name
Sum _ variants -> vcat $ map ppCtor variants TSum _ variants -> vcat $ map ppCtor variants
Product _ elements -> fsep $ punctuate " *" $ map pp elements TProduct _ elements -> fsep $ punctuate " *" $ map pp elements
TApply _ f xs -> pp f <> parens (fsep $ punctuate "," $ map pp xs) TApply _ f xs -> pp f <> parens (fsep $ punctuate "," $ map pp xs)
WrongType err -> pp err WrongType err -> pp err
where where
@ -204,14 +232,20 @@ instance Pretty (Expr i) where
Apply _ f xs -> pp f <> tuple xs Apply _ f xs -> pp f <> tuple xs
Constant _ constant -> pp constant Constant _ constant -> pp constant
Ident _ qname -> pp qname 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 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 instance Pretty (Constant i) where
pp = \case pp = \case
Int _ c -> int c Int _ c -> pp c
String _ c -> doubleQuotes (pp c) String _ c -> doubleQuotes (pp c)
Float _ c -> double c Float _ c -> pp c
Bytes _ c -> pp c Bytes _ c -> pp c
WrongConstant err -> pp err WrongConstant err -> pp err
@ -233,5 +267,16 @@ instance Pretty (Name i) where
Name _ raw -> pp raw Name _ raw -> pp raw
WrongName err -> pp err 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 :: Pretty p => [p] -> Doc
tuple xs = parens (fsep $ punctuate "," $ map pp xs) 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.Foldable
import Data.Text.Encoding import Data.Text.Encoding
import Data.Text (Text, pack, unpack) import Data.Text (Text, pack, unpack)
import qualified Data.Text as Text
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
@ -266,7 +267,7 @@ delete _ [] = []
delete k ((k', v) : rest) = delete k ((k', v) : rest) =
if k == k' if k == k'
then rest then rest
else (k', v) : delete k rest else delete k rest
notFollowedBy :: Parser a -> Parser () notFollowedBy :: Parser a -> Parser ()
notFollowedBy parser = do notFollowedBy parser = do
@ -283,4 +284,31 @@ class Stubbed a where
stub :: Error -> a stub :: Error -> a
instance Stubbed Text where 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