Fix con unit and integer parser. Partially fix conChar and tyInst.

plutus-core/plutus-core/src/PlutusCore/Error.hs

@@ -42,7 +42,6 @@ import Control.Monad.Except
 import Data.Text qualified as T
 import ErrorCode
 import Prettyprinter (hardline, indent, squotes, (<+>))
-import Prettyprinter.Internal (Doc (Text))
 import Text.Megaparsec.Error (ShowErrorComponent, showErrorComponent)
 import Text.Megaparsec.Pos (SourcePos, sourcePosPretty)
 import Universe (Closed (Everywhere), GEq, GShow)
@@ -55,8 +54,7 @@ throwingEither r e = case e of
 
 -- | An error encountered during parsing.
 data ParseError
-    = LexErr String
-    | UnknownBuiltinType T.Text SourcePos
+    = UnknownBuiltinType T.Text SourcePos
     | BuiltinTypeNotAStar T.Text SourcePos
     | UnknownBuiltinFunction T.Text SourcePos
     | InvalidBuiltinConstant T.Text T.Text SourcePos
@@ -127,7 +125,6 @@ instance Pretty SourcePos where
     pretty = pretty . sourcePosPretty
 
 instance Pretty ParseError where
-    pretty (LexErr s)                       = "Lexical error:" <+> Text (length s) (T.pack s)
     pretty (UnknownBuiltinType s loc)       = "Unknown built-in type" <+> squotes (pretty s) <+> "at" <+> pretty loc
     pretty (BuiltinTypeNotAStar ty loc)     = "Expected a type of kind star (to later parse a constant), but got:" <+> squotes (pretty ty) <+> "at" <+> pretty loc
     pretty (UnknownBuiltinFunction s loc)   = "Unknown built-in function" <+> squotes (pretty s) <+> "at" <+> pretty loc
@@ -198,7 +195,6 @@ instance HasErrorCode ParseError where
     errorCode UnknownBuiltinFunction {} = ErrorCode 9
     errorCode UnknownBuiltinType {}     = ErrorCode 8
     errorCode BuiltinTypeNotAStar {}    = ErrorCode 51
-    errorCode LexErr {}                 = ErrorCode 6
 
 instance HasErrorCode (UniqueError _a) where
       errorCode FreeVariable {}    = ErrorCode 21

plutus-core/plutus-core/src/PlutusCore/Parser.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE GADTs               #-}
 {-# LANGUAGE OverloadedStrings   #-}
 
 module PlutusCore.Parser
@@ -11,7 +12,7 @@ module PlutusCore.Parser
 import Data.ByteString.Lazy (ByteString)
 import Data.Text qualified as T
 import PlutusCore.Core (Program (..), Term (..), Type)
-import PlutusCore.Default (DefaultFun, DefaultUni)
+import PlutusCore.Default
 import PlutusCore.Error (ParseError (..))
 import PlutusCore.Name (Name, TyName)
 import PlutusCore.Parser.ParserCommon
@@ -40,7 +41,7 @@ appTerm = inBrackets $ do
     pure $ app pos tm tms
 
 app :: SourcePos -> PTerm -> [PTerm] -> PTerm
-app _  _t []        = error "appTerm, app: An application without the argument."
+app _  _t []        = error "appTerm, app: An application without an argument."
 app loc t [t']      = Apply loc t t'
 app loc t (t' : ts) = Apply loc (app loc t (t':init ts)) (last ts)
 
@@ -62,15 +63,42 @@ appTerms = choice
 conTerm :: Parser PTerm
 conTerm = inParens $ do
     p <- wordPos "con"
-    _conTy <- defaultUniType -- TODO: do case of for each ty?
-    con <- constant
+    conTy <- defaultUniType -- TODO: do case of for each ty?
+    con <-
+        case conTy of
+            SomeTypeIn DefaultUniInteger    -> conInt
+            SomeTypeIn DefaultUniByteString -> conChar
+            SomeTypeIn DefaultUniString     -> conText
+            SomeTypeIn DefaultUniUnit       -> conUnit
+            SomeTypeIn DefaultUniBool       -> conBool
     pure $ Constant p con
 
 builtinTerm :: Parser PTerm
 builtinTerm = inParens $ Builtin <$> wordPos "builtin" <*> builtinFunction
 
 tyInstTerm :: Parser PTerm
-tyInstTerm = inBraces $ TyInst <$> getSourcePos <*> term <*> pType
+tyInstTerm = inBraces $ do
+    pos <- getSourcePos
+    tm <- term
+    tys <- appTypes
+    pure $ tyInst pos tm tys
+
+appTypes :: Parser [PType]
+appTypes = choice
+    [ try types
+    , do
+        ty <- pType
+        pure [ty]
+    ]
+    where types = do
+            ty <- pType
+            tys <- appTypes
+            pure $ ty : tys
+
+tyInst :: SourcePos -> PTerm -> [PType] -> PTerm
+tyInst _  _t []         = error "tyInst: A type instantiation without an argument."
+tyInst loc t [ty]       = TyInst loc t ty
+tyInst loc t (ty : tys) = TyInst loc (tyInst loc t (ty : init tys)) (last tys)
 
 unwrapTerm :: Parser PTerm
 unwrapTerm = inParens $ Unwrap <$> wordPos "unwrap" <*> term

plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs

@@ -104,6 +104,11 @@ appType = do
     args <- some pType
     pure $ foldl' (TyApp pos) fn args
 
+tyApps :: SourcePos -> PType -> [PType] -> PType
+tyApps _  _t []           = error "tyApps: A type application without an argument."
+tyApps loc ty [ty']       = TyApp loc ty ty'
+tyApps loc ty (ty' : tys) = TyApp loc (tyApps loc ty (ty':init tys)) (last tys)
+
 kind :: Parser (Kind SourcePos)
 kind = inParens (typeKind <|> funKind)
     where
@@ -124,7 +129,7 @@ pType = choice
     ]
 
 defaultUniType :: Parser (SomeTypeIn DefaultUni)
