132 lines
2.9 KiB
Haskell
132 lines
2.9 KiB
Haskell
|
|
||
|
|
module AST.Parser where
|
||
|
|
|
||
|
|
import Data.Text (Text)
|
||
|
|
|
||
|
|
import AST.Types
|
||
|
|
|
||
|
|
import Parser
|
||
|
|
import Range
|
||
|
|
|
||
|
|
import Debug.Trace
|
||
|
|
|
||
|
|
name :: Parser (Name Range)
|
||
|
|
name = do
|
||
|
|
(raw, info) <- range (token "Name")
|
||
|
|
return Name {info, raw}
|
||
|
|
|
||
|
|
contract :: Parser (Contract Range)
|
||
|
|
contract = subtree "contract" do
|
||
|
|
(decls, info) <- range do
|
||
|
|
many "declaration" declaration
|
||
|
|
return (Contract info decls)
|
||
|
|
|
||
|
|
declaration :: Parser (Declaration Range)
|
||
|
|
declaration =
|
||
|
|
stubbed "declaration" do
|
||
|
|
field "declaration" do
|
||
|
|
(b, info) <- range binding
|
||
|
|
return (ValueDecl info b)
|
||
|
|
|
||
|
|
par x = do
|
||
|
|
consume "("
|
||
|
|
a <- x
|
||
|
|
consume ")"
|
||
|
|
return a
|
||
|
|
|
||
|
|
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
|
||
|
|
params <-
|
||
|
|
field "parameters" do
|
||
|
|
subtree "parameters" do
|
||
|
|
par do
|
||
|
|
many "param" do
|
||
|
|
notFollowedBy do
|
||
|
|
consumeOrDie ")"
|
||
|
|
|
||
|
|
stubbed "parameters" do
|
||
|
|
paramDecl
|
||
|
|
consume ":"
|
||
|
|
ty <-
|
||
|
|
stubbed "type" do
|
||
|
|
field "type" type_
|
||
|
|
consume "is"
|
||
|
|
expr <- stubbed "body" do
|
||
|
|
field "locals" anything
|
||
|
|
return (Function info (recur == Just "recursive") name params ty expr)
|
||
|
|
|
||
|
|
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)
|
||
|
|
|
||
|
|
newtype_ = do
|
||
|
|
type_
|
||
|
|
|
||
|
|
type_ :: Parser (Type Range)
|
||
|
|
type_ =
|
||
|
|
fun_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
|
||
|
|
|
||
|
|
cartesian = do
|
||
|
|
stubbed "cartesian" do
|
||
|
|
subtree "cartesian" do
|
||
|
|
info <- getRange
|
||
|
|
Product info <$> some "corety" do
|
||
|
|
field "element" do
|
||
|
|
core_type
|
||
|
|
|
||
|
|
core_type = do
|
||
|
|
info <- getRange
|
||
|
|
select
|
||
|
|
[ TVar info <$> typename
|
||
|
|
]
|
||
|
|
|
||
|
|
typename = name
|
||
|
|
|
||
|
|
tuple :: Text -> Parser a -> Parser [a]
|
||
|
|
tuple msg = par . some msg
|
||
|
|
|
||
|
|
example = "../../../src/test/contracts/address.ligo"
|