Apply PR comments.

IntersectMBO · Jun 9, 2021 · 3664153 · 3664153
1 parent c320a15
commit 3664153
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 26 deletions.
diff --git a/plutus-core/plutus-core/src/PlutusCore/ParserCommon.hs b/plutus-core/plutus-core/src/PlutusCore/ParserCommon.hs
@@ -54,6 +54,9 @@ topSourcePos = initialPos "top"
 initial :: ParserState
 initial = ParserState M.empty
 
+-- | Return the unique identifier of a name.
+-- If it's not in the current parser state, map the name with a fresh id
+-- and add it to the state. Used in the Name parser.
 intern :: (MonadState ParserState m, PLC.MonadQuote m) => T.Text -> m PLC.Unique
 intern n = do
     st <- get
@@ -77,9 +80,6 @@ parseQuoted p file str = flip evalStateT initial $ runParserT p file str
 whitespace :: Parser ()
 whitespace = Lex.space space1 (Lex.skipLineComment "--") (Lex.skipBlockCommentNested "{-" "-}")
 
--- Tokens
--- TODO: move this to separate module?
-
 lexeme :: Parser a -> Parser a
 lexeme = Lex.lexeme whitespace
 
@@ -113,6 +113,7 @@ inBraces = between lbrace rbrace
 isIdentifierChar :: Char -> Bool
 isIdentifierChar c = isAlphaNum c || c == '_' || c == '\''
 
+-- | Return the source position of the input word.
 reservedWord :: T.Text -> Parser SourcePos
 reservedWord w = lexeme $ try $ do
     p <- getSourcePos

diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/NewParser.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/NewParser.hs
@@ -42,61 +42,66 @@ import           Data.ByteString.Lazy.Internal   (unpackChars)
 import qualified Data.Text                       as T
 import           PlutusCore.ParserCommon
 
--- The following functions correspond to UntypedPlutusCore.Core.Type TermLike instances
+-- Parsers for UPLC terms
 
-delayTerm :: ParsecT ParseError
+conTerm
+    :: (PLC.Closed uni, uni `PLC.Everywhere` PLC.Parsable, PLC.Parsable (PLC.SomeTypeIn (PLC.Kinded uni)))
+    => Parser (UPLC.Term PLC.Name uni fun SourcePos)
+conTerm = inParens $ UPLC.Constant <$> reservedWord "con" <*> constant
+
+builtinTerm :: (Bounded fun, Enum fun, Pretty fun)
+    => Parser (UPLC.Term PLC.Name uni fun SourcePos)
+builtinTerm = inParens $ UPLC.Builtin <$> reservedWord "builtin" <*> builtinFunction
+
+varTerm :: Parser (UPLC.Term PLC.Name uni fun SourcePos)
+varTerm = UPLC.Var <$> getSourcePos <*> name
+
+lamTerm :: ParsecT ParseError
                    T.Text
                    (StateT ParserState PLC.Quote)
                    (UPLC.Term PLC.Name uni fun SourcePos)
                    -> Parser (UPLC.Term PLC.Name uni fun SourcePos)
-delayTerm tm = UPLC.Delay <$> reservedWord "abs" <*> tm
+lamTerm tm = inParens $ UPLC.LamAbs <$> reservedWord "lam" <*> name <*> tm
 
-lamTerm :: ParsecT ParseError
+appTerm :: ParsecT ParseError
                    T.Text
                    (StateT ParserState PLC.Quote)
                    (UPLC.Term PLC.Name uni fun SourcePos)
                    -> Parser (UPLC.Term PLC.Name uni fun SourcePos)
-lamTerm tm = UPLC.LamAbs <$> reservedWord "lam" <*> name <*> tm
+appTerm tm = inBrackets $ UPLC.Apply <$> getSourcePos <*> tm <*> tm
 
-appTerm :: ParsecT ParseError
+delayTerm :: ParsecT ParseError
                    T.Text
                    (StateT ParserState PLC.Quote)
                    (UPLC.Term PLC.Name uni fun SourcePos)
                    -> Parser (UPLC.Term PLC.Name uni fun SourcePos)
-appTerm tm = UPLC.Apply <$> getSourcePos <*> tm <*> tm
-
-conTerm
-    :: (PLC.Closed uni, uni `PLC.Everywhere` PLC.Parsable, PLC.Parsable (PLC.SomeTypeIn (PLC.Kinded uni)))
-    => Parser (UPLC.Term PLC.Name uni fun SourcePos)
-conTerm = UPLC.Constant <$> reservedWord "con" <*> constant
-
-builtinTerm :: (Bounded fun, Enum fun, Pretty fun)
-    => Parser (UPLC.Term PLC.Name uni fun SourcePos)
-builtinTerm = UPLC.Builtin <$> reservedWord "builtin" <*> builtinFunction
+delayTerm tm = inParens $ UPLC.Delay <$> reservedWord "abs" <*> tm
 
 forceTerm :: ParsecT ParseError
                    T.Text
                    (StateT ParserState PLC.Quote)
                    (UPLC.Term PLC.Name uni fun SourcePos)
                    -> Parser (UPLC.Term PLC.Name uni fun SourcePos)
-forceTerm tm = UPLC.Force <$> getSourcePos <*> tm
+forceTerm tm = inBraces $ UPLC.Force <$> getSourcePos <*> tm
 
 -- In uplc, Iwrap and Unwrap are removed.
 
 errorTerm
     :: Parser (UPLC.Term PLC.Name uni fun SourcePos)
-errorTerm = UPLC.Error <$> reservedWord "error"
+errorTerm = inParens $ UPLC.Error <$> reservedWord "error"
 
+-- | Parser for all UPLC terms.
 term
     :: ( PLC.Parsable (PLC.Some uni), PLC.Closed uni, uni `PLC.Everywhere` PLC.Parsable
        , Bounded fun, Enum fun, Pretty fun, PLC.Parsable (PLC.SomeTypeIn (PLC.Kinded uni)))
         => Parser (UPLC.Term PLC.Name uni fun SourcePos)
-term = (name >>= (\n -> getSourcePos >>= \p -> return $ UPLC.Var p n))
-    <|> (inParens $ delayTerm self <|> lamTerm self <|> conTerm <|> builtinTerm <|> errorTerm)
-    <|> inBraces (forceTerm self)
-    <|> inBrackets (appTerm self)
+term = conTerm <|> builtinTerm <|> varTerm
+    <|> lamTerm self <|> appTerm self
+    <|> delayTerm self <|> forceTerm self
+    <|>   errorTerm
     where self = term
 
+-- | Parser for UPLC programs.
 program
     :: ( PLC.Parsable (PLC.Some uni), PLC.Closed uni, uni `PLC.Everywhere` PLC.Parsable
        , Bounded fun, Enum fun, Pretty fun, PLC.Parsable (PLC.SomeTypeIn (PLC.Kinded uni)))
@@ -106,7 +111,7 @@ program = whitespace >> do
     notFollowedBy anySingle
     return prog
 
--- | Generic parser function
+-- | Generic parser function.
 parseGen :: Parser a -> ByteString -> Either (ParseErrorBundle T.Text ParseError) a
 parseGen stuff bs = parse stuff "test" $ (T.pack . unpackChars) bs