DAML-LF add support for generic comparison in archive (#4983)

* DAML-LF: add generic comparison to archive
digital-asset · Mar 13, 2020 · c76e0bc · c76e0bc
1 parent 5c2ed56
commit c76e0bc
Show file tree

Hide file tree

Showing 15 changed files with 93 additions and 46 deletions.
diff --git a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs
@@ -233,6 +233,10 @@ data BuiltinExpr
   -- Polymorphic functions
   | BEError                      -- :: ∀a. Text -> a
   | BEEqualGeneric               -- :: ∀t. t -> t -> Bool
+  | BELessGeneric                -- :: ∀t. t -> t -> Bool   
+  | BELessEqGeneric              -- :: ∀t. t -> t -> Bool   
+  | BEGreaterGeneric             -- :: ∀t. t -> t -> Bool
+  | BEGreaterEqGeneric           -- :: ∀t. t -> t -> Bool
   | BEEqual      !BuiltinType    -- :: t -> t -> Bool, where t is the builtin type
   | BELess       !BuiltinType    -- :: t -> t -> Bool, where t is the builtin type
   | BELessEq     !BuiltinType    -- :: t -> t -> Bool, where t is the builtin type

diff --git a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs
@@ -202,6 +202,10 @@ instance Pretty BuiltinExpr where
     BEBool b -> keyword_ $ case b of { False -> "false"; True -> "true" }
     BEError -> "ERROR"
     BEEqualGeneric -> "EQUAL"
+    BELessGeneric -> "LESS"
+    BELessEqGeneric -> "LESS_EQ"
+    BEGreaterGeneric -> "GREATER"
+    BEGreaterEqGeneric -> "GREATER_EQ"
     BEEqual t     -> maybeParens (prec > precEApp) ("EQUAL"      <-> prettyBTyArg lvl t)
     BELess t      -> maybeParens (prec > precEApp) ("LESS"       <-> prettyBTyArg lvl t)
     BELessEq t    -> maybeParens (prec > precEApp) ("LESS_EQ"    <-> prettyBTyArg lvl t)

diff --git a/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs b/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs
@@ -326,6 +326,12 @@ decodeChoice LF1.TemplateChoice{..} =
 
 decodeBuiltinFunction :: LF1.BuiltinFunction -> Decode BuiltinExpr
 decodeBuiltinFunction = pure . \case
+  LF1.BuiltinFunctionEQUAL -> BEEqualGeneric
+  LF1.BuiltinFunctionLESS -> BELessGeneric
+  LF1.BuiltinFunctionLESS_EQ -> BELessEqGeneric
+  LF1.BuiltinFunctionGREATER -> BEGreaterGeneric
+  LF1.BuiltinFunctionGREATER_EQ -> BEGreaterEqGeneric
+
   LF1.BuiltinFunctionEQUAL_INT64 -> BEEqual BTInt64
   LF1.BuiltinFunctionEQUAL_DECIMAL -> BEEqual BTDecimal
   LF1.BuiltinFunctionEQUAL_NUMERIC -> BEEqualNumeric
@@ -335,7 +341,6 @@ decodeBuiltinFunction = pure . \case
   LF1.BuiltinFunctionEQUAL_PARTY -> BEEqual BTParty
   LF1.BuiltinFunctionEQUAL_BOOL -> BEEqual BTBool
   LF1.BuiltinFunctionEQUAL_TYPE_REP -> BEEqual BTTypeRep
-  LF1.BuiltinFunctionEQUAL -> BEEqualGeneric
 
   LF1.BuiltinFunctionLEQ_INT64 -> BELessEq BTInt64
   LF1.BuiltinFunctionLEQ_DECIMAL -> BELessEq BTDecimal

diff --git a/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeV1.hs b/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeV1.hs
@@ -361,6 +361,11 @@ encodeBuiltinExpr = \case
         True -> P.PrimConCON_TRUE
 
     BEEqualGeneric -> builtin P.BuiltinFunctionEQUAL
+    BELessGeneric -> builtin P.BuiltinFunctionLESS
+    BELessEqGeneric -> builtin P.BuiltinFunctionLESS_EQ
+    BEGreaterGeneric -> builtin P.BuiltinFunctionGREATER
+    BEGreaterEqGeneric -> builtin P.BuiltinFunctionGREATER_EQ
+
     BEEqual typ -> case typ of
       BTInt64 -> builtin P.BuiltinFunctionEQUAL_INT64
       BTDecimal -> builtin P.BuiltinFunctionEQUAL_DECIMAL

diff --git a/compiler/daml-lf-tools/src/DA/Daml/LF/Simplifier.hs b/compiler/daml-lf-tools/src/DA/Daml/LF/Simplifier.hs
@@ -116,6 +116,10 @@ safetyStep = \case
       BEBool _            -> Safe 0
       BEError             -> Safe 0
       BEEqualGeneric      -> Safe 1 -- may crash if values are incomparable
+      BELessGeneric       -> Safe 1 -- may crash if values are incomparable
+      BELessEqGeneric     -> Safe 1 -- may crash if values are incomparable
+      BEGreaterGeneric    -> Safe 1 -- may crash if values are incomparable
+      BEGreaterEqGeneric  -> Safe 1 -- may crash if values are incomparable
       BEEqual _           -> Safe 2
       BELess _            -> Safe 2
       BELessEq _          -> Safe 2

diff --git a/compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs b/compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs
@@ -193,6 +193,10 @@ typeOfBuiltin = \case
   BEBool _           -> pure TBool
   BEError            -> pure $ TForall (alpha, KStar) (TText :-> tAlpha)
   BEEqualGeneric     -> pure $ TForall (alpha, KStar) (tAlpha :-> tAlpha :-> TBool)
+  BELessGeneric      -> pure $ TForall (alpha, KStar) (tAlpha :-> tAlpha :-> TBool)
+  BELessEqGeneric    -> pure $ TForall (alpha, KStar) (tAlpha :-> tAlpha :-> TBool)
+  BEGreaterGeneric   -> pure $ TForall (alpha, KStar) (tAlpha :-> tAlpha :-> TBool)
+  BEGreaterEqGeneric -> pure $ TForall (alpha, KStar) (tAlpha :-> tAlpha :-> TBool)
   BEEqual     btype  -> pure $ tComparison btype
   BELess      btype  -> pure $ tComparison btype
   BELessEq    btype  -> pure $ tComparison btype

diff --git a/daml-lf/archive/src/main/protobuf/com/digitalasset/daml_lf_dev/daml_lf_1.proto b/daml-lf/archive/src/main/protobuf/com/digitalasset/daml_lf_dev/daml_lf_1.proto
@@ -465,37 +465,37 @@ enum BuiltinFunction {
 
   ERROR = 25;
 
-  LEQ_INT64 = 33;
-  LEQ_DECIMAL = 34;  // *Available in versions < 1.7*
-  LEQ_NUMERIC = 112;  // *Available in versions >= 1.7*
-  LEQ_TEXT = 36;
-  LEQ_TIMESTAMP = 37;
-  LEQ_DATE = 67;
-  LEQ_PARTY = 89; // *Available in versions >= 1.1*
-
-  LESS_INT64 = 39;
-  LESS_DECIMAL = 40;  // *Available in versions < 1.7*
-  LESS_NUMERIC = 113;  // *Available in versions >= 1.7*
-  LESS_TEXT = 42;
-  LESS_TIMESTAMP = 43;
-  LESS_DATE = 68;
-  LESS_PARTY = 90; // *Available in versions >= 1.1*
-
-  GEQ_INT64 = 45;
-  GEQ_DECIMAL = 46;  // *Available in versions < 1.7*
-  GEQ_NUMERIC = 114;  // *Available in versions >= 1.7*
-  GEQ_TEXT = 48;
-  GEQ_TIMESTAMP = 49;
-  GEQ_DATE = 69;
-  GEQ_PARTY = 91; // *Available in versions >= 1.1*
-
-  GREATER_INT64 = 51;
-  GREATER_DECIMAL = 52;  // *Available in versions < 1.7*
-  GREATER_NUMERIC = 115;  // *Available in versions >= 1.7*
-  GREATER_TEXT = 54;
-  GREATER_TIMESTAMP = 55;
-  GREATER_DATE = 70;
-  GREATER_PARTY = 92; // *Available in versions >= 1.1*
+  LEQ_INT64 = 33;         // *Available in versions < 1.dev*
+  LEQ_DECIMAL = 34;       // *Available in versions < 1.7*
+  LEQ_NUMERIC = 112;      // *Available in versions >= 1.7 and < 1.dev*
+  LEQ_TEXT = 36;          // *Available in versions < 1.dev*
+  LEQ_TIMESTAMP = 37;     // *Available in versions < 1.dev*
+  LEQ_DATE = 67;          // *Available in versions < 1.dev*
+  LEQ_PARTY = 89;         // *Available in versions >= 1.1 and < 1.dev*
+
+  LESS_INT64 = 39;        // *Available in versions < 1.dev*
+  LESS_DECIMAL = 40;      // *Available in versions < 1.7*
+  LESS_NUMERIC = 113;     // *Available in versions >= 1.7 and < 1.dev*
+  LESS_TEXT = 42;         // *Available in versions < 1.dev*
+  LESS_TIMESTAMP = 43;    // *Available in versions < 1.dev*
+  LESS_DATE = 68;         // *Available in versions < 1.dev*
+  LESS_PARTY = 90;        // *Available in versions >= 1.1 and < 1.dev*
+
+  GEQ_INT64 = 45;         // *Available in versions < 1.dev*
+  GEQ_DECIMAL = 46;       // *Available in versions < 1.7*
+  GEQ_NUMERIC = 114;      // *Available in versions >= 1.7 and < 1.dev*
+  GEQ_TEXT = 48;          // *Available in versions < 1.dev*
+  GEQ_TIMESTAMP = 49;     // *Available in versions < 1.dev*
+  GEQ_DATE = 69;          // *Available in versions < 1.dev*
+  GEQ_PARTY = 91;         // *Available in versions >= 1.1 and < 1.dev*
+
+  GREATER_INT64 = 51;     // *Available in versions < 1.dev*
+  GREATER_DECIMAL = 52;   // *Available in versions < 1.7*
+  GREATER_NUMERIC = 115;  // *Available in versions >= 1.7 and < 1.dev*
+  GREATER_TEXT = 54;      // *Available in versions < 1.dev*
+  GREATER_TIMESTAMP = 55; // *Available in versions < 1.dev*
+  GREATER_DATE = 70;      // *Available in versions < 1.dev*
+  GREATER_PARTY = 92;     // *Available in versions >= 1.1 and < 1.dev*
 
   TO_TEXT_INT64 = 57;
   TO_TEXT_DECIMAL = 58;  // *Available in versions < 1.7*
@@ -533,10 +533,15 @@ enum BuiltinFunction {
   EQUAL_DATE = 83;        // *Available in versions < 1.dev*
   EQUAL_PARTY = 84;       // *Available in versions < 1.dev*
   EQUAL_BOOL = 85;        // *Available in versions < 1.dev*
-  EQUAL_CONTRACT_ID = 86;
+  EQUAL_CONTRACT_ID = 86; // *Available in versions < 1.dev*
   EQUAL_LIST = 87;
-  EQUAL_TYPE_REP = 123;   // *Available in versions < 1.dev*
+  EQUAL_TYPE_REP = 123;   // *Available in versions = 1.8*
+
   EQUAL = 131;            // *Available in versions >= 1.dev*
+  LESS_EQ = 132;          // *Available in versions >= 1.dev*
+  LESS = 133;             // *Available in versions >= 1.dev*
+  GREATER_EQ = 134;       // *Available in versions >= 1.dev*
+  GREATER = 135;          // *Available in versions >= 1.dev*
 
   TRACE = 88;
 
@@ -545,7 +550,7 @@ enum BuiltinFunction {
   TEXT_FROM_CODE_POINTS = 105;  // *Available in versions >= 1.6*
   TEXT_TO_CODE_POINTS = 106; // *Available in versions >= 1.6*
 
-  // Next id is 132. 131 is EQUAL.
+  // Next id is 136. 135 is GREATER.
 
   // EXPERIMENTAL TEXT PRIMITIVES -- these do not yet have stable numbers.
   TEXT_TO_UPPER = 9901; // *Available in versions >= 1.dev*

diff --git a/daml-lf/archive/src/main/scala/com/digitalasset/daml/lf/archive/DecodeV1.scala b/daml-lf/archive/src/main/scala/com/digitalasset/daml/lf/archive/DecodeV1.scala
@@ -1483,7 +1483,11 @@ private[lf] object DecodeV1 {
       BuiltinFunctionInfo(UNIX_DAYS_TO_DATE, BUnixDaysToDate),
       BuiltinFunctionInfo(UNIX_MICROSECONDS_TO_TIMESTAMP, BUnixMicrosecondsToTimestamp),
       BuiltinFunctionInfo(GREATER_DATE, BGreaterDate),
-      BuiltinFunctionInfo(EQUAL, BEqual, minVersion = genMap),
+      BuiltinFunctionInfo(EQUAL, BEqual, minVersion = genComparison),
+      BuiltinFunctionInfo(LESS, BELess, minVersion = genComparison),
+      BuiltinFunctionInfo(LESS_EQ, BELessEq, minVersion = genComparison),
+      BuiltinFunctionInfo(GREATER, BEGreater, minVersion = genComparison),
+      BuiltinFunctionInfo(GREATER_EQ, BEGreaterEq, minVersion = genComparison),
       BuiltinFunctionInfo(EQUAL_LIST, BEqualList),
       BuiltinFunctionInfo(EQUAL_INT64, BEqual, implicitParameters = List(TInt64)),
       BuiltinFunctionInfo(

diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Compiler.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Compiler.scala
@@ -293,6 +293,10 @@ final case class Compiler(packages: PackageId PartialFunction Package) {
               case BEqualNumeric => SBEqualNumeric
               case BEqualContractId => SBEqual
               case BEqual => SBEqual
+              case BELess => SBLess
+              case BELessEq => SBLessEq
+              case BEGreater => SBGreater
+              case BEGreaterEq => SBGreaterEq
 
               // TextMap
 

diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SBuiltin.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SBuiltin.scala
@@ -638,15 +638,7 @@ object SBuiltin {
 
   sealed abstract class SBCompare(pred: Int => Boolean) extends SBuiltin(2) {
     def execute(args: util.ArrayList[SValue], machine: Machine): Unit = {
-      val result = (args.get(0), args.get(1)) match {
-        case (SInt64(a), SInt64(b)) => pred(a compareTo b)
-        case (STimestamp(a), STimestamp(b)) => pred(a compareTo b)
-        case (SText(a), SText(b)) => pred(Utf8.Ordering.compare(a, b))
-        case (SDate(a), SDate(b)) => pred(a compareTo b)
-        case (SParty(a), SParty(b)) => pred(a compareTo b)
-        case _ =>
-          crash(s"type mismatch ${getClass.getSimpleName}: $args")
-      }
+      val result = pred(svalue.Ordering.compare(args.get(0), args.get(1)))
       machine.ctrl = CtrlValue.bool(result)
     }
   }

diff --git a/daml-lf/language/src/main/scala/com/digitalasset/daml/lf/language/Ast.scala b/daml-lf/language/src/main/scala/com/digitalasset/daml/lf/language/Ast.scala
@@ -429,6 +429,10 @@ object Ast {
   final case object BEqualList extends BuiltinFunction(3) // : ∀a. (a -> a -> Bool) -> List a -> List a -> Bool
   final case object BEqualContractId extends BuiltinFunction(2) // : ∀a. ContractId a -> ContractId a -> Bool
   final case object BEqual extends BuiltinFunction(2) // ∀a. a -> a -> Bool
+  final case object BELess extends BuiltinFunction(2) // ∀a. a -> a -> Bool
+  final case object BELessEq extends BuiltinFunction(2) // ∀a. a -> a -> Bool
+  final case object BEGreater extends BuiltinFunction(2) // ∀a. a -> a -> Bool
+  final case object BEGreaterEq extends BuiltinFunction(2) // ∀a. a -> a -> Bool
   final case object BCoerceContractId extends BuiltinFunction(1) // : ∀a b. ContractId a -> ContractId b
 
   // Unstable Text Primitives

diff --git a/daml-lf/language/src/main/scala/com/digitalasset/daml/lf/language/LanguageVersion.scala b/daml-lf/language/src/main/scala/com/digitalasset/daml/lf/language/LanguageVersion.scala
@@ -64,6 +64,7 @@ object LanguageVersion {
     val typeSynonyms = v1_8
     val packageMetadata = v1_8
     val genMap = v1_dev
+    val genComparison = v1_dev
     val scenarioMustFailAtMsg = v1_dev
 
     /** Unstable, experimental features. This should stay in 1.dev forever.

diff --git a/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/ExprParser.scala b/daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/ExprParser.scala
@@ -285,6 +285,10 @@ private[parser] class ExprParser[P](parserParameters: ParserParameters[P]) {
     "EQUAL_LIST" -> BEqualList,
     "EQUAL_CONTRACT_ID" -> BEqualContractId,
     "EQUAL" -> BEqual,
+    "LESS" -> BELess,
+    "LESS_EQ" -> BELessEq,
+    "GREATER" -> BEGreater,
+    "GREATER_EQ" -> BEGreaterEq,
     "COERCE_CONTRACT_ID" -> BCoerceContractId,
   )
 

diff --git a/daml-lf/parser/src/test/scala/com/digitalasset/daml/lf/testing/parser/ParsersSpec.scala b/daml-lf/parser/src/test/scala/com/digitalasset/daml/lf/testing/parser/ParsersSpec.scala
@@ -227,7 +227,10 @@ class ParsersSpec extends WordSpec with TableDrivenPropertyChecks with Matchers
         "EQUAL_NUMERIC" -> BEqualNumeric,
         "EQUAL_LIST" -> BEqualList,
         "EQUAL_CONTRACT_ID" -> BEqualContractId,
-        "EQUAL" -> BEqual,
+        "LESS" -> BELess,
+        "LESS_EQ" -> BELessEq,
+        "GREATER" -> BEGreater,
+        "GREATER_EQ" -> BEGreaterEq,
         "COERCE_CONTRACT_ID" -> BCoerceContractId,
       )
 

diff --git a/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Typing.scala b/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Typing.scala
@@ -222,6 +222,10 @@ private[validation] object Typing {
       BEqualContractId ->
         TForall(alpha.name -> KStar, TContractId(alpha) ->: TContractId(alpha) ->: TBool),
       BEqual -> TForall(alpha.name -> KStar, alpha ->: alpha ->: TBool),
+      BELess -> TForall(alpha.name -> KStar, alpha ->: alpha ->: TBool),
+      BELessEq -> TForall(alpha.name -> KStar, alpha ->: alpha ->: TBool),
+      BEGreater -> TForall(alpha.name -> KStar, alpha ->: alpha ->: TBool),
+      BEGreaterEq -> TForall(alpha.name -> KStar, alpha ->: alpha ->: TBool),
       BCoerceContractId ->
         TForall(
           alpha.name -> KStar,