-defaultUniType = choice
+defaultUniType = choice $ map try
   [ inParens defaultUniType
   , SomeTypeIn DefaultUniInteger <$ symbol "integer"
   , SomeTypeIn DefaultUniByteString <$ symbol "bytestring"
@@ -243,16 +248,19 @@ enforce p = do
     guard . not $ T.null input
     pure x
 
+signedInteger :: ParsecT ParseError T.Text (StateT ParserState Quote) Integer
+signedInteger = Lex.signed whitespace (lexeme Lex.decimal)
+
 -- | Parser for integer constants.
 conInt :: Parser (Some (ValueOf DefaultUni))
 conInt = do
-    con::Integer <- lexeme Lex.decimal
+    con::Integer <- signedInteger
     pure $ someValue con
 
 -- | Parser for single quoted char.
 conChar :: Parser (Some (ValueOf DefaultUni))
 conChar = do
-    con <- between (char '\'') (char '\'') Lex.charLiteral
+    con <- Lex.charLiteral
     pure $ someValue $ singleton con
 
 -- | Parser for double quoted string.
@@ -263,7 +271,7 @@ conText = do
 
 -- | Parser for unit.
 conUnit :: Parser (Some (ValueOf DefaultUni))
-conUnit = someValue () <$ symbol "unit"
+conUnit = someValue () <$ symbol "()"
 
 -- | Parser for bool.
 conBool :: Parser (Some (ValueOf DefaultUni))

plutus-core/plutus-core/test/Spec.hs

@@ -191,9 +191,9 @@ tests :: TestTree
 tests = testCase "example programs" $ fold
     [ fmt "(program 0.1.0 [(builtin addInteger) x y])" @?= Right "(program 0.1.0 [ [ (builtin addInteger) x ] y ])"
     , fmt "(program 0.1.0 doesn't)" @?= Right "(program 0.1.0 doesn't)"
-    , fmt "{- program " @?= Left (LexErr "Error in nested comment at line 1, column 12")
     ]
     where
+        fmt :: BSL.ByteString -> Either ParseError T.Text
         fmt = format cfg
         cfg = defPrettyConfigPlcClassic defPrettyConfigPlcOptions
 

plutus-errors/src/Errors.hs

@@ -35,7 +35,6 @@ allErrors =
    , 'PIR.MalformedDataConstrResType
    , 'PIR.CompilationError
    , 'PIR.UnsupportedError
-   , 'PLC.LexErr
    , 'PLC.Unexpected
    , 'PLC.UnknownBuiltinType
    , 'PLC.BuiltinTypeNotAStar