mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
Convert experimental primitive TYPEREP_TYCON_NAME
into proper LF builtin (#13465)
* Convert experimental primitive TYPEREP_TYCON_NAME into proper LF builtin * Add entry for TYPEREP_TYCON_NAME in daml-lf spec * disable quickcheck test in DA.Test.Packaging changelog_begin changelog_end
This commit is contained in:
parent
19714e27c6
commit
f59d1cd0b4
@ -345,6 +345,9 @@ data BuiltinExpr
|
|||||||
| BEEqualContractId -- :: forall a. ContractId a -> ContractId a -> Bool
|
| BEEqualContractId -- :: forall a. ContractId a -> ContractId a -> Bool
|
||||||
| BECoerceContractId -- :: forall a b. ContractId a -> ContractId b
|
| BECoerceContractId -- :: forall a b. ContractId a -> ContractId b
|
||||||
|
|
||||||
|
-- TypeRep
|
||||||
|
| BETypeRepTyConName -- :: TypeRep -> Optional Text
|
||||||
|
|
||||||
-- Experimental Text Primitives
|
-- Experimental Text Primitives
|
||||||
| BETextToUpper -- :: Text -> Text
|
| BETextToUpper -- :: Text -> Text
|
||||||
| BETextToLower -- :: Text -> Text
|
| BETextToLower -- :: Text -> Text
|
||||||
|
@ -298,6 +298,7 @@ instance Pretty BuiltinExpr where
|
|||||||
BETextToCodePoints -> "TEXT_TO_CODE_POINTS"
|
BETextToCodePoints -> "TEXT_TO_CODE_POINTS"
|
||||||
BECodePointsToText -> "CODE_POINTS_TO_TEXT"
|
BECodePointsToText -> "CODE_POINTS_TO_TEXT"
|
||||||
BECoerceContractId -> "COERCE_CONTRACT_ID"
|
BECoerceContractId -> "COERCE_CONTRACT_ID"
|
||||||
|
BETypeRepTyConName -> "TYPEREP_TYCON_NAME"
|
||||||
BETextToUpper -> "TEXT_TO_UPPER"
|
BETextToUpper -> "TEXT_TO_UPPER"
|
||||||
BETextToLower -> "TEXT_TO_LOWER"
|
BETextToLower -> "TEXT_TO_LOWER"
|
||||||
BETextSlice -> "TEXT_SLICE"
|
BETextSlice -> "TEXT_SLICE"
|
||||||
|
@ -500,6 +500,8 @@ decodeBuiltinFunction = \case
|
|||||||
LF1.BuiltinFunctionEQUAL_CONTRACT_ID -> pure BEEqualContractId
|
LF1.BuiltinFunctionEQUAL_CONTRACT_ID -> pure BEEqualContractId
|
||||||
LF1.BuiltinFunctionCOERCE_CONTRACT_ID -> pure BECoerceContractId
|
LF1.BuiltinFunctionCOERCE_CONTRACT_ID -> pure BECoerceContractId
|
||||||
|
|
||||||
|
LF1.BuiltinFunctionTYPEREP_TYCON_NAME -> pure BETypeRepTyConName
|
||||||
|
|
||||||
LF1.BuiltinFunctionTEXT_TO_UPPER -> pure BETextToUpper
|
LF1.BuiltinFunctionTEXT_TO_UPPER -> pure BETextToUpper
|
||||||
LF1.BuiltinFunctionTEXT_TO_LOWER -> pure BETextToLower
|
LF1.BuiltinFunctionTEXT_TO_LOWER -> pure BETextToLower
|
||||||
LF1.BuiltinFunctionTEXT_SLICE -> pure BETextSlice
|
LF1.BuiltinFunctionTEXT_SLICE -> pure BETextSlice
|
||||||
|
@ -550,6 +550,8 @@ encodeBuiltinExpr = \case
|
|||||||
BEEqualContractId -> builtin P.BuiltinFunctionEQUAL_CONTRACT_ID
|
BEEqualContractId -> builtin P.BuiltinFunctionEQUAL_CONTRACT_ID
|
||||||
BECoerceContractId -> builtin P.BuiltinFunctionCOERCE_CONTRACT_ID
|
BECoerceContractId -> builtin P.BuiltinFunctionCOERCE_CONTRACT_ID
|
||||||
|
|
||||||
|
BETypeRepTyConName -> builtin P.BuiltinFunctionTYPEREP_TYCON_NAME
|
||||||
|
|
||||||
BETextToUpper -> builtin P.BuiltinFunctionTEXT_TO_UPPER
|
BETextToUpper -> builtin P.BuiltinFunctionTEXT_TO_UPPER
|
||||||
BETextToLower -> builtin P.BuiltinFunctionTEXT_TO_LOWER
|
BETextToLower -> builtin P.BuiltinFunctionTEXT_TO_LOWER
|
||||||
BETextSlice -> builtin P.BuiltinFunctionTEXT_SLICE
|
BETextSlice -> builtin P.BuiltinFunctionTEXT_SLICE
|
||||||
|
@ -166,6 +166,7 @@ safetyStep = \case
|
|||||||
BETextToInt64 -> Safe 1
|
BETextToInt64 -> Safe 1
|
||||||
BETextToCodePoints -> Safe 1
|
BETextToCodePoints -> Safe 1
|
||||||
BECoerceContractId -> Safe 1
|
BECoerceContractId -> Safe 1
|
||||||
|
BETypeRepTyConName -> Safe 1
|
||||||
BETextToUpper -> Safe 1
|
BETextToUpper -> Safe 1
|
||||||
BETextToLower -> Safe 1
|
BETextToLower -> Safe 1
|
||||||
BETextSlice -> Safe 3
|
BETextSlice -> Safe 3
|
||||||
|
@ -302,6 +302,8 @@ typeOfBuiltin = \case
|
|||||||
BECoerceContractId -> do
|
BECoerceContractId -> do
|
||||||
pure $ TForall (alpha, KStar) $ TForall (beta, KStar) $ TContractId tAlpha :-> TContractId tBeta
|
pure $ TForall (alpha, KStar) $ TForall (beta, KStar) $ TContractId tAlpha :-> TContractId tBeta
|
||||||
|
|
||||||
|
BETypeRepTyConName -> pure (TTypeRep :-> TOptional TText)
|
||||||
|
|
||||||
BETextToUpper -> pure (TText :-> TText)
|
BETextToUpper -> pure (TText :-> TText)
|
||||||
BETextToLower -> pure (TText :-> TText)
|
BETextToLower -> pure (TText :-> TText)
|
||||||
BETextSlice -> pure (TInt64 :-> TInt64 :-> TText :-> TText)
|
BETextSlice -> pure (TInt64 :-> TInt64 :-> TText :-> TText)
|
||||||
@ -798,7 +800,6 @@ typeOf' = \case
|
|||||||
|
|
||||||
checkExperimentalType :: MonadGamma m => T.Text -> Type -> m ()
|
checkExperimentalType :: MonadGamma m => T.Text -> Type -> m ()
|
||||||
checkExperimentalType "ANSWER" (TUnit :-> TInt64) = pure ()
|
checkExperimentalType "ANSWER" (TUnit :-> TInt64) = pure ()
|
||||||
checkExperimentalType "TYPEREP_TYCON_NAME" (TTypeRep :-> TOptional TText) = pure ()
|
|
||||||
checkExperimentalType name ty =
|
checkExperimentalType name ty =
|
||||||
throwWithContext (EUnknownExperimental name ty)
|
throwWithContext (EUnknownExperimental name ty)
|
||||||
|
|
||||||
|
@ -416,6 +416,8 @@ convertPrim _ "EUnsafeFromRequiredInterface" (TContractId (TCon superIface) :->
|
|||||||
$ ETmLam (mkVar "i", TCon superIface)
|
$ ETmLam (mkVar "i", TCon superIface)
|
||||||
$ EUnsafeFromRequiredInterface superIface subIface (EVar $ mkVar "cid") (EVar $ mkVar "i")
|
$ EUnsafeFromRequiredInterface superIface subIface (EVar $ mkVar "cid") (EVar $ mkVar "i")
|
||||||
|
|
||||||
|
convertPrim _ "ETypeRepTyConName" (TTypeRep :-> TOptional TText) = EBuiltin BETypeRepTyConName
|
||||||
|
|
||||||
convertPrim (V1 PointDev) (L.stripPrefix "$" -> Just builtin) typ =
|
convertPrim (V1 PointDev) (L.stripPrefix "$" -> Just builtin) typ =
|
||||||
EExperimental (T.pack builtin) typ
|
EExperimental (T.pack builtin) typ
|
||||||
|
|
||||||
|
@ -262,7 +262,7 @@ deriving instance Ord TemplateTypeRep
|
|||||||
-- represented by a TemplateTypeRep, as a string.
|
-- represented by a TemplateTypeRep, as a string.
|
||||||
templateTypeRepToText : TemplateTypeRep -> Text
|
templateTypeRepToText : TemplateTypeRep -> Text
|
||||||
templateTypeRepToText (TemplateTypeRep x) =
|
templateTypeRepToText (TemplateTypeRep x) =
|
||||||
case primitive @"$TYPEREP_TYCON_NAME" x of
|
case primitive @"ETypeRepTyConName" x of
|
||||||
None -> error "Invalid TemplateTypeRep, does not contain a type constructor."
|
None -> error "Invalid TemplateTypeRep, does not contain a type constructor."
|
||||||
Some y -> y
|
Some y -> y
|
||||||
|
|
||||||
|
@ -22,10 +22,10 @@ import System.Exit
|
|||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.IO.Extra
|
import System.IO.Extra
|
||||||
import System.Process
|
import System.Process
|
||||||
import qualified Test.QuickCheck.Monadic as Q (monadicIO, run)
|
-- import qualified Test.QuickCheck.Monadic as Q (monadicIO, run)
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
import Test.Tasty.QuickCheck
|
-- import Test.Tasty.QuickCheck
|
||||||
|
|
||||||
import SdkVersion
|
import SdkVersion
|
||||||
|
|
||||||
@ -731,6 +731,7 @@ tests Tools{damlc} = testGroup "Packaging" $
|
|||||||
exitCode @?= ExitFailure 1
|
exitCode @?= ExitFailure 1
|
||||||
assertBool ("Expected \"non-exhaustive\" error in stderr but got: " <> show stderr) ("non-exhaustive" `isInfixOf` stderr)
|
assertBool ("Expected \"non-exhaustive\" error in stderr but got: " <> show stderr) ("non-exhaustive" `isInfixOf` stderr)
|
||||||
|
|
||||||
|
{-
|
||||||
, testProperty "data-dependencies + exposed-modules" $ \(n1 :: Int) (n2 :: Int) ->
|
, testProperty "data-dependencies + exposed-modules" $ \(n1 :: Int) (n2 :: Int) ->
|
||||||
-- Since the order in which dependencies are processed depends on their PackageIds,
|
-- Since the order in which dependencies are processed depends on their PackageIds,
|
||||||
-- which in turn depends on their contents, we check that 'data-dependency' is
|
-- which in turn depends on their contents, we check that 'data-dependency' is
|
||||||
@ -795,6 +796,7 @@ tests Tools{damlc} = testGroup "Packaging" $
|
|||||||
, "foo = f"
|
, "foo = f"
|
||||||
]
|
]
|
||||||
withCurrentDirectory (projDir </> "main") $ callProcessSilent damlc ["build", "-o", "main.dar"]
|
withCurrentDirectory (projDir </> "main") $ callProcessSilent damlc ["build", "-o", "main.dar"]
|
||||||
|
-}
|
||||||
, testCaseSteps "dependency with data-dependency" $ \step -> withTempDir $ \projDir -> do
|
, testCaseSteps "dependency with data-dependency" $ \step -> withTempDir $ \projDir -> do
|
||||||
-- This tests that a Daml project ('main') can depend on a package ('dependency') which in turn
|
-- This tests that a Daml project ('main') can depend on a package ('dependency') which in turn
|
||||||
-- has a data-dependency on a third package ('data-dependency'). Note that, as usual, all the
|
-- has a data-dependency on a third package ('data-dependency'). Note that, as usual, all the
|
||||||
|
@ -568,7 +568,9 @@ enum BuiltinFunction {
|
|||||||
NUMERIC_TO_BIGNUMERIC = 145; // *Available in versions >= 1.13*
|
NUMERIC_TO_BIGNUMERIC = 145; // *Available in versions >= 1.13*
|
||||||
BIGNUMERIC_TO_TEXT = 146; // *Available in versions >= 1.13*
|
BIGNUMERIC_TO_TEXT = 146; // *Available in versions >= 1.13*
|
||||||
|
|
||||||
// Next id is 148. 147 is ANY_EXCEPTION_MESSAGE.
|
TYPEREP_TYCON_NAME = 148; // *Available in versions >= 1.dev*
|
||||||
|
|
||||||
|
// Next id is 149.
|
||||||
|
|
||||||
// EXPERIMENTAL TEXT PRIMITIVES -- these do not yet have stable numbers.
|
// EXPERIMENTAL TEXT PRIMITIVES -- these do not yet have stable numbers.
|
||||||
TEXT_TO_UPPER = 9901; // *Available in versions >= 1.dev*
|
TEXT_TO_UPPER = 9901; // *Available in versions >= 1.dev*
|
||||||
|
@ -2015,6 +2015,7 @@ private[lf] object DecodeV1 {
|
|||||||
BuiltinFunctionInfo(NUMERIC_TO_BIGNUMERIC, BNumericToBigNumeric, minVersion = bigNumeric),
|
BuiltinFunctionInfo(NUMERIC_TO_BIGNUMERIC, BNumericToBigNumeric, minVersion = bigNumeric),
|
||||||
BuiltinFunctionInfo(BIGNUMERIC_TO_TEXT, BBigNumericToText, minVersion = bigNumeric),
|
BuiltinFunctionInfo(BIGNUMERIC_TO_TEXT, BBigNumericToText, minVersion = bigNumeric),
|
||||||
BuiltinFunctionInfo(ANY_EXCEPTION_MESSAGE, BAnyExceptionMessage, minVersion = exceptions),
|
BuiltinFunctionInfo(ANY_EXCEPTION_MESSAGE, BAnyExceptionMessage, minVersion = exceptions),
|
||||||
|
BuiltinFunctionInfo(TYPEREP_TYCON_NAME, BTypeRepTyConName, minVersion = interfaces),
|
||||||
BuiltinFunctionInfo(TEXT_TO_UPPER, BTextToUpper, minVersion = unstable),
|
BuiltinFunctionInfo(TEXT_TO_UPPER, BTextToUpper, minVersion = unstable),
|
||||||
BuiltinFunctionInfo(TEXT_TO_LOWER, BTextToLower, minVersion = unstable),
|
BuiltinFunctionInfo(TEXT_TO_LOWER, BTextToLower, minVersion = unstable),
|
||||||
BuiltinFunctionInfo(TEXT_SLICE, BTextSlice, minVersion = unstable),
|
BuiltinFunctionInfo(TEXT_SLICE, BTextSlice, minVersion = unstable),
|
||||||
|
@ -1194,6 +1194,13 @@ class DecodeV1Spec
|
|||||||
)
|
)
|
||||||
.build()
|
.build()
|
||||||
|
|
||||||
|
val typeRepTyConName = DamlLf1.Expr
|
||||||
|
.newBuilder()
|
||||||
|
.setBuiltin(
|
||||||
|
DamlLf1.BuiltinFunction.TYPEREP_TYCON_NAME
|
||||||
|
)
|
||||||
|
.build()
|
||||||
|
|
||||||
Table(
|
Table(
|
||||||
"input" -> "expected output",
|
"input" -> "expected output",
|
||||||
interfaceTemplateTypeRep -> EInterfaceTemplateTypeRep(
|
interfaceTemplateTypeRep -> EInterfaceTemplateTypeRep(
|
||||||
@ -1234,6 +1241,7 @@ class DecodeV1Spec
|
|||||||
contractIdExpr = EUnit,
|
contractIdExpr = EUnit,
|
||||||
ifaceExpr = EFalse,
|
ifaceExpr = EFalse,
|
||||||
),
|
),
|
||||||
|
typeRepTyConName -> Ast.EBuiltin(Ast.BTypeRepTyConName),
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -493,6 +493,9 @@ private[lf] final class PhaseOne(
|
|||||||
case BBigNumericToNumeric => SBBigNumericToNumeric
|
case BBigNumericToNumeric => SBBigNumericToNumeric
|
||||||
case BBigNumericToText => SBToText
|
case BBigNumericToText => SBToText
|
||||||
|
|
||||||
|
// TypeRep
|
||||||
|
case BTypeRepTyConName => SBTypeRepTyConName
|
||||||
|
|
||||||
// Unstable Text Primitives
|
// Unstable Text Primitives
|
||||||
case BTextToUpper => SBTextToUpper
|
case BTextToUpper => SBTextToUpper
|
||||||
case BTextToLower => SBTextToLower
|
case BTextToLower => SBTextToLower
|
||||||
|
@ -1672,6 +1672,18 @@ private[lf] object SBuiltin {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/** $type_rep_ty_con_name
|
||||||
|
* :: TypeRep
|
||||||
|
* -> Optional Text
|
||||||
|
*/
|
||||||
|
final case object SBTypeRepTyConName extends SBuiltinPure(1) {
|
||||||
|
override private[speedy] def executePure(args: util.ArrayList[SValue]): SOptional =
|
||||||
|
getSTypeRep(args, 0) match {
|
||||||
|
case Ast.TTyCon(name) => SOptional(Some(SText(name.toString)))
|
||||||
|
case _ => SOptional(None)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
// Unstable text primitives.
|
// Unstable text primitives.
|
||||||
|
|
||||||
/** $text_to_upper :: Text -> Text */
|
/** $text_to_upper :: Text -> Text */
|
||||||
@ -1871,19 +1883,10 @@ private[lf] object SBuiltin {
|
|||||||
machine.returnValue = SInt64(42L)
|
machine.returnValue = SInt64(42L)
|
||||||
}
|
}
|
||||||
|
|
||||||
private object SBExperimentalTypeRepTyConName extends SBuiltinPure(1) {
|
|
||||||
override private[speedy] def executePure(args: util.ArrayList[SValue]): SOptional =
|
|
||||||
getSTypeRep(args, 0) match {
|
|
||||||
case Ast.TTyCon(name) => SOptional(Some(SText(name.toString)))
|
|
||||||
case _ => SOptional(None)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
//TODO: move this into the speedy compiler code
|
//TODO: move this into the speedy compiler code
|
||||||
private val mapping: Map[String, compileTime.SExpr] =
|
private val mapping: Map[String, compileTime.SExpr] =
|
||||||
List(
|
List(
|
||||||
"ANSWER" -> SBExperimentalAnswer,
|
"ANSWER" -> SBExperimentalAnswer
|
||||||
"TYPEREP_TYCON_NAME" -> SBExperimentalTypeRepTyConName,
|
|
||||||
).view.map { case (name, builtin) => name -> compileTime.SEBuiltin(builtin) }.toMap
|
).view.map { case (name, builtin) => name -> compileTime.SEBuiltin(builtin) }.toMap
|
||||||
|
|
||||||
def apply(name: String): compileTime.SExpr =
|
def apply(name: String): compileTime.SExpr =
|
||||||
|
@ -513,6 +513,9 @@ object Ast {
|
|||||||
final case object BNumericToBigNumeric extends BuiltinFunction // : ∀s. Numeric s → BigNumeric
|
final case object BNumericToBigNumeric extends BuiltinFunction // : ∀s. Numeric s → BigNumeric
|
||||||
final case object BBigNumericToText extends BuiltinFunction // : BigNumeric → Text
|
final case object BBigNumericToText extends BuiltinFunction // : BigNumeric → Text
|
||||||
|
|
||||||
|
// TypeRep
|
||||||
|
final case object BTypeRepTyConName extends BuiltinFunction // : TypeRep → Optional Text
|
||||||
|
|
||||||
// Unstable Text Primitives
|
// Unstable Text Primitives
|
||||||
final case object BTextToUpper extends BuiltinFunction // Text → Text
|
final case object BTextToUpper extends BuiltinFunction // Text → Text
|
||||||
final case object BTextToLower extends BuiltinFunction // : Text → Text
|
final case object BTextToLower extends BuiltinFunction // : Text → Text
|
||||||
|
@ -376,6 +376,7 @@ private[parser] class ExprParser[P](parserParameters: ParserParameters[P]) {
|
|||||||
"BIGNUMERIC_TO_NUMERIC" -> BBigNumericToNumeric,
|
"BIGNUMERIC_TO_NUMERIC" -> BBigNumericToNumeric,
|
||||||
"NUMERIC_TO_BIGNUMERIC" -> BNumericToBigNumeric,
|
"NUMERIC_TO_BIGNUMERIC" -> BNumericToBigNumeric,
|
||||||
"BIGNUMERIC_TO_TEXT" -> BBigNumericToText,
|
"BIGNUMERIC_TO_TEXT" -> BBigNumericToText,
|
||||||
|
"TYPEREP_TYCON_NAME" -> BTypeRepTyConName,
|
||||||
)
|
)
|
||||||
|
|
||||||
private lazy val eCallInterface: Parser[ECallInterface] =
|
private lazy val eCallInterface: Parser[ECallInterface] =
|
||||||
|
@ -233,6 +233,7 @@ class ParsersSpec extends AnyWordSpec with ScalaCheckPropertyChecks with Matcher
|
|||||||
"GREATER_EQ" -> BGreaterEq,
|
"GREATER_EQ" -> BGreaterEq,
|
||||||
"COERCE_CONTRACT_ID" -> BCoerceContractId,
|
"COERCE_CONTRACT_ID" -> BCoerceContractId,
|
||||||
"ANY_EXCEPTION_MESSAGE" -> BAnyExceptionMessage,
|
"ANY_EXCEPTION_MESSAGE" -> BAnyExceptionMessage,
|
||||||
|
"TYPEREP_TYCON_NAME" -> BTypeRepTyConName,
|
||||||
)
|
)
|
||||||
|
|
||||||
forEvery(testCases)((stringToParse, expectedBuiltin) =>
|
forEvery(testCases)((stringToParse, expectedBuiltin) =>
|
||||||
|
@ -5195,6 +5195,14 @@ Type Representation function
|
|||||||
[*Available in versions >= 1.7*]
|
[*Available in versions >= 1.7*]
|
||||||
|
|
||||||
|
|
||||||
|
* ``TYPEREP_TYCON_NAME`` : 'TypeRep' → 'Optional' 'Text'``
|
||||||
|
|
||||||
|
Returns the type constructor name, as a string, of the given ``'TypeRep'``,
|
||||||
|
if it is indeed a type constructor. Otherwise returns ``'None'``
|
||||||
|
|
||||||
|
[*Available in versions >= 1.dev*]
|
||||||
|
|
||||||
|
|
||||||
Conversions functions
|
Conversions functions
|
||||||
~~~~~~~~~~~~~~~~~~~~~
|
~~~~~~~~~~~~~~~~~~~~~
|
||||||
|
|
||||||
|
@ -236,6 +236,8 @@ private[validation] object Typing {
|
|||||||
BBigNumericToText -> (TBigNumeric ->: TText),
|
BBigNumericToText -> (TBigNumeric ->: TText),
|
||||||
// Exception functions
|
// Exception functions
|
||||||
BAnyExceptionMessage -> (TAnyException ->: TText),
|
BAnyExceptionMessage -> (TAnyException ->: TText),
|
||||||
|
// TypeRep functions
|
||||||
|
BTypeRepTyConName -> (TTypeRep ->: TOptional(TText)),
|
||||||
// Unstable text functions
|
// Unstable text functions
|
||||||
BTextToUpper -> (TText ->: TText),
|
BTextToUpper -> (TText ->: TText),
|
||||||
BTextToLower -> (TText ->: TText),
|
BTextToLower -> (TText ->: TText),
|
||||||
|
Loading…
Reference in New Issue
Block a user