-
Notifications
You must be signed in to change notification settings - Fork 463
/
Parser.hs
96 lines (77 loc) · 2.96 KB
/
Parser.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module PlutusCore.Parser
( parseProgram
, parseTerm
, parseType
, ParseError(..)
) where
import Data.ByteString.Lazy (ByteString)
import Data.Text qualified as T
import PlutusCore.Core (Program (..), Term (..), Type)
import PlutusCore.Default (DefaultFun, DefaultUni)
import PlutusCore.Error (ParseError (..))
import PlutusCore.Name (Name, TyName)
import PlutusCore.Parser.ParserCommon
import PlutusPrelude
import Text.Megaparsec (MonadParsec (notFollowedBy), SourcePos, anySingle, getSourcePos)
import Text.Megaparsec.Error (ParseErrorBundle)
-- Parsers for PLC terms
-- | A parsable PLC term.
type PTerm = Term TyName Name DefaultUni DefaultFun SourcePos
varTerm :: Parser PTerm
varTerm = Var <$> getSourcePos <*> name
tyAbsTerm :: Parser PTerm
tyAbsTerm = TyAbs <$> wordPos "abs" <*> tyName <*> kind <*> term
lamTerm :: Parser PTerm
lamTerm = inParens $ LamAbs <$> wordPos "lam" <*> name <*> pType <*> term
appTerm :: Parser PTerm
appTerm = inBrackets $ Apply <$> getSourcePos <*> term <*> term
conTerm :: Parser PTerm
conTerm = inParens $ Constant <$> wordPos "con" <*> constant
builtinTerm :: Parser PTerm
builtinTerm = inParens $ Builtin <$> wordPos "builtin" <*> builtinFunction
tyInstTerm :: Parser PTerm
tyInstTerm = inBraces $ TyInst <$> getSourcePos <*> term <*> pType
unwrapTerm :: Parser PTerm
unwrapTerm = inParens $ Unwrap <$> wordPos "unwrap" <*> term
iwrapTerm :: Parser PTerm
iwrapTerm = inParens $ IWrap <$> wordPos "iwrap" <*> pType <*> pType <*> term
errorTerm
:: Parser PTerm
errorTerm = inParens $ Error <$> wordPos "error" <*> pType
-- | Parser for all PLC terms.
term :: Parser PTerm
term = varTerm
<|> tyAbsTerm
<|> lamTerm
<|> appTerm
<|> conTerm
<|> builtinTerm
<|> tyInstTerm
<|> unwrapTerm
<|> iwrapTerm
<|> errorTerm
-- | Parse a PLC program. The resulting program will have fresh names. The underlying monad must be capable
-- of handling any parse errors.
parseProgram ::
ByteString -> Either (ParseErrorBundle T.Text ParseError) (Program TyName Name DefaultUni DefaultFun SourcePos)
parseProgram = parseGen program
-- | Parser for PLC programs.
program :: Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
program = whitespace >> do
prog <- inParens $ Program <$> wordPos "program" <*> version <*> term
notFollowedBy anySingle
return prog
-- | Parse a PLC term. The resulting program will have fresh names. The underlying monad must be capable
-- of handling any parse errors.
parseTerm ::
ByteString ->
Either (ParseErrorBundle T.Text ParseError) (Term TyName Name DefaultUni DefaultFun SourcePos)
parseTerm = parseGen term
-- | Parse a PLC type. The resulting program will have fresh names. The underlying monad must be capable
-- of handling any parse errors.
parseType ::
ByteString ->
Either (ParseErrorBundle T.Text ParseError) (Type TyName DefaultUni SourcePos)
parseType = parseGen pType